package ZoneEdit;

# Documentation.

=head1 NAME

ZoneEdit - Perl extension for creating/modifying the ZoneEdit service

=head1 SYNOPSIS

  use ZoneEdit;

#  $ZoneEdit::SERVER = 'dns.mysite.com';                        # if you are using a fully branded site

  $ZoneEdit::USERNAME = 'username';                             # set to an admin user/password set aside for this API
  $ZoneEdit::PASSWORD = 'password';

  print ZoneEdit::add_user('fred', 'pass556hy');                # creates a user called fred
  print ZoneEdit::add_user_zone('fred', 'atreju.com');          # adds 'atreju.com' to freds list of zones
  print ZoneEdit::create_url('fred', 'atreju.com', 'VIEW');     # creates a single signon link for fred
  print ZoneEdit::del_user('fred');                             # deletes fred

OR

  $ZoneEdit::PKEY     = 'partner secret key';                   # set to a key generated by ZoneEdit

#  followed by the same functions as above....

=head1 DESCRIPTION

  PERL API wrapper creates functions for each of the ZoneEdit commands that can be used to 
  modify the ZoneEdit server.
  
    add_user_zone($user, $zone, %props)
        - adds a zone to a user, optionally creating the user (if you specify a pass=>'value' in %props)
          your team must have rights to the zone, or you must be certified as an authoritative user

        OPTIONAL PROPS:  pass, email, fullname, access, ip
    
    add_user($user, $pass, %props)
        - creates a new user account and/or modifies a user account

        OPTIONAL PROPS:  email, fullname, access, ip
        
    del_user($user)
        - permanently and irrevocably deletes a user, use with care
        
    create_url
        - creates a 'single signon' url so that preauthenticated users can log in without 
          needing a password.  
        - this should ONLY be used if you have already logged the user in to your system.  
        - the user must exist!
  
=cut

use Net::SSLeay qw(get_https make_headers);     # Available from CPAN, any version will do
use MIME::Base64;                               # 
use Crypt::CBC;                                 # **IMPORTANT**: Use ZoneEdit's *openssl-compatible* modified CBC... ((it's also compatible with the regular CBC))

$VERSION = '1.21';                              # 04/18/2001

$Net::SSLeay::random_device = $0 if (!-s $Net::SSLeay::random_device);  # win32 hack .. uses a very weak key!

$PKEY_EXPIRES = 3600 if $PKEY_EXPIRES == 0;     # default partner key expiration time
$SERVER = 'www.zoneedit.com';                   # default dns control panel server (can be dns.yourdomain.com)
$USERNAME = '';                                 # admin user name
$PASSWORD = '';                                 # admin password
$PKEY = '';                                     # partner routing key

# Windows users don't get strong encryption, unless they can find a random device to put here
$Net::SSLeay::random_device = $0 unless ($Net::SSLeay::random_device || -r '/etc/passwd');

sub add_user  {
    my ($user, $pass, %props) = @_;

	die "Invalid AddUser request" unless ($user && $pass);

    my $props = build_request(%props);
    
    return send_command("command=AddUser&User=$user&pass=$pass$props");
}

sub del_user  {
    my ($user, %props) = @_;

	die "Invalid DelUser request" unless ($user);

    my $props = build_request(%props);
    
    return send_command("command=DelUser&User=$user$props");
}

sub add_user_zone  {
    my ($user, $zone, %props) = @_;

	die "Invalid AddUserZone request" unless ($user && $zone);

    my $props = build_request(%props);
    return send_command("command=AddUserZone&User=$user&zone=$zone$props");
}

sub del_user_zone  {
    my ($user, $zone, %props) = @_;

	die "Invalid DelUserZone request" unless ($user && $zone);

    my $props = build_request(%props);
    
    return send_command("command=DelUserZone&User=$user&zone=$zone$props");
}

