#       misc - miscellaneaous functions
#
# 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: misc.pl,v 2.22 1999/10/06 16:41:13 marek Exp $
#
#	$RCSfile: misc.pl,v $
#	$Revision: 2.22 $
#	$Author: marek $
#	$Date: 1999/10/06 16:41:13 $
#

require "defines.pl";
require "dpr.pl";

# sort subroutine for sorting changed fields by date

sub sortchangedfield {
  $a =~ / ((?:\d{2}){3,4})$/;	# matches YYMMDD or YYYYMMDD
  my($date1) = YYMMDDtoYYYYMMDD($1);

  $b =~ / ((?:\d{2}){3,4})$/;	# matches YYMMDD or YYYYMMDD
  my($date2) = YYMMDDtoYYYYMMDD($1);

  return 0 unless $date1 || $date2;
  return -1 unless $date1;
  return 1 unless $date2;

  return $date1 <=> $date2;
}

sub ReplaceGlobalVars {
    local(*text)=@_;
    
    return if (!defined($text));
    
    #
    # we do multi line matching
    
    local($*)=1;
    
    $text=~ s/\$FROMHOST/$FROMHOST/go;
    
    $text=~ s/\$FROM/$FROM/go;
    if (!$CC) {
       $text=~ s/(^|.*\s)Cc\s*\:\s.*\n//gi;
    }
    else {
       $text=~ s/\$CC/$CC/go;
    }
    $text=~ s/\$REPLYTO/$REPLYTO/go;
    
    $text=~ s/\$SUBJECT/$SUBJECT/go;
    $text=~ s/\$MDATE/$MDATE/go;
    $text=~ s/\$MSGID/$MSGID/go;
    $text=~ s/\$HUMAILBOX/$HUMAILBOX/go;
    $text=~ s/\$AUTOBOX/$AUTOBOX/go;
    $text=~ s/\$DATE/$DATE/go;
    $text=~ s/\$TIME/$TIME/go;
    $text=~ s/\$REFERHOST/$REFERHOST/go;
    $text=~ s/\$REFERPORT/$REFERPORT/go;
    $text=~ s/\$REFERMSG/$REFERMSG/go;
    $text=~ s/\$REFERQUERY/$REFERQUERY/go;
}

sub MakeRegular {
    local($value)=@_;
        
    $value=~ s/([^\w\s])/\\$1/g;
                
    return $value;
    
}

#
# print date & COPYRIGHT message to file
# 

sub printrights {
   local($file)=@_;
   
   print $file "#\n# ", $DATE, " ", $TIME, "\n#";
   
   foreach (split(/\n/, $RIGHTS)) {
      print $file "\n# ", $_;
   }
   
   print $file "\n#\n";

}

# delormoveindices
#
# deletes the indices
#
# OR
#
# if a second argument is given :
# moves the indices and database file to a new destination database (no dir!!!)

