package ZoneEdit;

# Documentation.

=head1 NAME

ZoneEdit - Perl extension for creating/modifying the ZoneEdit service

=head1 SYNOPSIS

  use ZoneEdit;

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

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

  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

#  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 IO::Socket::SSL;				# This should work instead of Crypt::SSLeay if you like, but it hasn't been tested
use Crypt::SSLeay;
use Crypt::CBC;                                 # **IMPORTANT**: Use ZoneEdit's *openssl-compatible* modified CBC... ((it's also compatible with the regular CBC))
use LWP::UserAgent;

$VERSION = '1.13';                              # 01/12/2000 v1.13

$VERSION = '2.0';                               # 04/16/2000 v2.0 Increased support for pkey to remove necessity of $PASSWORD
                                                # 04/16/2000 v2.0 Added control panel API features.

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

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

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

    my $props = build_request(%props);
    
	$user = url_encode($user);
	$pass = url_encode($pass);

    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);
    
	$user = url_encode($user);

    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);

	$user = url_encode($user);

    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);
    
	$user = url_encode($user);

    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);

	$user = url_encode($user);
	$comment = url_encode($comment);

    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);

	$user = url_encode($user);
    
    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);
    
	$user = url_encode($user);

    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 change_record  {
    my ($user, $zone, $type, $dnsfrom, $dnsto, $forward, %props) = @_;

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

    my $props = build_request(%props);
    
	$user = url_encode($user);

    return send_command("command=ChangeRecord&user=$user&zone=$zone&type=$type$props");
}

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

	die "Invalid ViewRecord request" unless ($zone || $user);
	
	$props{'forward'} = $forward if $forward;
	$props{'dnsfrom'} = $dnsfrom if $dnsfrom;
	$props{'dnsto'}   = $dnsto   if $dnsto;

    my $props = build_request(%props);
    
	$user = url_encode($user);

    return send_command("command=ViewRecord&user=$user&zone=$zone&type=$type$props");
}

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

	die "Invalid ViewZone request" unless ($zone && $user);
	
    my $props = build_request(%props);
    
	$user = url_encode($user);

    return send_command("command=ViewZone&user=$user&zone=$zone$props");
}

sub create_login_key {
	my($user)=@_;
	
	if ($PKEY) {
		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 "$pid:$pkey";
	} else {
		return "";
	}
}

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


    if ($PKEY) {
        # the quick way of getting a routing URL creates a trusted request though an encrypted 'partner key'
        return "/auth/edit.html?type=$type&zone=$zone&pkey=" . create_login_key($user);
    } else {
        # 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;
    }
}

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

    $ua = new LWP::UserAgent;
    $ua->agent("ZoneEdit API/$VERSION");
	
    my $request = new HTTP::Request('GET', "http://$SERVER/auth/admin/command.html?$command" . 
    					($PKEY?"&pkey=" . create_login_key($USERNAME):"")
    				);
	
    $request->authorization_basic($USERNAME, $PASSWORD) if ($USERNAME && $PASSWORD && !$PKEY);
    $response = $ua->simple_request($request);

    my $page=$response->content;
    my $result=$response->message;
    my %headers=%{$response->headers};

	print "\n" . $page . "\n";

    ($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;