sub add_user_credit  {
    my ($user, $amount, $paid, $comment, %props) = @_;

	die "Invalid AddUserCredit request" unless ($user && $amount);

    my $props = build_request(%props);

    return send_command("command=AddUserCredit&User=$user&credits-amount=$amount&credits-paid=$paid&credits-comment=$comment$props");
}

sub add_record  {
    my ($user, $zone, $type, $dnsfrom, $dnsto, $forward, %props) = @_;
	
	die "Invalid AddRecord request" unless ($zone && $type);
	
	$props{'forward'} = $forward if $forward;
	$props{'dnsfrom'} = $dnsfrom if $dnsfrom;
	$props{'dnsto'}   = $dnsto   if $dnsto;
	
    my $props = build_request(%props);
    
    return send_command("command=AddRecord&user=$user&zone=$zone&type=$type$props");
}

sub del_record  {
    my ($user, $zone, $type, $dnsfrom, $dnsto, $forward, %props) = @_;

	die "Invalid DelRecord request" unless ($zone && $type);
	
	$props{'forward'} = $forward if $forward;
	$props{'dnsfrom'} = $dnsfrom if $dnsfrom;
	$props{'dnsto'}   = $dnsto   if $dnsto;

    my $props = build_request(%props);
    
    return send_command("command=DelRecord&user=$user&zone=$zone&type=$type$props");
}

sub del_record_id  {
    my ($type, $zone, $type, $id, %props) = @_;

	die "Invalid DelRecord by ID request" unless ($zone && $type && $id);
	
    my $props = build_request(%props);
    
    return send_command("command=DelRecord&user=$user&zone=$zone&type=$type&id=$id$props");
}

sub create_url  {
    my ($user, $zone, $type) = @_;

    if ($USERNAME && $PASSWORD && !$PKEY) {
        # the slow way of getting a routing URL  makes a ssl request of the server
        
        ($error, $result) = send_command("command=Route&Type=$type&User=$user&Zone=$zone");
        return $result;
    } else {
        # the quick way of getting a routing URL creates a trusted request though an encrypted 'partner key'
        
        my ($pid,$pkey)  = $PKEY =~ /(.*):(.*)/;
        my $ctime = time()+$PKEY_EXPIRES;
        
        $pkey = pack('H*',$pkey);
        my $cipher = new Crypt::CBC($pkey,'Crypt::Blowfish',16);
        $cipher->setrandomiv(0);
        $pkey = $cipher->encrypt("$user:$ctime");
        $pkey = unpack('H*',$pkey);
        
        return "/auth/edit.html?type=$type&zone=$zone&pkey=$pid:$pkey";
    }
}

sub send_command {
    my ($command) = @_;

    my $was = $Net::SSLeay::ssl_version;

    $Net::SSLeay::ssl_version = 3;
    my ($page, $result, %headers)
         = get_https($SERVER, 443, "/auth/admin/command.html?$command",
          make_headers('Authorization' => ('Basic ' . MIME::Base64::encode("$USERNAME:$PASSWORD")),
                       'Host' => $SERVER
          )
          );
    $Net::SSLeay::ssl_version = $was;
    
    ($code, $desc) = ($page =~ m/<failure * code="([0-9]+)"[^>]*>(.*)<\/failure>/i);
    
    if ($code >= 300) {
        die "ERROR $code: $desc";
    }
    
    if ($headers{LOCATION}) {
        return (100, $headers{LOCATION});
    }

    ($code, $desc) = ($page =~ m/<success * code="([0-9]+)"[^>]*>(.*)<\/success>/i);

    if ($code > 0) {
        return ($code, $desc);
    }
   
    return (0, $result);
}

sub build_request {
    my (%props) = @_;
    my $props;

    for (keys(%props)) {
        $props .= '&' . $_ . '=' . url_encode($props{$_});
    }
    
    return $props;
}

sub url_encode {
    $value=$_[0];
    $value =~ s/([^a-zA-Z0-9])/'%'.unpack("H*",$1)/eg;
    $value =~ tr/ /+/;
    return $value;
};

1;