sub delormoveindices {
   local($db,$todb,$classless)=@_;
   
   local($dir, $name, $todir, $toname, $file);
   local(@oldfiles)=();
   local(@renames)=();
   
   # print STDERR "delormoveindices($db,$todb,$classless)\n";
   
   #
   # $db always contains the raw data file
   # $basefile the basename for the indices

   local($basefile)=$db; 
   $db=~ s/$CLASSLESSEXT$// if ($classless);
   
   #
   # we only do this if there is really a database present ;-)
   
   &fatalerror("delormoveindices - cannot delete/move indices when \'", $db, "\' doesn\'t exist") if (! -f $db);
   
   # just delete/move the standard index suffices...
   
   if ($todb) {
      
      push(@renames,$db,$todb) if (!$classless);
      
      push(@renames,$basefile.".pag",$todb.".pag") if (-f $basefile.".pag");
      push(@renames,$basefile.".dir",$todb.".dir") if (-f $basefile.".dir");
      push(@renames,$basefile.".db",$todb.".db") if (-f $basefile.".db");
      
      
   }
   else {
      push(@oldfiles, $basefile.".pag") if (-f $basefile.".pag");
      push(@oldfiles, $basefile.".dir") if (-f $basefile.".dir");
      push(@oldfiles, $basefile.".db") if (-f $basefile.".db");
   }
   
   #
   # and now go for the overflow files
   
   # 
   # find the dirname and filename only
   
   ($dir, $name)= $basefile =~ /$SPLITFILENAME/o;
   $dir=".\/" if ($dir=~ /^\s*$/);
   
   # print STDERR "dir: $dir name: $name\n";
   
   #
   # find the indices files that are in the old dir but not in the new...
   
   if ($todb) {
      
      #
      # find the new dirname and filename only
      
      ($todir, $toname)= $todb =~ /$SPLITFILENAME/o;
      $todir=".\/" if ($todir=~ /^\s*$/);
      
      # print STDERR "todir: $todir toname: $toname\n";
      
      &fatalerror("delormoveindices - cannot move indices/db file from $dir to $todir") if ($dir=~ /^\s*$todir\s*$/);
      
      #
      # first find overflow files that don't exist anymore in the new dir   
      
      opendir(TODBDIR,$todir);
   
      foreach $file (readdir(TODBDIR)) {
         push(@oldfiles,$todir.$file) if (($file=~ /^\s*$toname($OVERFLOWEXTENSION\d+)\s*$/) && (! -f $dir.$name.$1));
         # print STDERR "rm todb: $file <> $toname$OVERFLOWEXTENSION $dir$name$1\n";
      }
   
      closedir(TODBDIR);
   
   }
   
   opendir(DBDIR,$dir);
   
   foreach $file (readdir(DBDIR)) {
      
      # print STDERR "$file ";
      
      if ($file=~ /^\s*$name($OVERFLOWEXTENSION\d+)\s*$/) {
      
         if ($todb) {
         
            push(@renames, $dir.$file, $todir.$toname.$1);
         
            # print STDERR "ren todb: $name$OVERFLOWEXTENSION $dir$_ -> $todir$toname$1\n";
         
         }
         else {
         
            push(@oldfiles, $dir.$file);
         
            # print STDERR "rm db: $name$OVERFLOWEXTENSION $dir$_\n";
         
         }
         
      }
      
   }
   
   close(DBDIR);
   
   # print STDERR "delormoveindices - renames:\n", join("\n", @renames), "\n\n";
   # print STDERR "delormoveindices - oldfiles:\n", join("\n", @oldfiles), "\n\n";
      
   while ($file=shift(@renames)) {
      rename($file, shift(@renames));
   }
   
   unlink(@oldfiles) if (@oldfiles);
   
}

sub trimnet {
    local($quad) = @_;
    
    if ($quad=~ /^\s*0*(1?[1-9]?\d|[12][0-4]\d|25[0-5])\.0*(1?[1-9]?\d|[12][0-4]\d|25[0-5])\.0*(1?[1-9]?\d|[12][0-4]\d|25[0-5])\.0*(1?[1-9]?\d|[12][0-4]\d|25[0-5])\s*$/) {
       return "$1.$2.$3.$4";
    }
    else {
       &syslog("ERRLOG", "trimnet: illegal ip number \"$quad\"");
       return "";
    }
    
}


#
# do an 'and' zero mask from the right of $_[1] bits 

sub iprightzeromask {
    local($ipvalue, $length)=@_;
    
    #
    # ipv4 version
    
    if ($ipvalue!~ /\:/) {

      # This bit can cause problems. Some versions of perl return
      # a signed result which causes classless lookups to fail.

      # check from the command line with something like...

      # perl5.00307  -e 'print 3238002689 & 4294967040, "\n"'
      # -1056964608
      # perl5.00397  -e 'print 3238002689 & 4294967040, "\n"'
      # 3238002688
      # perl5.00401  -e 'print 3238002689 & 4294967040, "\n"'
      # 3238002688

      # the first one is broken.

      # But even 5.00401 doesn't completely fix it. Perl will
      # convert between numbers and strings automagically,
      # but something going wrong with bitwise &.
      #
      # perl5.00401  -e 'print "3238002689" & 4294967040, "\n"'
      # 2147483392

      # We force $ipvalue to be numeric (rather than a string of digits)
      # by decrementing and incrementing it.
      # (inc then dec if it is zero so it doesn't become signed)

      if ($ipvalue != 0) {
        $ipvalue--; $ipvalue++;
      } else {
        $ipvalue++; $ipvalue--;
      }

      {
	my ($result) = $ipvalue & $masks[$length];

#	my ($quad) = int2quad($result);
#	print "iprightzeromask: [$result] [$quad]\n" if $opt_V;

	return $result; 
      }
    }
    
    #
    # now try the ipv6 version   
    
    # print STDERR "length: ",$length,"\n";
    
    return &ipv6rightzeromask($ipvalue, 128-$length);
    
}

