#!/usr/bin/perl 
#
# $Author: smajer $
# $Id: cp2fwbuilder,v 1.14 2002/04/07 09:42:22 smajer Exp $
# $Date: 2002/04/07 09:42:22 $
#
# Used modules
#
use Getopt::Long;
use XML::Writer;
use Digest::MD5 qw(md5_hex);
use IO;


$VERSION	= '0.5';
$SCR_NAME	= 'cp2fwbuilder';

$FW1rules	= 'Standard.W';
$FW1objects	= 'objects.C';

$LogFile	= 'cp2fwbuilder.log';

%icmpcode = 
(	'ICMP_UNREACH'		=> '1',
	'ICMP_ECHOREPLY'	=> '0',
	'ICMP_ECHO'			=> '0',
	'ICMP_IREQREPLY' 	=> '0',
	'ICMP_IREQ'			=> '0',
	'ICMP_MASKREPLY'	=> '0',
	'ICMP_MASKREQ'		=> '0',
	'ICMP_PARAMPROB'	=> '0',
	'ICMP_REDIRECT'		=> '1',
	'ICMP_SOURCEQUENCH'	=> '0',
	'ICMP_TIMXCEED'		=> '0',
	'ICMP_TSTAMP'		=> '0',
	'ICMP_TSTAMPREPLY'	=> '0');

%icmptype = 
(	'ICMP_UNREACH'		=> '3',
	'ICMP_ECHOREPLY'	=> '0',
	'ICMP_ECHO'			=> '8',
	'ICMP_IREQREPLY' 	=> '16',
	'ICMP_IREQ'			=> '15',
	'ICMP_MASKREPLY'	=> '18',
	'ICMP_MASKREQ'		=> '17',
	'ICMP_PARAMPROB'	=> '12',
	'ICMP_REDIRECT'		=> '5',
	'ICMP_SOURCEQUENCH'	=> '4',
	'ICMP_TIMXCEED'		=> '11',
	'ICMP_TSTAMP'		=> '13',
	'ICMP_TSTAMPREPLY'	=> '14');



##########################################################################
# print out Usage
sub Usage{
  print STDERR "
Usage:
------

   $SCR_NAME.PL
	[--objects=<objects file>]
	[--rules=<rules file>]
	[--all_objs] [--all_services]
	[--with_implicit_rules]
	[--sort_by_type]
	[--verbose] [--version] [--comments]
	[--output_xml=<xml file>] \n"
}

##########################################################################
# correct Micro$oft stuff (line end, spaces)
sub fromdos {
    $line = $_[0];
    $line =~ s/\n//g;
    $line =~ s/\r//g;
    $line =~ s/        /\t/g;
    return $line;
}
##########################################################################
# correct wrong Encoding
sub xmlencode {
    my $line = $_[0];
	$line =~ s/\"//g;
	$line =~ s/;/\\n/g;
	$line =~ s/\&//g;
	$line =~ s/\<//g;
	$line =~ s/\>//g;
	$line =~ s/ä/ae/g;
	$line =~ s/ö/oe/g;
	$line =~ s/ü/ue/g;
	$line =~ s/Ä/Ae/g;
	$line =~ s/Ö/Oe/g;
	$line =~ s/Ü/Ue/g;
	
    return $line;
}

##########################################################################
# print out comments / errors
sub PrintLog{
    my ($msg) = $_[0];
    if ($FLAG_verbose){
	print STDERR "$msg";
	print LOGFILE "$msg";
    }
}

##########################################################################
# read all network entities/objects defined
#
# Object variables where obj_name equals the hash for each of these:
#
#	$obj_number 	= number of objects
#	@obj_name 	= names of all objects
#	%obj_type 	= host, network, gateway, group
#	%obj_location 	= 0=internal, 1=external
#	%obj_is_fw1 	= has FW1 installed? 0=false, 1=true
#	%obj_ipaddr 	= IP Address
#	%obj_netmask	= netmask
#	%obj_NATadr 	= NAT address for implicit NAT
#	%obj_NATtype 	= 0=hide, 1=static
#	%obj_members 	= members, if a group
#	%obj_comment 	= comment for the object
#	%obj_colour 	= colour the object is to be displayed with 
#	%obj_used 	= wether the object is used in the rulbase
#			  (set later when evaluating the ruleset)

