Net::Bind::Utils - various routines common across Net::Bind packages.

Net-Bind documentation Contained in the Net-Bind distribution.

Index

Code Index:

NAME

Top

Net::Bind::Utils - various routines common across Net::Bind packages.

SYNOPSIS

Top

  use Net::Bind::Utils qw(valid_domain valid_ip);

DESCRIPTION

Top

A catch-all place for various routines that are useful across most, if not all, of the Net::Bind interfaces.

This module is not designed to be subclassable.

ROUTINES

Top

valid_domain($domain)

Returns 1 if the given $domain string is defined and is a domain that bind is capable of resolving, otherwise returns 0.

valid_domain_rfc1035($domain)

Returns 1 if the given $domain string is defined and is a valid rfc1035 domain name, otherwise returns 0.

valid_ip($ip)

Returns 1 if the given $ip string is defined and is an ip address, otherwise returns 0.

The check for a valid ip address is currently very simple minded. It merely checks for a dotted-quad with all non-negative numbers with no number larger than 254.

valid_netmask($netmask)

Returns 1 if the given $netmask string is defined and is a netmask, otherwise return 0.

The check for a valid netmask is currently very simple minded. It merely checks for a dotted-quad with all non-negative numbers with no number larger than 255.

AUTHORS

Top

Kevin Johnson <kjj@pobox.com> Rob Brown <rob@roobik.com>

COPYRIGHT

Top

Copyright (c) 1997 Kevin Johnson <kjj@pobox.com>. Copyright (c) 2001 Rob Brown <rob@roobik.com>.

All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Net-Bind documentation Contained in the Net-Bind distribution. 
#-*-perl-*-
#
# Copyright (c) 1997 Kevin Johnson <kjj@pobox.com>.
# Copyright (c) 2001 Rob Brown <rob@roobik.com>.
#
# All rights reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
#
# $Id: Utils.pm,v 1.6 2002/04/18 02:22:47 rob Exp $

package Net::Bind::Utils;

use strict;
use vars qw($VERSION @ISA @EXPORT_OK);
use Carp;
use Exporter;

$VERSION = '0.05';
@ISA = qw(Exporter);
@EXPORT_OK = qw(valid_domain valid_domain_rfc1035 valid_ip valid_netmask);


sub valid_domain {
  my $domain = shift;

  return 0 unless defined($domain);
  # Root domain is okay
  return 1 if $domain eq ".";
  # empty label is illegal
  return 0 if $domain =~ /\.\./;
  # Force rooting if not already done
  $domain =~ s/([^\.])$/$1./;
  # A preceeding "-" in any section is illegal
  return 0 if $domain =~ /(^|\.)\-/;
  # A trailing "-" in any section is illegal
  return 0 if $domain =~ /\-\./;
  # Make sure each section has between 1 and 63 characters
  return 1 if $domain =~ /^([a-zA-Z0-9\-]{1,63}\.)+$/;
  return 0;
}


sub valid_domain_rfc1035 {
  my $domain = shift;

  return 0 unless defined($domain);

  # from RFC1035:
  # <domain> ::= <subdomain> | " "
  # <subdomain> ::= <label> | <subdomain> "." <label>
  # <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
  # <ldh-str> ::= <let-dig-hyp> | <let-dig-hyp> <ldh-str>
  # <let-dig-hyp> ::= <let-dig> | "-"
  # <let-dig> ::= <letter> | <digit>
  # <letter> ::= any one of the 52 alphabetic characters A through Z in
  # upper case and a through z in lower case
  # <digit> ::= any one of the ten digits 0 through 9
  my $label = '(?:[a-zA-Z](?:(?:[a-zA-Z\d\-]+)?[a-zA-Z\d])?)';
  my $dom = "(?:(?:$label\.?)*$label)";

  return ($domain =~ /^$dom$/);
}


sub valid_ip {
  my $ip = shift;

  return 0 unless defined($ip);

  return 0 if ($ip !~ /^[0-9\.]+$/);
  return 0 if ($ip !~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/);
  for my $num ($1, $2, $3, $4) { return 0 if ($num > 254) }
  return 1;
}


sub valid_netmask {
  my $mask = shift;

  return 0 unless defined($mask);

  return 0 if ($mask !~ /^[0-9\.]+$/);
  return 0 if ($mask !~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/);
  for my $num ($1, $2, $3, $4) { return 0 if ($num > 255) }
  return 1;
}


1;