#
# do an 'and' zero mask from the right of $_[1] bits for an ipv6 address  

sub ipv6rightzeromask {
    local($value, $zeroes)=@_;
    
    local($field, $newfield);
    
    local(@fields)=split(/\:/, $value);
    local(@newrightside)=();
    
    while (($zeroes>0) && (($field=pop(@fields))!~ /^\s*$/)) {
       
       # print STDERR "zeroes: ",$zeroes, " field: ",$field, "\n";
       
       #
       # do we mask 16 or more bits at once or is the field already "0" ?
       
       if (($field eq "0") || ($zeroes>=16)) {
          
          unshift(@newrightside, "0");
          
          $zeroes-=16;
          
          # print STDERR "Zeroes: $zeroes\n";
          next;
          
       }
       
       # print STDERR "do further splitting\n";
       
       #
       # we need to split up further down and do the
       # individual hexadecimal numbers
       
       $newfield="";
       
       while (($zeroes>0) && ($field=~ s/(.)$//)) {
          
          # print STDERR "letter: ", $1, "\n";
          
          if ($zeroes>=4) {
          
             $newfield="0".$newfield;
          
             $zeroes-=4;
          
             next;
          
          }
          elsif ($zeroes==3) {
          
             $newfield=$ipv6masks3{$1}.$newfield;
          
             $zeroes-=3;
          
          }
          elsif ($zeroes==2) {
          
             $newfield=$ipv6masks2{$1}.$newfield;
          
             $zeroes-=2;
          
          }
          elsif ($zeroes==1) {
          
             $newfield=$ipv6masks1{$1}.$newfield;
          
             $zeroes=0;
             
             # print STDERR $zeroes, "\n";
          
          }
          
          last;
          
       }
       
       if (length($field)==0) {
       
          $zeroes-=(4-length($newfield))*4 if (length($newfield)<4);
          
          $newfield=~ s/^0+//;
          
          unshift(@newrightside, $newfield?$newfield:"0");
          
       }
       else {
          unshift(@newrightside, $field.$newfield);          
       }
       
    }
    
    #
    # rebuild the IPv6 number and return
    
    #print STDERR "old: ",join("\:", @fields), "\n";
    #print STDERR "new: ",join("\:", @newrightside), "\n";
    #print STDERR "all+: ",join("\:", @fields, @newrightside), "\n";
    
    if (@fields) {
    
       return join("\:", @fields, @newrightside) if (@newrightside);
       
       return join("\:", @fields);
       
    }
    
    return join("\:", @newrightside);
    
}


sub fullipv6formatprefix {
    local($value)=@_;
    
    $value=~ s/\s+//g;
    
    $value=~ tr/A-F/a-f/;
    
    local($length);
    
    $value=~ s/\:?(\/\d+)$//;
    $length=$1;
    $value=~ s/^\://;
        
    local($nrofcolons)=0;
    local($position)=-1;
    
    $value=~ s/\:(\d+)\.(\d+)\.(\d+)\.(\d+)$/sprintf("\:%x%x\:%x%x", $1, $2, $3, $4)/e;
    
    local(@fields)=();
    
    # print STDERR "value: ", $value,"\n";
    
    foreach (split(/\:/,  $value)) {
       
       # print STDERR $_, "\n";
       
       if (length($_)>0) {
          s/^0+//;
          $_="0" if (!$_);
          if(length($_) == 1 && $_ ne '0'){
            $_ = '000'.$_;
          }
          if(length($_) == 2){
            $_ = '00'.$_;
          }
          if(length($_) == 3){
            $_ = '0'.$_;
          }
          push(@fields, $_);
          
          $nrofcolons++;
          
       }
       else {
          $position=$nrofcolons if ($position<0);
       }
       
    }
    
    $position=$nrofcolons if (($position<0) && ($value=~ /\:$/));
    
    splice(@fields, $position, 0, ("0") x (8-$nrofcolons)) if ($position>=0);
    
    #print STDERR "fullipv6*", join("\:", @fields).$length, "*\n";
    
    return join("\:", @fields).$length;
        
}


sub isipv6prefix {
    local($value)=@_;
    
    local($length);
    
    $value=~ s/\/(\d+)$//;
    $length=$1;
    
    #print STDERR "1: ", ($length>0) && ($length<129),"\n";
    #print STDERR "2: ", ($value=~ /^$VALIDIP6$/o),"\n";
    #print STDERR "3: ", &ipv6rightzeromask($value, 128-$length),"\n";
    #print STDERR "3: ", $value,"\n";
    #print STDERR "3: ", &ipv6rightzeromask($value, 128-$length) eq $value,"\n";
    
    return (($length>0) && ($length<129) &&
            ($value=~ /^$VALIDIP6$/o) &&
            (&ipv6rightzeromask($value, 128-$length) eq $value));
    
}

sub islen {
    
    return (($_[0]>=0) && ($_[0]<=32));

}

sub isnet {
    local($net) = @_;
    local($i);
    if($net !~ /^\d+\.\d+\.\d+\.\d+$/) {
	return 0;
    }
    local(@quads) = split(/\./, $net);
    for ($i=0; $i<4 ; $i++ ) {
	if ($quads[$i] < 0 || $quads[$i] > 255) {
	    return 0;
	}
    }
    return 1;
}

# the name says all ...:

sub getYYYYMMDDandHHMMSS {

    local($s,$m,$h,$day,$month,$year,$wd,$yd,$is)=localtime(time);

    $YYYYMMDD=sprintf("%4d%2d%2d",$year + 1900,++$month,$day);
    $YYYYMMDD=~ s/\D/0/g;

    $HHMMSS=sprintf("%2d:%2d:%2d",$h,$m,$s);
    $HHMMSS=~ s/[^\d:]/0/g;

    print STDERR "$YYYYMMDD $HHMMSS $YEAR\n" if $DEBUG;                    

    return ($YYYYMMDD,$HHMMSS);
}

#  YYMMDDtoYYYYMMDD
#
#  converts a date with six digits to y2k-compliant form with 8 digits
#
#  assumes that years 00-69 are 2000-2069 and 70-99 are 1970-1999 as the
#  UNIX calendar starts at 1970 :-)
#
#  passes dates which are already in 8 digit form safely through

sub YYMMDDtoYYYYMMDD {
    my($origdate) = shift;

    if (length($origdate) == 8) {
      return $origdate;
    }
    if (length($origdate) == 6) {
      return (substr($origdate, 0, 2) < 70 ? '20' : '19') . $origdate;
    }
    &syslog("ERRLOG", "YYMMDDtoYYYYMMDD: illegal date \"$origdate\"");
    return undef;
}

# 
#  A load of silly syntax check subroutines - TB
#
#  isnetnum() - Is is a valid netnumber
#  isdonname() - Is it a valid domainname
#  isname() - Is it a personal name.
#  isphone() - Is is a valid phone or fax format.
#  isemail() -  Is is a valid RFC822 address
#  isasnum() - Is it a valid AS number
#  isaspref() - Is is a valid preference cost
#  isaskeyword() - Is it one of the askeywords (needs to be done somewhat
#                  differently later
#  isasmacro() - Is it a valid as-macro.
#  isclnsprefix() - Is it a CLNS prefix
#  isclnskeyowrd() - Is it one of the CLNS keywords (from Henk S' paper)
#  iscommunity() - got to check it doesn't with a RIPE-81 KEYWORD yuck.
#  ishandle() - check the handle syntax. REMEMBER TO UPDATE the postfix array.
#  ishandser() - check the actual handle serial
#  isnetlist() - Is this a valid netlist
#  ishostaddr() - Is this a valid hostaddress
#  ispeerkeyword() - check list of peer keywords
#

sub isasnum {
    
    return scalar(($_[0]=~ /^AS([1-9]+\d*)$/) && ($1 > 0) && ($1 < 65536));
    
}

sub isnetname {
    
    return scalar($_[0]=~ /^[A-Z][A-Z\d\-]*$/);
    
}

sub ismaintainer {
    
    return scalar($_[0]=~ /^[A-Z][A-Z\d\-]*$/);
    
}

sub islimerick {
    
    return scalar($_[0]=~ /^LIM\-[a-zA-Z\d\-]+$/);
   
}



sub isnichandle {
    
    #
    # this is a very trickey routine but avoids more
    # problems then it causes...
    
    # the problem is as follows:
    #
    # we can never find out which NIC handles are possible on the
    # globe since we don't know that they exist
    #
    # we want to solve this with once with DNS :
    #
    # RIPE.registries.int     CNAME whois.ripe.net
    # InterNIC.registries.int CNAME whois.internic.net
    # and so on...
    
    #
    # 1) it first does a basic syntax check
    #    
    #    notes:
    #    
    #    - catches InterNIC handles
    #    - catches the JP|JP-JP APNIC exceptions
    #    - limits the number of initials to three with a good reason:
    #      we have a much better chance to find syntax errors like:
    #      RIPE-DK13 and other problems like this
    # 
    # 2) checks for valid suffixes
    #    - all 'source:' attribute values from sites that we mirror
    #      are allowed
    #    - country codes are allowed for APNIC compatibility
    #    - APNIC AP|CC-AU exceptions are handled correctly
    #    - -ORG organization InterNIC handles
    #    - -ARIN ARIN handles
    #    - -ORG-ARIN ARIN handles
    #    - -RIPN RIPN handles
    
  my $handle = shift;
  
  # reject lowercase
  return undef if $handle =~ /[a-z]/;

  # Japanese NIC handles
  # 
  # leading zeros in the number part *are* allowed
  #
  # e.g. AB021JP AB199JP-JP
  #
  return 1 if ($handle =~ /[A-Z]{2}\d{3}JP(-JP)?/);

  # Standard NIC handles
  #
  # leading zeros in the number part are *not* allowed
  #
  # InterNIC - TBQ, IP4
  # RIPE format - AB1-RIPE
  # APNIC use two letter country code suffix
  # Austraila have used -1-AU, -2-AU, -CC-AU suffix.
  # Internic used -ORG suffix
  # ARIN use -ARIN suffix
  # ARIN also use -ORG-ARIN suffix
  # RIPN use -RIPN suffix
  #
  
  if ($handle =~ /^([A-Z]{2,$MAXLENGTHINITIALS})([1-9]\d{0,5})?(-\S+)?$/) {
    my ($initials,$number,$suffix) = ($1,$2,$3);

    # we're done if there is no suffix
    return 1 unless $suffix;

    # strip leading '-'
    $suffix =~ s/^-//;

    # suffix of local sources (better to use the reverse hash of NICPOSTFIX)
    foreach $v (values %NICPOSTFIX) {
      return 1 if ($suffix eq $v);
    }

#    return 1 if (defined $NICPOSTFIX{$suffix});

    # country codes
    return 1 if (defined $COUNTRY{$suffix});

    # special suffix (using a 'static' hash would be quicker)
    return 1 if (
		 ($suffix eq 'CC-AU') ||
		 ($suffix eq '1-AU') ||
		 ($suffix eq '2-AU') ||
		 ($suffix eq 'ORG') ||
                 ($suffix eq 'ARIN') ||
                 ($suffix eq 'ORG-ARIN') ||
		 ($suffix eq 'RIPN') ||
		 ($suffix eq 'AP')
		 );
  }

  return undef;
}


#
# Current RIPE-81 KEYWORDS
#
%KEYWORD = (
#
# Now gone for RIPE-81++
#
#           "RIPE-DB", 1,
#	    "LOCAL", 1,
	    "ANY", 1,
	    "AND", 1,
	    "OR", 1,
	    "NOT", 1,
	    "(", 1,
	    ")", 1,
	    );

sub isaskeyword {
    local($str) = @_;
    if( $str !~ /^\($/ ) {
	$str =~ s/^\(//;
    }
    if ($str !~ /^\)$/ ) {
	$str =~ s/\)$//;
    }
    
    if (&isasnum($str) || ($KEYWORD{$str}) || &iscommunity($str) || 
	&isasmacro($str) || &isnetlist($str)) {
	return 1;
    }
    return 0;
}

sub isasmacro {

    return scalar($_[0]=~ /^AS\-[A-Z]+$/);

}

#
# CLNS KEYWORDS
#
%CLNSWORD = (
	     "ANY", 1, 
	     "AND", 1,
	     "OR", 1,
	     "NOT", 1,
	     "(", 1,
	     ")", 1,
	     );
sub isclnskeyword {
    local($str) = @_;
        if( $str !~ /^\($/ ) {
	$str =~ s/^\(//;
    }
    if ($str !~ /^\)$/ ) {
	$str =~ s/\)$//;
    }
    if(&isclnsprefix($str) || ($CLNSWORD{$str})) {
	return 1;
    }
    return 0;
}

#
# Peer KEYWORDS
#

%PEERWORD = (
	     "EGP", 1, 
	     "BGP", 1,
	     "BGP4", 1,
	     "IDRP", 1,
	     "IGP", 1,
	     "HELLO", 1,
	     "IGRP", 1,
	     "EIGRP", 1,
	     "OSPF", 1,
	     "ISIS", 1,
	     "RIP", 1,
	     "RIP2", 1,
	     "OTHER", 1,
	     );

sub ispeerkeyword {
    local($str) = @_;
    return 0 if !$PEERWORD{$str};
    return 1;
}

#
# isnetlist

sub isnetlist {
    
    return scalar($_[0]=~ /^\s*\{\s*$VALIDIP4PREFIX\s*(\s*\,\s*$VALIDIP4PREFIX\s*)*\}\s*$/o);
    
}


sub iscommunity {
    local($str) = @_;
    
    local($key);
    
    return 0 if $str !~ /^[A-Z][A-Z\d\_\-]+$/;
    
    #
    # the LIM is very special... we don't want to
    # confuse limericks with our real data :-)
    
    foreach (keys(%KEYWORD), "AS", "LIM-") {
	
	($key=$_)=~ s/([^\w\s])/\\$1/g;
	
	return 0 if ($str=~ /^$key/);
    
    }
    				
    return 1;
}

sub isaspref {
    local($str) = @_;
    $str = $str + 0 ;
    if ( $str < 1 ) {
	return 0;
    }
    return 1;
}


sub isnetnum {
    local($str) = @_;
#
# check for trailing dot before doing the split
# not nice but needed
#
    return 0 if $str =~ /^.*\.$/;
    local(@add) = split(/\./, $str);
    if ($#add != 3) {
	return 0;
    }
    foreach (@add) {
	if (($_ !~ /^[0-9]+$/) || ($_ > 255) || ($_ < 0)) {
	    return 0;
	}
    }

    if (($add[0] > 223) || ($add[0] == 0)) {
	return 0;
    }
    
    return 1;
}

sub isipaddr {
    local($str) = @_;
    local($i) = 0;
    local($net) = "";
    if($str =~ /^(\d+\.\d+\.\d+\.\d+)\/(\d+)$/) {
	$net = $1; 
	local($pref) = $2;
	if($pref != 32) {
	    return 0;
	}
    } else {
	$net = "$str";
    }
    if($net !~ /^(\d+\.\d+\.\d+\.\d+)$/) {
	return 0;
    }
    local(@add) = split(/\./, "$net");

    if ($#add != 3) {
	return 0;
    }
    if($add[0] > 223) {
	return 0;
    }
    foreach $i (0..$#add) {
	$add[$i] +=0;
	if ($add[$i] < 0 || $add[$i] > 255 ) {
	    return 0;
	}
    }
    return 1;
}

sub ismask {
    local($str) = @_;

    local($i) = 0;
    local($net) = "";
    if($str !~ /^(\d+\.\d+\.\d+\.\d+)$/) {
	return 0;
    }
    local(@add) = split(/\./, $str);
    if ($#add != 3) {
	return 0;
    }
    foreach $i (0..$#add) {
	$add[$i] +=0;
	if ($add[$i] < 0 || $add[$i] > 255 ) {
	    return 0;
	}
    }
    return 1;

}
#
sub isclnsprefix {
    local($str) = @_;
    local($i);
    $str =~ tr/A-Z/a-z/;

    return 0 if $str =~ /\.$/;

    local(@parts) = split(/\./, $str);

    return 0 if $parts[0] !~ /^[0-9a-f][0-9a-f]$/;
    return 0 if $parts[1] !~ /^[0-9a-f][0-9a-f][0-9a-f][0-9a-f]$/;
    foreach $i (2..$#parts-1) {
        return 0 if $parts[$i] !~ /^[0-9a-f]+$/;
        return 0 if length($parts[$i]) != 4;
    }
    return 0 if $parts[$#parts] !~ /^[0-9a-f]+$/;
    return 1;
}
#
sub issubdomname {

    return scalar($_[0]=~ /^\s*$DOMAINNAME\s*$/o);

}

sub isdomname {

    # print STDERR "dom: ($_[0])", scalar($_[0]=~ /^\s*$DOMAINNAME\s*$/o), "\n";
    
    return scalar($_[0]=~ /^\s*$DOMAINNAME\s*$/o);

}

sub isname {
    
    return scalar(($_[0]!~ /^$AUTONICPREFIXREGULAR/o) && ($_[0]=~ /^[a-zA-Z][\w\-\.\'\|\`]*$/));

}

sub isphone {
    
    return scalar(($_[0] =~ /^\s*\+\s*\(?\s*\d+\s*\)?\s*(\s*[\-\.\(]*\s*\d+\s*\)?\s*)*(\s*ext\.\s*\d+\s*)?$/i) &&
            (&isparen($_[0])));
    
}

sub isemail {
    local($str)=@_;
    
    if ($str=~ /^\s*\<.*\>\s*$/) {
       $str=~ s/^\s*\<//;
       $str=~ s/\>\s*$//;
    }
    
    if (($str!~ /\@[^\@]*\@/) &&
        ($str=~ /\@$DOMAINNAME\s*$/o) &&
        (($str=~ /^\s*[^\(\)\<\>\,\;\:\\\"\.\[\]\s]+(\.[^\(\)\<\>\,\;\:\\\"\.\[\]\s]+)*\@/) ||
         ($str=~ /^\s*\"[^\"\@\\\r\n]+\"\@/))) {
       
       return 1;
    
    }
    else {
       
       return 0;
    
    }

}

# check for matching curly braces (was previously isbracket but
# bracets are [] as far as I know :-) //snabb 980928

sub isbrace {
    
    return ($_[0]=~ s/\{/\{/g==$_[0]=~ s/\}/\}/g);
    
}

# check for matching parentheses (was previously isbrace but
# braces are {}...) //snabb 980928

sub isparen {
   
    return ($_[0]=~ s/\(/\(/g==$_[0]=~ s/\)/\)/g);

}

#
# exclusive locking
#

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

    local($returncode)=flock($file, $LOCK_EX);
    seek($file, 0, 0);
    
    return ($returncode);
}

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

    local($returncode)=flock($file, $LOCK_EX);
    seek($file, 0, 2);
    
    return ($returncode);
}

#
sub unlock {
    local($file) = @_;

    return (flock($file, $LOCK_UN));
}

# Provides a simple wrapper around the setpriority or renice command. Use
# setpriority syscall unless RENICECMD is defined in config file.

# $RENICECMD is set from config file in rconf.pl

{

  # value to change priority to (should probably be in config file)
  my($nice_value)=10;

  # lower priority of running process
  # takes no args - returns status of syscall or system
  #

    sub lower_priority {

      if (defined $RENICECMD) {
#	&dpr("using [$RENICECMD]\n");
	return system("$RENICECMD 10 $$ > /dev/null 2>/dev/null");
      } else {
#	&dpr("using setpriority(2)\n");
	return setpriority PRIO_PROCESS, 0, $nice_value;
      }
    }
}

1;