sub ReadNetworkObjects{
    my ($dummy)     = '';
    my ($name)      = '';
    my ($lineparam) = '';
    my ($amember)   = '';
    my ($members)   = '';

    $obj_number = 0;
	$number_of_if = 0;
	
    while ( ($line = <INFILE>) && ( "$line" ne "\t)\n" ) ) {
          chop $line;
          while ( $line !~ /\t\t\: \(/ )  {
                $line = <INFILE>;
                chop $line;
          }
          ($dummy,$name) = split(/\(/,$line,2);
#		  $name =~ s/ /_/g;  # translate whitespaces in objetcnames to _
		  $name =~ s/\"//g;  # remove quotes
          $amember = '';
          $members = '';
          while ( ($line = <INFILE>) && ( "$line" ne "\t\t)\n" ) ) {
                chop $line;
                ($dummy,$lineparam) = split(/\(/,$line,2) ;
                ($lineparam,$dummy) = split(/\)/,$lineparam,2) ;
                if ( $line =~ /^\t\t\t:type \(/ ){
		   $obj_type{$name} = lc($lineparam);
                } elsif ( $line =~ /^\t\t\t:location \(/ ){
		   $obj_location{$name} = ("$lineparam" eq 'external') * 1;
                } elsif ( $line =~ /^\t\t\t:firewall \(/ ){
		   $obj_is_fw1{$name} = ("$lineparam" eq 'installed') * 1;
                } elsif ( $line =~ /^\t\t\t:ipaddr \(/ ){
 		   $obj_ipaddr{$name} = $lineparam;
		   $obj_ipaddr{$name} =~ s/\"//g;  # remove quotes
		   $obj_ipaddr{$name} =~ s/ //g;  # remove blank
                } elsif ( $line =~ /^\t\t\t:netmask \(/ ){
           $obj_netmask{$name} = $lineparam;
		   $obj_netmask{$name} =~ s/\"//g;  # remove quotes
		   $obj_netmask{$name} =~ s/ //g;  # remove blanks
                } elsif ( $line =~ /^\t\t\t:valid_ipaddr \(/ ){
 		   $obj_NATadr{$name} = $lineparam;
                } elsif ( $line =~ /^\t\t\t:netobj_adrtr_method \(/ ){
		   $obj_NATtype{$name} = ("$lineparam" eq 'adrtr_static') * 1;
                } elsif ( $line =~ /^\t\t\t:comments \(/ ){
 		   $obj_comment{$name} = $lineparam;
                } elsif ( $line =~ /^\t\t\t:color \(/ ){
 		   $obj_colour{$name} = lc($lineparam);
                } elsif ( $line =~ /^\t\t\t: / ){
                   ($dummy,$amember) = split(/: /,$line,2) ;
#				   $member =~ s/ /_/g;  # translate whitespaces in objetcnames to _
		 		   $amember =~ s/\"//g;  # remove quotes
                  $members = "$members§$amember";
                } elsif ($line =~ /^\t\t\t\t:ipaddr \(/ ){
			$tmp_ipaddr = $lineparam;
			$tmp_ipaddr =~ s/\"//g;  # remove quotes
			$tmp_ipaddr =~ s/ //g;  # remove blanks
				} elsif ($line =~ /^\t\t\t\t:netmask \(/ ){
			$tmp_netmask = $lineparam;
			$tmp_netmask =~ s/\"//g;  # remove quotes
			$tmp_netmask =~ s/ //g;  # remove blanks
				} elsif ($line =~ /^\t\t\t\t:officialname \(/ ){
			$tmp_officialname = $lineparam;
				} elsif ($line =~ /^\t\t\t\t:description \(/ ){
			$tmp_description = $lineparam;
				} elsif ($line =~ /^\t\t\t\t:antispoof \(/ ){
			$tmp_antispoof = $lineparam;
				} elsif ($line =~ /^\t\t\t\t:ifindex \(/ ){
			$tmp_ifindex = $lineparam;
			$number_of_if ++;
			
			$obj_ipaddr_if[$tmp_ifindex]{$name} = $tmp_ipaddr;
			$obj_netmask_if[$tmp_ifindex]{$name} = $tmp_netmask;
			$obj_officialname_if[$tmp_ifindex]{$name} = $tmp_officialname;
			$obj_description_if[$tmp_ifindex]{$name} = $tmp_description;
			$obj_antispoof_if[$tmp_ifindex]{$name} = $tmp_antispoof;
			$obj_num_if{$name} = $number_of_if;
			
				} elsif ($line =~ /^\t\t\t\t\t:access \(/ ){
			$obj_access_if[$tmp_ifindex]{$name} = $lineparam;
				} elsif (($line =~ /^\t\t\t\t:refname \(/ ) or ($line =~ /^\t\t\t\t\t:refname \(/ )){
			$lineparam =~ s /#_//g;
			$lineparam =~ s /\"//g;
			$obj_allowed_if[$tmp_ifindex]{$name} = $lineparam;
				}

				
          }
		 
		  $number_of_if = 0;
				  
          if ( "$obj_type{$name}" eq 'group' ) {
             ($dummy,$members) = split (/§/, $members, 2);
             $obj_members{$name} = $members;
          }
	  $obj_name[$obj_number] = $name;
	  $obj_number += 1;
          &PrintLog('.');
    }
	
    
	$obj_type{'Any'} = 'any';
    if ($FLAG_sortbytype) {
    	@obj_name = sort { $obj_type{"$a"} cmp $obj_type{"$b"} or lc($a) cmp lc($b) } @obj_name;
    } else {
    	@obj_name = sort { lc($a) cmp lc($b) } @obj_name;
    }
}

##########################################################################
# read all network services defined
#
# service variables where svc_name equals the hash for each of these:
#
#	$svc_number 	= number of services read
#	@svc_name 	= names of all services
#	%svc_type 	= tcp, udp, icmp, rpc, group
#	%svc_dst_port 	= destination port
#	%svc_src_low 	= range source port from
#	%svc_src_high 	= range source port to
#	%svc_match	= if MATCH defines (for RPCs)
#	%svc_prolog	= RPC prolog
#	%svc_members 	= members, if a group
#	%svc_comment 	= comment for the service
#	%svc_colour 	= colour of the service
#	%svc_used 	= wether the service is used in the rulbase
#			  (set later when evaluating the ruleset)
sub ReadServices{
    my ($dummy)    = '';
    my ($name)     = '';
    my ($amember)  = '';
    my ($members)  = '';

    while ( ($line = <INFILE>) && ( "$line" ne "\t)\n" ) ) {
          chop $line;
          while ( $line !~ /\t\t\: \(/ )  {
                $line = <INFILE>;
                chop $line;
          }
          ($dummy,$name) = split(/\(/,$line,2) ;
#  		  $name =~ s/ /_/g; # translate whitespaces in objetcnames to _
  		  $name =~ s/\"//g; # remove
          $amember  = '';
          $members  = '';
          while ( ($line = <INFILE>) && ( "$line" ne "\t\t)\n" ) ) {
                chop $line;
                ($dummy,$lineparam) = split(/\(/,$line,2) ;
                ($lineparam,$dummy) = split(/\)/,$lineparam,2) ;
                if ("$lineparam" =~ /"\>/){  # this stands for ports bigger than...
                   ($dummy,$lineparam) = split(/\>/,$lineparam,2) ;
                   ($lineparam,$dummy) = split(/"/,$lineparam,2) ;
                   $lineparam = "$lineparam:";
                }
                if ( $line =~ /^\t\t\t:type \(/ ){
                   $svc_type{$name} = lc($lineparam);
                } elsif ( $line =~ /^\t\t\t:exp \(/ ){           # ICMP extensions
                   $lineparam =~ s/\"//g;
				   
				   ($exp_type,$exp_param) = split(/=/,$lineparam,2);
				   $exp_type =~ s/ //g;
				   $exp_param =~ s/ //g;

				   if ($exp_type eq "icmp_type") {
				   		$svc_icmp_type{$name} = $exp_param;
				   }
				   if ($exp_type eq "ip_p"){
				   		$svc_ip_protocol{$name} = $exp_param;
						$svc_type{$name} = "ip";
				   }
				   if ($exp_type eq "tcp,dport" ){
				   		($exp_param,$dummy) = split(/,/,$exp_param,2);
				   		($exp_param,$dummy) = split(/ordport=/,$exp_param,2);
				   		$svc_dst_port{$name} = $exp_param;
						$svc_type{$name} = "tcp";
				   }
				   if ($exp_type eq "tcp,(sport"){
				   		$svc_src_port{$name} = $exp_param;
						$svc_type{$name} = "tcp";
				   }
				   
				   ############# TODO #########################
				   if ($exp_type =~ /^udp,uh_dport/ ){
				        print "Traceroute type=$exp_type\n";
				   		$svc_src_port{$name} = $exp_type;
						$svc_type{$name} = "udp";
				   }
				   
                   $svc_dst_port{$name} = $ICMPtranslate{$lineparam};
                } elsif ( $line =~ /^\t\t\t:port \(/ ){          # TCP/UDP destination port
                   $lineparam =~ tr/-/:/;
                   $svc_dst_port{$name} = $lineparam;
                } elsif ( $line =~ /^\t\t\t:src_port_from \(/ ){
                   $svc_src_low{$name} = $lineparam;
                } elsif ( $line =~ /^\t\t\t:src_port_to \(/ ){
                   $svc_src_high{$name} = $lineparam;
                } elsif ( $line =~ /^\t\t\t:prematch \(/ ){
                   $svc_match{$name} = $lineparam;
                } elsif ( $line =~ /^\t\t\t:prolog \(/ ){
                   $svc_prolog{$name} = $lineparam;
                } elsif ( $line =~ /^\t\t\t:comments \(/ ){
                   $svc_comment{$name} = $lineparam;
                } elsif ( $line =~ /^\t\t\t:color \(/ ){
                   $svc_colour{$name} = lc($lineparam);
                } elsif ( $line =~ /^\t\t\t: / ){
                   ($dummy,$amember) = split(/: /,$line,2) ;
#				   $member =~ s/ /_/g;  # translate whitespaces in objetcnames to _
				   $member =~ s/\"//g;  # translate whitespaces in objetcnames to _
                   $members = "$members§$amember";
                }
          }
	  $svc_name[$svc_number] = $name;
          if ( "$svc_type{$name}" eq 'group' ) {
                ($dummy,$members) = split (/§/, $members, 2);
                $svc_members{$name} = $members;
           }
           &PrintLog('.');
	   $svc_number += 1;
    }
    &PrintLog ("\n");
    $svc_type{'Any'} = 'any';
    if ($FLAG_sortbytype) {
    	@svc_name = sort { $svc_type{"$a"} cmp $svc_type{"$b"} or lc($a) cmp lc($b) } @svc_name;
    } else {
    	@svc_name = sort { lc($a) cmp lc($b) } @svc_name;
    }
}
##########################################################################
# read properties
#
#	%prop_setting{'XXX'}	= setting for XXX
#
#	of interest with respect to implicit rules:
#		rip, domain_udp, domain_tcp, established,
#		    icmpenable, fw1enable ==  true / false
#		rip_p, domain_udp_p, domain_tcp_p, established_p,
#		    icmpenable_p, fw1enable_p ==  first / "before last" / last
#
sub ReadProperties{
    my($line) = '';
    my($par)  = '';
    my($set)  = '';
    my($rest) = '';
    my($dump) = '';
    
    while ( ($line = <INFILE>) && ( fromdos("$line") ne "\t)" ) ) {
          $line = fromdos($line);
          &PrintLog('.');
          if ( "$line" =~ m/\t\t:.* \(.*\)$/ ){
	     ($par,$set) = split(/ \(/, $line, 2);
	     ($dump,$par) = split(/:/, $par, 2);
	     $set =~ s/\)//g;
             $prop_setting{"$par"} = "$set";
          }
    }
    &PrintLog("\n");
}


##########################################################################
# recursively set usage on objects
sub SetObjUsed{
    my ($index) = $_[0];
    my ($single) = '';
    my (@members);

    $obj_used{"$index"} += 1;		
    if ( "$obj_type{$index}" eq 'group'){
    	@members = split (/ /,$obj_members{$index});
	foreach $single (@members) {
	    &SetObjUsed("$single");
	}
    }
}


##########################################################################
# recursively set usage on services
sub SetSvcUsed{
    my ($index) = $_[0];
    my ($single) = '';
    my (@members);
    
    $svc_used{"$index"} += 1;		
    if ( "$svc_type{$index}" eq 'group'){
    	@members = split (/ /,$svc_members{$index});
	foreach $single (@members) {
	    &SetSvcUsed("$single");
	}
    }
}


##########################################################################
# read NAT rules
#
#	$nat_number	 	= number of NAT rules read (array starting at zero)
#	@nat_orig_from 		= original source object
#	@nat_orig_to 		= original destination object
#	@nat_orig_svc 		= original service object
#	@nat_transl_from 	= translated source object
#	@nat_transl_from_methd 	= translated source object method: 0=hide, 1=static
#	@nat_transl_to 		= translated destination object
#	@nat_transl_to_methd	= translated destination object method: 0=hide, 1=static
#	@nat_transl_svc 	= translated service object
#	@nat_transl_svc_methd 	= translated service object method: 0=hide, 1=static
#	@nat_install_on		= install rule on...
#
sub ReadNATrules{
    my ($mode)    = 'none';
    my ($param)   = '';
    my ($dummy)   = '';
    my ($wert)    = '';
    my ($user)    = '';
    my ($fileEOF) = 1;

    $nat_number = -1;
    while ( ( $line !~ /^\t\:filename \(/ ) && $fileEOF ) {
	 fromdos($line);
	 $mode    = 'none';
	 if ( $line !~ /^\t:rule_adtr \(/ ) {
	       &PrintLog('.');
	 } else {
	    $nat_number  += 1;
	    &PrintLog("\n\trule_adtr($nat_number)");

	    while ( ($line = <INFILE>) && ( fromdos("$line") ne "\t)" ) ) {
	       fromdos($line);
	       &PrintLog('.');
	       if ( $line =~ /^\t\t:comments \(\"/ ){
	               ($dummy,$wert) = split(/\(\"/,$line,2) ;
	               ($nat_comment[$nat_number],$dummy) = split(/\"/,$wert,2) ;
	       } elsif ( $line =~ /^\t\t:disabled \(true\)/ ){
	               $nat_disabled[$nat_number] = 1;
	       } elsif ( $line =~ /^\t\t:(src_adtr|dst_adtr|services_adtr|src_adtr_translated|dst_adtr_translated|services_adtr_translated|install) \(/ ){
	               ($dummy,$wert) = split(/:/,$line,2) ;
	               ($mode,$dummy) = split(/ /,$wert,2) ;
	       } elsif ("$mode" eq 'src_adtr') {
	           if ($line =~ /^\t\t\t: /) {
	               ($dummy,$wert) = split(/: /,$line,2) ;
	               $wert=~s/^\(//;
#		   		   $wert =~ s/ /_/g; # translate whitespaces in objetcnames to _
		   		   $wert =~ s/\"//g; # remove quotes
	               $nat_orig_from[$nat_number] = "$wert";
	               &SetObjUsed("$wert");
	           }
	       } elsif ("$mode" eq 'dst_adtr') {
	           if ($line =~ /^\t\t\t: /) {
	               ($dummy,$wert) = split(/: /,$line,2) ;
	               $wert=~s/^\(//;
#		   		   $wert =~ s/ /_/g; # translate whitespaces in objetcnames to _
		   		   $wert =~ s/\"//g; # remove quotes
	               $nat_orig_to[$nat_number] = "$wert";
	               &SetObjUsed("$wert");
	           }
	       } elsif ("$mode" eq 'services_adtr') {
	           if ($line =~ /^\t\t\t: /) {
	               ($dummy,$wert) = split(/: /,$line,2) ;
	               $wert=~s/^\(//;
#		   		   $wert =~ s/ /_/g; # translate whitespaces in objetcnames to _
		   		   $wert =~ s/\"//g; # remove quotes
	               $nat_orig_svc[$nat_number] = "$wert";
	               &SetSvcUsed("$wert");
	           }
	       } elsif ("$mode" eq 'src_adtr_translated') {
	           if ($line =~ /^\t\t\t: /) {
	               ($dummy,$wert) = split(/: /,$line,2) ;
	               $wert=~s/^\(//;
#		   		   $wert =~ s/ /_/g; # translate whitespaces in objetcnames to _
		   		   $wert =~ s/\"//g; # remove quotes
		       if ( lc("$wert") eq 'any' ) { $wert = 'Original'; }
	               $nat_transl_from[$nat_number] = "$wert";
	               &SetObjUsed("$wert");
	           } elsif ($line =~ /^\t\t\t:adtr_method/) {
	               if ( $line =~ m/adtr_method_static/ ) {
	                    $nat_transl_from_methd[$nat_number] = 1;
	               } else {
	                    $nat_transl_from_methd[$nat_number] = 0;
	               }
	           }
	       } elsif ("$mode" eq 'dst_adtr_translated') {
	           if ($line =~ /^\t\t\t: /) {
	               ($dummy,$wert) = split(/: /,$line,2) ;
	               $wert=~s/^\(//;
#		   		   $wert =~ s/ /_/g; # translate whitespaces in objetcnames to _
		   		   $wert =~ s/\"//g; # remove quotes
		       if ( lc("$wert") eq 'any' ) { $wert = 'Original'; }
	               $nat_transl_to[$nat_number] = "$wert";
	               &SetObjUsed("$wert");
	               $nat_transl_to_methd[$nat_number] = 1;
	           }
	       } elsif ("$mode" eq 'services_adtr_translated') {
	           if ($line =~ /^\t\t\t: /) {
	               ($dummy,$wert) = split(/: /,$line,2) ;
	               $wert=~s/^\(//;
#		   		   $wert =~ s/ /_/g; # translate whitespaces in objetcnames to _
		   		   $wert =~ s/\"//g; # remove quotes
		       if ( lc("$wert") eq 'any' ) { $wert = 'Original'; }
	               $nat_transl_svc[$nat_number] = "$wert";
	               &SetSvcUsed("$wert");
	               $nat_transl_svc_methd[$nat_number] = 1;
	           }
	       } elsif ("$mode" eq 'install') {
	           if  ( $line =~ /^\t\t\t: / ) {
	               ($dummy,$wert) = split(/: /,$line,2) ;
	               $wert=~s/^\(//;
#		   		   $wert =~ s/ /_/g; # translate whitespaces in objetcnames to _
		   		   $wert =~ s/\"//g; # remove quotes
	               if ( "$nat_install_on[$nat_number]" eq '') {
	                   $nat_install_on[$nat_number] = "$wert";
	               } else {        
	                   $nat_install_on[$nat_number] = "$nat_install_on[$nat_number]§$wert";
	               }
	           }
	        }
	    } #--- inner while
	 } #--- else (i.e. rule processing)
	 $fileEOF = ($line = <INFILE>);
    } #--- outer while
}



##########################################################################
# read Access rules
#
#	$access_number	 	= number of access rules read (array starting at zero)
#	@access_disabled	= rule enabled=0, rule disabled=1
#	@access_from		= list of source objects, separated by space
#	@access_from_negated	= from-list negated=1, standard=0
#	@access_to		= list of destination objects, separated by space
#	@access_to_negated	= to-list negated=1, standard=0
#	@access_services	= list of services, separated by space
#	@access_services_negated= services-list negated=1, standard=0
#	@access_action		= action: deny, allow, encrypt, ...
#	@access_track		= log: long, short, account, ...
#	@access_time		= time object (not really implemented yet)
#	@access_install_on	= install rule on...
#	@access_comment		= comment on this particular rule
#
sub ReadAccessRules{
    my ($mode)    = 'none';
    my ($param)   = '';
    my ($dummy)   = '';
    my ($wert)    = '';
    my ($fileEOF) = 1;

    $access_number = -1;
    while ( ( $line !~ /^\t\:rule_adtr \(/ ) && $fileEOF ) {
          fromdos($line);
          $mode    = 'none';
          if ( $line !~ /^\t:rule \(/ ) {
                &PrintLog('.');
          } else {
             $access_number  += 1;
             &PrintLog("\n\trule($access_number)");

             while ( ($line = <INFILE>) && ( fromdos("$line") ne "\t)" ) ) {
		fromdos($line);
		&PrintLog('.');
		if ( $line =~ /^\t\t:comments \(\"/ ){
			($dummy,$wert) = split(/\(\"/,$line,2) ;
			($access_comment[$access_number],$dummy) = split(/\"/,$wert,2) ;
		} elsif ( $line =~ /^\t\t:disabled \(true\)/ ){
			$access_disabled[$access_number] = 1;
		} elsif ( $line =~ /^\t\t:(src|dst|services|action|track|install|time) \(/ ){
			($dummy,$wert) = split(/:/,$line,2) ;
			($mode,$dummy) = split(/ /,$wert,2) ;
		} elsif ("$mode" eq 'src') {
                      if ($line =~ /^\t\t\t: /) {
			($dummy,$wert) = split(/: /,$line,2) ;
#			$wert =~ s/ /_/g;# translate whitespaces in objetcnames to _
			$wert =~ s/\"//g; # remove quotes
			if ( "$access_from[$access_number]" eq '') {
			    $access_from[$access_number] = "$wert";
			} else {	
			    $access_from[$access_number] = "$access_from[$access_number]§$wert";
			}
			&SetObjUsed("$wert");
                      } elsif ($line =~ /^\t\t\t:op \(\"not in\"\)/) {
			$access_from_negated[$access_number] = 1;
                      }
		} elsif ("$mode" eq 'dst') {
                      if ($line =~ /^\t\t\t: /) {
			($dummy,$wert) = split(/: /,$line,2) ;
#			$wert =~ s/ /_/g; # translate whitespaces in objetcnames to _
			$wert =~ s/\"//g; # remove quotes
			if ( "$access_to[$access_number]" eq '') {
			    $access_to[$access_number] = "$wert";
			} else {	
			    $access_to[$access_number] = "$access_to[$access_number]§$wert";
			}
			&SetObjUsed("$wert");
                      } elsif ($line =~ /^\t\t\t:op \(\"not in\"\)/) {
			$access_to_negated[$access_number] = 1;
                      }
		} elsif ("$mode" eq 'services') {
		      ($dummy,$wert) = split(/\(\"/,$line,2) ;   #--- just for security servers
		      ($wert,$dummy) = split(/\"/,$wert,2) ;
#			$wert =~ s/ /_/g; # translate whitespaces in objetcnames to _
			$wert =~ s/\"//g; # remove quotes
                      if ($line =~ /^\t\t\t: \(\"smtp-\>/) {
	 		if ( "$access_services[$access_number]" eq '') {
			    $access_services[$access_number] = "$wert";
			} else {
			    $access_services[$access_number] = "$access_services[$access_number]§$wert";
			}
                      } elsif ($line =~ /^\t\t\t: \(\"(http-\>.*)\"/) {
                        if ( "$access_services[$access_number]" eq '') {
			    $access_services[$access_number] = "$wert";
			} else {
			    $access_services[$access_number] = "$access_services[$access_number]§$wert";
			}
                     } elsif ($line =~ /^\t\t\t: \(\"ftp-\>/) {
	 		if ( "$access_services[$access_number]" eq '') {
			    $access_services[$access_number] = "$wert";
			} else {
			    $access_services[$access_number] = "$access_services[$access_number]§$wert";
			}
                      } elsif ($line =~ /^\t\t\t: /) {
			($dummy,$wert) = split(/: /,$line,2) ;
#			$wert =~ s/ /_/g; # translate whitespaces in objetcnames to _
			$wert =~ s/\"//g; # remove quotes
			if ( "$access_services[$access_number]" eq '') {
			    $access_services[$access_number] = "$wert";
			} else {
			    $access_services[$access_number] = "$access_services[$access_number]§$wert";
			}
			&SetSvcUsed("$wert");
                      } elsif ($line =~ /^\t\t\t:op \(\"not in\"\)/) {
			$access_services_negated[$access_number] = 1;
                      }
		} elsif ("$mode" eq 'action') {
		      if ( "$wert" eq '"Client Encrypt"') { $wert = 'clientencrypt' }
		      if  ( $line =~ /^\t\t\t: \([a-z]*/ ) {
			($dummy,$wert) = split(/: \(/,$line,2) ;
		        if ( "$wert" eq '"Client Encrypt"') { $wert = 'clientencrypt' }
			$access_action[$access_number] = $wert;
                      }
		} elsif ("$mode" eq 'track') {
		      if  ( $line =~ /^\t\t\t: [A-Z]([a-z]*)/ ) {
			($dummy,$wert) = split(/: /,$line,2) ;
			$access_track[$access_number] = "$wert";
                      }
		} elsif ("$mode" eq 'install') {
		      if  ( $line =~ /^\t\t\t: / ) {
			($dummy,$wert) = split(/: /,$line,2) ;
			$wert =~ s/\(//; # Handle Gateway object
			if ( "$access_install_on[$access_number]" eq '') {
			    $access_install_on[$access_number] = "$wert";
			} else {	
			    $access_install_on[$access_number] = "$access_install_on[$access_number]§$wert";
			}
                      }
		} elsif ("$mode" eq 'time') {
		      if  ( $line =~ /^\t\t\t: .*/ ) {
			($dummy,$wert) = split(/: /,$line,2) ;
			if ( "$access_time[$access_number]" eq '') {
			    $access_time[$access_number] = "$wert";
			} else {	
			    $access_time[$access_number] = "$access_time[$access_number]§$wert";
			}
                      }
	 	}
	     } #--- inner while
	  } #--- else (i.e. rule processing)
	  $fileEOF = ($line = <INFILE>);
    } #--- outer while
}


##########################################################################
# print NAT into XML file
#	filename for the resulting file
sub dumpNAT {
    my $writer = $_[0];
    my $name = $_[1];
	my $j;
	my $id;
	my $comment;
	my $hexid;
	my $singlehexid;
	my $noinstall,@install_members,$install_single;

	$writer->startTag("NAT", "id"=>"id_nat_$name");

		for ( $j = 0; $j<=$nat_number; $j++ ) {

			$noinstall = 0;
			@install_members = split(/ /,$nat_install_on[$i]);
			foreach $install_single (@install_members) {
				if ($install_single eq $name){
					$noinstall = 0;
					last;
				} elsif ($install_single eq "Gateways"){
					$noinstall = 0;
					last;
				} else {
					$noinstall = 1;
				}
			}
			
			if ($noinstall){
				next;
			}

			$comment = xmlencode($nat_comment[$j]);

			$hexid=md5_hex($name);
			$id="idfw". $hexid. "nat$j";
			$writer->startTag("NATRule", "disabled"=>"False", "id"=>$id, 
								"comment"=>$comment,"position"=>$j);

			$writer->startTag("OSrc", "neg"=>"False");
			@members = split (/§/,$nat_orig_from[$j]);
			foreach $single (@members) {
				if ( ($nat_orig_from[$j] eq "Any") or ($nat_orig_from[$j] eq "Original")){
					$writer->emptyTag("ObjectRef", "ref"=>"sysid0");
				} else {
					$singlehexid=md5_hex($single);
					$writer->emptyTag("ObjectRef", "ref"=>"id$singlehexid");
					$writer->comment($single)  if $FLAG_comments;
				}
			}
			$writer->endTag("OSrc");

			$writer->startTag("ODst", "neg"=>"False");
			@members = split (/§/,$nat_orig_to[$j]);
			foreach $single (@members) {
				if ( ($nat_orig_to[$j] eq "Any") or ($nat_orig_to[$j] eq "Original") ){
					$writer->emptyTag("ObjectRef", "ref"=>"sysid0");
				} else {
					$singlehexid=md5_hex($single);
					$writer->emptyTag("ObjectRef", "ref"=>"id$singlehexid");
					$writer->comment($single) if $FLAG_comments;
				}
			}
			$writer->endTag("ODst");

			$writer->startTag("OSrv", "neg"=>"False");
			@members = split (/§/,$nat_orig_svc[$j]);
			foreach $single (@members) {
				if ( ($nat_orig_svc[$j] eq "Any") or ($nat_orig_svc[$j] eq "Original") ){
					$writer->emptyTag("ServiceRef", "ref"=>"sysid1");
				} else {
					$singlehexid=md5_hex($single);
					$writer->emptyTag("ServiceRef", "ref"=>"id$singlehexid");
					$writer->comment($single) if $FLAG_comments;
				}
			}
			$writer->endTag("OSrv");

			$writer->startTag("TSrc", "neg"=>"False");
			@members = split (/§/,$nat_transl_from[$j]);
			foreach $single (@members) {
				if ( ($nat_transl_from[$j] eq "Any") or ($nat_transl_from[$j] eq "Original") ){
					$writer->emptyTag("ObjectRef", "ref"=>"sysid0");
				} else {
					$singlehexid=md5_hex($single);
					$writer->emptyTag("ObjectRef", "ref"=>"id$singlehexid");
					$writer->comment($single) if $FLAG_comments;
				}
			}
			$writer->endTag("TSrc");

			$writer->startTag("TDst", "neg"=>"False");
			@members = split (/§/,$nat_transl_to[$j]);
			foreach $single (@members) {
				if ( ($nat_transl_to[$j] eq "Any") or ($nat_transl_to[$j] eq "Original") ){
					$writer->emptyTag("ObjectRef", "ref"=>"sysid0");
				} else {
					$singlehexid=md5_hex($single);
					$writer->emptyTag("ObjectRef", "ref"=>"id$singlehexid");
					$writer->comment($single) if $FLAG_comments;
				}
			}
			$writer->endTag("TDst");

			$writer->startTag("TSrv", "neg"=>"False");
			@members = split (/§/,$nat_transl_svc[$j]);
			foreach $single (@members) {
				if ( ($nat_transl_svc[$j] eq "Any") or ($nat_transl_svc[$j] eq "Original") ){
					$writer->emptyTag("ServiceRef", "ref"=>"sysid1");
				} else {
					$singlehexid=md5_hex($single);
					$writer->emptyTag("ServiceRef", "ref"=>"id$singlehexid");
					$writer->comment($single) if $FLAG_comments;
				}
			}
			$writer->endTag("TSrv");

			$writer->emptyTag("NATRuleOptions");
			$writer->endTag("NATRule");
		}
	$writer->endTag("NAT");

}

##########################################################################
# print Policy into XML file
#	filename for the resulting file
sub dumpPolicy {
    my $writer = $_[0];
    my $name = $_[1];
	my $i;
	my $comment;
	my $hexid;
	my $singlehexid;
	my $noinstall,@install_members,$install_single;

	$writer->startTag("Policy", "id"=>"id_policy_$name");
		for ( $i = 0; $i<=$access_number; $i++ ) {
			
			$noinstall = 0;
			@install_members = split(/§/,$access_install_on[$i]);
			foreach $install_single (@install_members) {
				if ($install_single eq $name){
					$noinstall = 0;
					last;
				} elsif ($install_single eq "Gateways"){
					$noinstall = 0;
					last;
				} else {
					$noinstall = 1;
				}
			}
			
			if ($noinstall){
				next;
			}

			$comment = xmlencode($access_comment[$i]);

			if ( ($access_action[$i] eq "\"Client Auth\"") or ($access_action[$i] eq "\"User Auth\"") ){
				print "We should implement: $access_action[$i] in Rule $i\n";
				next;
			}
			$access_action[$i] = "Accept" if ($access_action[$i] eq "accept") ;
			$access_action[$i] = "Deny" if ($access_action[$i] eq "drop") ;
			$access_action[$i] = "Reject" if ($access_action[$i] eq "reject") ;
			$access_disabled[$i] = "False" if ($access_disabled[$i] eq "") ;
			$access_disabled[$i] = "True" if ($access_disabled[$i] eq "1") ;
				
			if (($access_track[$i] eq "Long") or 
				($access_track[$i] eq "Alert") or
				($access_track[$i] eq "SnmpTrap") or
				($access_track[$i] eq "Short")){
				$access_track[$i] ="True"
			} else {
				$access_track[$i] ="False"
			}
			if ( $access_from_negated[$i] eq "1" ){
				$access_from_negated[$i] = "True"
			} else {
				$access_from_negated[$i] = "False"
			}
			if ( $access_to_negated[$i] eq "1" ){
				$access_to_negated[$i] = "True"
			} else {
				$access_to_negated[$i] = "False"
			}
			if ( $access_services_negated[$i] eq "1" ){
				$access_services_negated[$i] = "True"
			} else {
				$access_services_negated[$i] = "False"
			}
			
			$hexid=md5_hex($name);
			$id = "idfw". $hexid. "rule$i";
			$writer->startTag("PolicyRule", "id"=>$id, "action"=>$access_action[$i],
								"disabled"=>$access_disabled[$i],"log"=>$access_track[$i],
								 "position"=>$i, "comment"=>$comment );
				
		$writer->startTag("Src", "neg"=>$access_from_negated[$i]);	
		@members = split (/§/,$access_from[$i]);
		foreach $single (@members) {
			if ( $access_from[$i] =~ m/Any/ ){
				$writer->emptyTag("ObjectRef", "ref"=>"sysid0");
			} else {
				$singlehexid=md5_hex($single);
				$writer->emptyTag("ObjectRef", "ref"=>"id$singlehexid");
				$writer->comment($single) if $FLAG_comments;
			}
		}
		$writer->endTag("Src");
			
		$writer->startTag("Dst", "neg"=>$access_to_negated[$i]);				
		@members = split (/§/,$access_to[$i]);
		foreach $single (@members) {
			if ( $access_to[$i] =~ m/Any/ ){
				$writer->emptyTag("ObjectRef", "ref"=>"sysid0");
			} else {
				$singlehexid=md5_hex($single);
				$writer->emptyTag("ObjectRef", "ref"=>"id$singlehexid");
				$writer->comment($single) if $FLAG_comments;
			}
		}
		$writer->endTag("Dst");
			
		$writer->startTag("Srv", "neg"=>$access_services_negated[$i]);				
		@members = split (/§/,$access_services[$i]);
		foreach $single (@members) {
			if ( $access_services[$i] =~ m/Any/ ){
				$writer->emptyTag("ServiceRef", "ref"=>"sysid1");
			} else {
				$singlehexid=md5_hex($single);
				$writer->emptyTag("ServiceRef", "ref"=>"id$singlehexid");
				$writer->comment($single) if $FLAG_comments;
			}
		}
		$writer->endTag("Srv");
				
		$writer->startTag("When", "neg"=>"False");
		$writer->emptyTag("IntervalRef", "ref"=>"sysid2");
		$writer->endTag("When");

		$writer->emptyTag("PolicyRuleOptions");

		$writer->endTag("PolicyRule");
		}
	$writer->endTag("Policy");

}
##########################################################################
# print FirewallInterface into XML file
#	filename for the resulting file
sub dumpInterface {
    my $writer = $_[0];
    my $name = $_[1];
	my $comment;
	my $hexid;
	my $singlehexid;

	for ( $i = 0; $i<$obj_num_if{$name}; $i++ ) {
	$hexid=md5_hex($name.$obj_officialname_if[$i]{$name});
	$writer->startTag("Interface", "address"=>$obj_ipaddr_if[$i]{$name}, "dyn"=>"False",
						"id"=>"idif$hexid", "label"=>$obj_officialname_if[$i]{$name},
						"name"=>$obj_description_if[$i]{$name}, "netmask"=>$obj_netmask_if[$i]{$name},
						"physAddress"=>"", "security_level"=>"0",);

#		printf "$name $obj_officialname_if[$i]{$name} $obj_allowed_if[$i]{$name}\n";
#		if (($obj_antispoof_if[$i]{$name} eq "true") 
#			and ($obj_access_if[$i]{$name} ne "default")
#			and (defined $obj_allowed_if[$i]{$name}) ){
		
#		$writer->startTag("InterfacePolicy", "id"=>"idifp$hexid");
#		$writer->startTag("PolicyRule", "id"=>"idifpr$hexid",
#							"action"=>"Deny", "disabled"=>"False", "log"=>"True", "position"=>"0");

#			if ($obj_access_if[$i]{$name}){
				
#				if ($obj_access_if[$i]{$name} eq "this"){
#					$access = "sysid0";
#				} else {
#					$singlehexid=md5_hex($obj_access_if[$i]{$name});					
#					$access = "id$singlehexid";
#				}
#			$writer->startTag("Src", "neg"=>"True");
#			$writer->emptyTag("ObjectRef","ref"=>$access);
#			$writer->endTag("Src");
#			} elsif ($obj_allowed_if[$i]{$name}){
#			$singlehexid=md5_hex($obj_allowed_if[$i]{$name});					
#			$writer->startTag("Src", "neg"=>"True");
#			$writer->emptyTag("ObjectRef","ref"=>"id$singlehexid");
#			$writer->endTag("Src");
#			}

#		$writer->startTag("Dst", "neg"=>"False");
#		$writer->emptyTag("ObjectRef","ref"=>"sysid0");
#		$writer->endTag("Dst");
#		$writer->startTag("Srv", "neg"=>"False");
#		$writer->emptyTag("ServiceRef","ref"=>"sysid1");
#		$writer->endTag("Srv");

#		$writer->emptyTag("PolicyRuleOptions");
#		$writer->endTag("PolicyRule");
#		$writer->endTag("InterfacePolicy");
#		}

	$writer->endTag("Interface");
				
	}

}

##########################################################################
# print FireWalls into XML file
#	filename for the resulting file
sub dumpFirewalls {
    my $writer = $_[0];
	my $name;
	my $comment;
	my $hexid;

	foreach $name (@obj_name){
		if ( ($obj_used{$name}) and ($obj_type{$name} eq "gateway")){
			$comment = xmlencode($obj_comment{$name});
			$hexid=md5_hex($name);
			
			$writer->startTag("Firewall", "address"=>$obj_ipaddr{$name}, "id"=>"idfw$hexid", "name"=>$name,
								"host_OS"=>"linux24",
								"platform"=>"iptables",
								"version"=>"",
								"comment"=>$comment
							);
							
			&dumpNAT($writer,$name);
			&dumpPolicy($writer,$name);
			&dumpInterface($writer,$name);
			$writer->emptyTag("FirewallOptions");
			$writer->endTag("Firewall");
		}
	}
	
}

##########################################################################
# print Objects into XML file
#	filename for the resulting file
sub dumpGroupObjects {
    my $writer = $_[0];
	my $name;
	my $hexid;
	my $singlehexid;

	$writer->startTag("ObjectGroup", "id"=>"stdid02", "library"=>"Standard", "name"=>"Groups");
	
	foreach $name (@obj_name){
		if ($obj_type{$name} eq "group") { 
			$hexid=md5_hex($name);
			$writer->startTag("ObjectGroup", "id"=>"id$hexid", "name"=>$name);
			@members = split (/§/,$obj_members{$name});
			foreach $single (@members) {
				$singlehexid=md5_hex($single);
				$writer->emptyTag("ObjectRef", "ref"=>"id$singlehexid");
				$writer->comment($single) if $FLAG_comments;
			}
			$writer->endTag("ObjectGroup");
		}
	}
	
	$writer->endTag("ObjectGroup");
	
}
sub dumpHostObjects {
    my $writer = $_[0];
	my $name;
	my $comment;
	my $hexid;
	
	$writer->startTag("ObjectGroup", "id"=>"stdid03", "library"=>"Standard", "name"=>"Hosts");
	
	foreach $name (@obj_name){
		$comment = xmlencode($obj_comment{$name});

		if (($obj_type{$name} eq "host") or ($obj_type{$name} eq "gateway") or ($obj_type{$name} eq "router")) {
			$hexid=md5_hex($name);

			$writer->startTag("Host", "address"=>$obj_ipaddr{$name}, "id"=>"id$hexid", "name"=>$name,"comment"=>$comment );
			$writer->startTag("HostOptions");

			$writer->emptyTag("Option", "name"=>"snmp_contact");
			$writer->emptyTag("Option", "name"=>"snmp_description");
			$writer->emptyTag("Option", "name"=>"snmp_location");

			$writer->startTag("Option", "name"=>"use_mac_addr_filter");
			$writer->characters("False");
			$writer->endTag("Option");

			$writer->endTag("HostOptions");

			$writer->endTag("Host");
		}
	}

	$writer->endTag("ObjectGroup");
	
}
sub dumpNetworkObjects {
    my ($writer)       = $_[0];
	my $name;
	my $comment;
	my $hexid;
	
	$writer->startTag("ObjectGroup", "id"=>"stdid04", "library"=>"Standard", "name"=>"Networks");
	
	foreach $name (@obj_name){
		$comment = xmlencode($obj_comment{$name});
		$hexid=md5_hex($name);

		if ($obj_type{$name} eq "network") { 
			$writer->emptyTag("Network", "id"=>"id$hexid", "name"=>$name, "address"=>$obj_ipaddr{$name}, "netmask"=>$obj_netmask{$name}, "comment"=>$comment );
			$writer->comment($name) if $FLAG_comments;
		}
	}
	
	$writer->endTag("ObjectGroup");
	
}
##########################################################################
# print Services into XML file
#	filename for the resulting file
#	switch:  1 = if with implicit rules,   0 = explicit only
#	switch:  1 = with all objects,   0 = just the used ones
sub dumpGroupServices {
    my ($writer)       = $_[0];
	my $name;
	my $comment;
	my $hexid;
	my $singlehexid;

	$writer->startTag("ServiceGroup", "id"=>"stdid10", "library"=>"Standard", "name"=>"Groups");
    foreach $name (@svc_name){
		$comment = xmlencode($svc_comment{$name});
		$hexid=md5_hex($name);

		if ($svc_type{$name} eq "group"){
			$writer->startTag("ServiceGroup", "id"=>"id$hexid", "name"=>$name);
			@members = split (/§/,$svc_members{$name});
			foreach $single (@members) {
				$singlehexid=md5_hex($single);
				$writer->emptyTag("ServiceRef", "ref"=>"id$singlehexid");
				$writer->comment($single) if $FLAG_comments;
			}
			$writer->endTag("ServiceGroup");
		}
	}
	$writer->endTag("ServiceGroup");
	
}
sub dumpTCPServices {
    my ($writer)       = $_[0];
	my $name;
	my $comment;
	my $hexid;
	
	$writer->startTag("ServiceGroup", "id"=>"stdid06", "library"=>"Standard", "name"=>"TCP");
    foreach $name (@svc_name){
		$comment = xmlencode($svc_comment{$name});
		$hexid=md5_hex($name);

		if ($svc_type{$name} eq "tcp"){
			$writer->emptyTag("TCPService", 
								"id"=>"id$hexid",
								"name"=>"$name",
								"urg_flag"=>"False", 
								"psh_flag"=>"False", 
								"ack_flag"=>"False", 
								"syn_flag"=>"False", 
								"fin_flag"=>"False",
								"rst_flag"=>"False",
								"dst_range_start"=>$svc_dst_port{$name},
								"dst_range_end"=>"",
								"src_range_start"=>$svc_src_port_low{$name},
								"src_range_end"=>$svc_src_port_high{$name},
								"comment"=>$comment 
							);
			$writer->comment("$name") if $FLAG_comments;

		}
	}
	
	$writer->endTag("ServiceGroup");
	
}
sub dumpUDPServices {
    my ($writer)       = $_[0];
	my $name;
	my $comment;
	my $hexid;
		
	$writer->startTag("ServiceGroup", "id"=>"stdid07", "library"=>"Standard", "name"=>"UDP");
    foreach $name (@svc_name){
		$comment = xmlencode($svc_comment{$name});
		$hexid=md5_hex($name);

		if ($svc_type{$name} eq "udp"){
			$writer->emptyTag("UDPService", 
								"id"=>"id$hexid",
								"name"=>$name,
								"dst_range_start"=>$svc_dst_port{$name},
								"dst_range_end"=>"",
								"src_range_start"=>$svc_src_port_low{$name},
								"src_range_end"=>$svc_src_port_high{$name},
								"comment"=>$comment 
							);
			$writer->comment("$name") if $FLAG_comments;
		}
	}
	$writer->endTag("ServiceGroup");
	
}
sub dumpICMPServices {
    my ($writer)       = $_[0];
	my $name;
	my $comment;
	my $hexid;

	$writer->startTag("ServiceGroup", "id"=>"stdid08", "library"=>"Standard", "name"=>"ICMP");
    foreach $name (@svc_name){
		$comment = xmlencode($svc_comment{$name});
		$hexid=md5_hex($name);

		if ($svc_type{$name} eq "icmp"){
			$writer->emptyTag("ICMPService", 
								"id"=>"id$hexid",
								"name"=>$name,
								"code"=>$icmpcode{$svc_icmp_type{$name}},
								"type"=>$icmptype{$svc_icmp_type{$name}},
								"comment"=>$comment
							);
			$writer->comment("$name") if $FLAG_comments;
		}
	}
	$writer->endTag("ServiceGroup");
	
}
sub dumpIPServices {
    my ($writer)       = $_[0];
	my $name;
	my $comment;
	my $hexid;
	
	$writer->startTag("ServiceGroup", "id"=>"stdid09", "library"=>"Standard", "name"=>"IP");
    foreach $name (@svc_name){
		$comment = xmlencode($svc_comment{$name});
		$hexid=md5_hex($name);
	
		if ($svc_type{$name} eq "ip"){
			$writer->emptyTag("IPService", 
								"id"=>"id$hexid",
								"name"=>$name,
								"protocol_num"=>$svc_ip_protocol{$name},
								"comment"=>$comment 
							);
			$writer->comment("$name") if $FLAG_comments;
		}
	}
	$writer->endTag("ServiceGroup");
	
}
sub dumpUnknownServices {
    my ($writer)       = $_[0];
	my $name;
	my $comment;
	my $hexid;
			
	$writer->startTag("ServiceGroup", "id"=>"stdid13", "library"=>"Standard", "name"=>"Unknown");
    foreach $name (@svc_name){
		$comment = xmlencode($svc_comment{$name});
		$hexid=md5_hex($name);
	
		if (($svc_type{$name} eq "rpc") or ($svc_type{$name} eq "other")){
			$writer->emptyTag("CustomService", 
								"id"=>"id$hexid",
								"name"=>$name,
								"comment"=>$comment 
							);
			$writer->comment("$name") if $FLAG_comments;
		}
	}
	$writer->endTag("ServiceGroup");
	
}


##########################################################################
# print configuration into XML file
#	filename for the resulting file
#	switch:  1 = if with implicit rules,   0 = explicit only
#	switch:  1 = with all objects,   0 = just the used ones
sub Output_to_XML {
    my ($writer)       = $_[0];
    my ($if_implicit)  = $_[1];
    my ($if_allobjs)   = $_[2];
    my ($name)         = '';
	my $now = localtime();
	
	$writer->xmlDecl();
	$writer->comment("Generated: $now by $SCR_NAME ($VERSION)");
	$writer->doctype("FWObjectDatabase",0,"fwbuilder.dtd");
	$writer->startTag("FWObjectDatabase", "xmlns"=>"http://www.fwbuilder.org/1.0/", "version"=>"0.10.5","id"=>"root");
	
	$writer->emptyTag("AnyNetwork","comment"=>"Any Network", "id"=>"sysid0", "library"=>"Standard", "name"=>"Any", "address"=>"0.0.0.0", "netmask"=>"0.0.0.0");
	$writer->emptyTag("AnyIPService", "comment"=>"Any IP Service", "id"=>"sysid1", "library"=>"Standard", "name"=>"Any", "protocol_num"=>"0");
	$writer->emptyTag("AnyInterval", "comment"=>"Any Interval", "from_day"=>"-1", "from_hour"=>"-1", "from_minute"=>"-1", "from_month"=>"-1", "from_weekday"=>"-1", "from_year"=>"-1", "id"=>"sysid2", "library"=>"Standard", "name"=>"Any", "to_day"=>"-1", "to_hour"=>"-1", "to_minute"=>"-1", "to_month"=>"-1", "to_weekday"=>"-1", "to_year"=>"-1");
	$writer->emptyTag("ObjectGroup", "id"=>"sysid3", "library"=>"Standard", "name"=>"ScratchPad");

	$writer->startTag("ObjectGroup", "id"=>"stdid01", "library"=>"Standard", "name"=>"Objects");
	&dumpGroupObjects;
	&dumpHostObjects;
	&dumpNetworkObjects;
	$writer->emptyTag("ObjectGroup", "id"=>"stdid15", "library"=>"Standard", "name"=>"Address Ranges");
	$writer->endTag("ObjectGroup");
	
	$writer->startTag("ServiceGroup", "id"=>"stdid05", "library"=>"Standard", "name"=>"Services");
	&dumpGroupServices;
	&dumpTCPServices;
	&dumpUDPServices;
	&dumpICMPServices;
	&dumpIPServices;
	&dumpUnknownServices;
	$writer->endTag("ServiceGroup");

	$writer->startTag("ObjectGroup", "id"=>"stdid12", "library"=>"Standard", "name"=>"Firewalls");
	&dumpFirewalls;
	$writer->endTag("ObjectGroup");
	
	
	
	$writer->endTag("FWObjectDatabase");
	
}


##########################################################################
##########################################################################
###   MAIN
##########################################################################
##########################################################################

# Parse and process options
if (!GetOptions(\%optctl, 
	'objects=s', 'rules=s', 
	'all_objs', 'all_services', 'with_implicit_rules',
	'output_xml=s',
	'verbose','version','comments','sort_by_type'
	)
	|| keys(%optctl) == 0 || $optctl{help} == 1 || $optctl{version} == 1 )
{
        if ($optctl{version} == 1)
        {
		print STDERR "$SCR_NAME \($VERSION\) - 2002 by Stefan Majer \<stefan\@x-cellent.com\>\n";
        } else {
                &Usage();
        }
        exit;
}


#--------------------------------------------------
# filename options
if (defined($optctl{'objects'})) { $FW1objects = $optctl{'objects'}; }
if (defined($optctl{'rules'})) { $FW1rules = $optctl{'rules'}; }

#--------------------------------------------------
# switches / flags
$FLAG_allobjs = (defined($optctl{'all_objs'}));
$FLAG_allservices = (defined($optctl{'all_services'}));
$FLAG_implicitrules = (defined($optctl{'with_implicit_rules'}));
$FLAG_verbose = (defined($optctl{'verbose'}));
$FLAG_comments = (defined($optctl{'comments'}));
$FLAG_sortbytype = (defined($optctl{'sort_by_type'}));

#----------------------------------------------------------------

open (LOGFILE,">$LogFile") ;

#------ first the objects ------

open (INFILE,"$FW1objects") 
	or die "Cannot open the object file $FW1objects!\n\n";
	
&PrintLog("$SCR_NAME \($VERSION\) - 2002 by Stefan Majer \<stefan\@x-cellent.com\>\n\n");

&PrintLog("skipping...");
while ( ($line = <INFILE>) && ( $line !~ /^\t\:netobj \(netobj/ ) ) { &PrintLog('.'); }
&PrintLog("\n\nReading network objects...");
&ReadNetworkObjects;

&PrintLog("\n\nskipping...");
while ( ($line = <INFILE>) && ( $line !~ /^\t\:servobj \(servobj/ ) ) { &PrintLog('.');}
&PrintLog("\n\nReading services...");
&ReadServices;

&PrintLog("\n\nskipping...");
while ( ($line = <INFILE>) && ( $line !~ /^\t\:resourcesobj \(resourcesobj/ ) ) { &PrintLog('.');}
&PrintLog("\n\nReading resources...");
#&ReadResources;

&PrintLog("\n\nskipping...");
while ( ($line = <INFILE>) && ( $line !~ /^\t\:props \(/ ) ) { &PrintLog('.');}
&PrintLog("\n\nReading properties...");
&ReadProperties;

close (INFILE);

#------ now the rulebase ------

open (INFILE,"$FW1rules") 
	or die "Cannot open the rules file $FW1rules!\n\n";
	
&PrintLog("\n\nskipping...");
while ( ( $line !~ /^\t\:rule \(/ ) && ($line = <INFILE>) ) { &PrintLog('.');}
&PrintLog("\n\nReading access rules...");
&ReadAccessRules;

&PrintLog("\n\nskipping...");
while ( ( $line !~ /^\t\:rule_adtr \(/ ) && ($line = <INFILE>) ) { &PrintLog('.');}
&PrintLog("\n\nReading NAT rules...");
&ReadNATrules;

close (INFILE);


&PrintLog("\n\nReading Done.\n\n");

if (defined($optctl{'output_xml'})) {
	&PrintLog("Printing ruleset in xml format.\n");
	
	my $output = new IO::File( ">$optctl{'output_xml'}");
	my $writer = new XML::Writer(OUTPUT => $output, DATA_MODE => 1, DATA_INDENT => 1);

	#&Output_in_XML ($writer,$FLAG_implicitrules,$FLAG_allobjs); 
	&Output_to_XML ($writer,$FLAG_implicitrules,$FLAG_allobjs); 
	
	$writer->end();
	$output->close();
}

close(LOGFILE);

#
# $Log: cp2fwbuilder,v $
# Revision 1.14  2002/04/07 09:42:22  smajer
# changed handling of whitespaces in objectnames
#
# Revision 1.13  2002/04/07 07:46:58  smajer
# really fixed quotes
#
# Revision 1.12  2002/04/07 07:16:32  smajer
# removed quotes fro objectnames and ipaddresses
#
# Revision 1.11  2002/04/06 13:07:30  smajer
# whitespaces in object and servicenames tranlated to _
#
# Revision 1.10  2002/04/06 12:09:03  smajer
# added comments on objectref und serviceref as an option
#
# Revision 1.9  2002/04/05 19:07:02  smajer
# added Address Ranges
#
# Revision 1.8  2002/04/05 18:51:03  smajer
# compatible with fwbuilder 1.0.1
# fixed bogus Any Service matching
#
# Revision 1.7  2002/03/15 20:37:43  smajer
# initial checkin of parse.pl
#
# Revision 1.6  2002/03/12 19:00:25  smajer
# Interface Policy disabled in Firewallgeneration due to
# bug in object parsing code
#
# Revision 1.5  2002/03/06 17:17:58  smajer
# Correct handling of antispoof feature
#
# Revision 1.4  2002/03/04 19:09:16  smajer
#  - Router added as possible Object Type
#  - Policy generation now involves "install on" feature of Checkpoint
#
# Revision 1.3  2002/03/03 09:21:11  smajer
# Cosmetic fixes
#
# Revision 1.2  2002/03/02 18:36:24  smajer
# Changelog added
# changed id for objects to md5_hex of object-name to avoid possible
# conflicts with special characters in them
#
# Revision 1.1  2002/02/24 09:37:36  smajer
# corrected import
#
# Revision 1.8  2002/02/21 20:16:37  stefan
# fixes from fw1rules
#
# Revision 1.7  2002/02/21 17:23:51  stefan
# NAT polixcy und Interfaces
#
# Revision 1.6  2002/02/20 20:33:55  stefan
# Firewall vorbereited
# stiubs für nat policy und interfaces implementiert
#
# Revision 1.5  2002/02/20 19:52:57  stefan
# Objects und services als XML Output reimplemetiert
#
# Revision 1.4  2002/02/18 21:20:17  stefan
# Test for ca[3~[3~haracter encodinfg
#
# Revision 1.3  2002/02/18 21:15:23  stefan
# RCS tags corrected
#
# ö
#
#