<%doc>
Manipulate DNS/DHCP records using REST
</%doc>
<%args>
$user                    # Should be assigned by autohandler
$manager                 # Should be assigned by autohandler
$rrid           => undef # Id of RR
$ipid           => undef # Id of Ipblock
$name           => undef # Name for RR
$zone           => undef # Zone name
$subnet         => undef # Subnet address
$address        => undef # IP string. Will get next available if not specified
$expiration     => undef # Expiration date for RR
$aliases        => undef # Comma-separated list of strings for CNAMEs
$ethernet       => undef # MAC address string for DHCP host
$duid           => undef # DUID string for IPv6 DHCP host
$cpu            => undef # CPU string for HINFO
$os             => undef # OS string for HINFO
$info           => undef # Informational text
</%args>
<%init>
my $DEBUG = 0;
print '%ARGS is  <pre>', Dumper(%ARGS), '</pre><br>' if $DEBUG;

use Apache2::Const -compile => qw(FORBIDDEN OK NOT_FOUND HTTP_BAD_REQUEST);

use Netdot::REST;
my $rest = Netdot::REST->new(user=>$user, manager=>$manager);
$rest->request($r);

# Get relevant HTTP headers from request object
my $headers = $rest->{request}->headers_in;

# Deal with Accept header
$rest->check_accept_header($headers->{Accept}) if ( $headers->{Accept} );

my $method = $rest->{request}->method;
my $req_args = $method eq 'POST' ? 
    sprintf("%s", join(": ", %ARGS)) : $rest->{request}->args;

my $logger = Netdot->log->get_logger("Netdot::REST");
$logger->info(sprintf("/rest/host: %s request with args: %s from %s (%s)", 
 		      $method, 
		      $req_args,
 		      $rest->{request}->connection->remote_ip, 
 		      $headers->{'User-Agent'}
 	      ));

my $user_type = $user->getAttribute('USER_TYPE');

my %rrs;
my %ips;

</%init>
<%perl>
    
if ( $method eq 'GET' ){
    if ( $rrid ){
	my $rr = RR->retrieve($rrid);
	$rest->throw(code=>Apache2::Const::NOT_FOUND, msg=>"RR not found")
	    unless $rr;
	$rrs{$rr->id} = $rr;
    }elsif ( $ipid ){
	my $ipb = Ipblock->retrieve($ipid);
	$rest->throw(code=>Apache2::Const::NOT_FOUND, msg=>"IP not found")
	    unless $ipb;
	$ips{$ipb->id} = $ipb;
    }elsif ( $name ){
	my $rr = RR->search(name=>$name)->first;
	$rest->throw(code=>Apache2::Const::NOT_FOUND, msg=>"Name not found")
	    unless $rr;
	$rrs{$rr->id} = $rr;
    }elsif ( $address ){
	my $ipb;
	if ( Ipblock->matches_v4($address) ){
	    $ipb = Ipblock->search(address=>$address, version=>4, prefix=>32)->first;
	}elsif  ( Ipblock->matches_v6($address) ){
	    $ipb = Ipblock->search(address=>$address, version=>6, prefix=>128)->first;
	}else{
	    $rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
			 msg=>'Bad request: invalid address'); 
	}
	if ( $ipb ){
	    $ips{$ipb->id} = $ipb;
	}else{
	    $rest->throw(code=>Apache2::Const::NOT_FOUND, msg=>"Address not found"); 
	}
    }elsif ( $ethernet ){
	if ( my $phy = PhysAddr->search(address=>$ethernet)->first ){
	    foreach my $host ( $phy->dhcp_hosts ){
		my $ip = $host->ipblock;
		$ips{$ip->id} = $ip if $ip;
	    }
	}else{
	    $rest->throw(code=>Apache2::Const::NOT_FOUND, msg=>"MAC not found"); 
	}
    }elsif ( $duid ){
	if ( my $host = DhcpScope->search(duid=>$duid)->first ){
	    my $ip = $host->ipblock;
	    $ips{$ip->id} = $ip if $ip;
	}

    }elsif ( $zone ){
	# All RRs within given zone
	my $zoneobj = Zone->objectify($zone) or
	    $rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
			 msg=>'Bad request: invalid zone'); 
	unless ( $manager->can($user, 'view', $zoneobj) ){
	    $rest->throw(code=>Apache2::Const::HTTP_FORBIDDEN, 
			 msg=>"User not allowed to view this zone");
	}
	# Get all records in this zone
	map { $rrs{$_->id} = $_ } $zoneobj->records;

    }elsif ( $subnet ){
	my $subnetobj = Ipblock->objectify($subnet) or
	    $rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
			 msg=>'Bad request: invalid subnet'); 
	unless ( $manager->can($user, 'view', $subnetobj) ){
	    $rest->throw(code=>Apache2::Const::HTTP_FORBIDDEN, 
			 msg=>"User not allowed to view this subnet");
	}
	# Get all ips in this subnet
	map { $ips{$_->id} = $_ } $subnetobj->children;
    }else{
	# No other criteria. Return all RR objects if they have permissions for that
	if ( $manager->can($user, 'access_section', 'rest/host:get_all') ){
	    if ( my @allrrs = RR->retrieve_all() ){
		map { $rrs{$_->id} = $_ } @allrrs;
	    }else{
		$rest->throw_rest(code=>Apache2::Const::NOT_FOUND, msg=>"No records"); 
	    }
	}else{
	    $rest->throw(code=>Apache2::Const::HTTP_FORBIDDEN, 
			 msg=>"User not allowed to view all records");
	}
    }

    # Get all related IPs and names
    foreach my $rr ( values %rrs ){
	foreach my $ar ( $rr->a_records ){
	    my $ip = $ar->ipblock;
	    $ips{$ip->id} = $ip;
	} 
    }
    foreach my $ipb ( values %ips ){
	foreach my $ar ( $ipb->a_records ){
	    my $rr = $ar->rr;
	    $rrs{$rr->id} = $rr;
	}
	foreach my $ptr ( $ipb->ptr_records ){
	    my $rr = $ptr->rr;
	    $rrs{$rr->id} = $rr;
	}
    }

    my %ret;  # Return hash

    foreach my $rr ( values %rrs ){
	my $o = $rest->get(obj=>$rr, depth=>0);
	push @{$ret{RR}}, $o;
    }

    foreach my $ip ( values %ips ){
	# Return Ipblock data
	my $o = $rest->get(obj=>$ip, depth=>0);
	push @{$ret{Ipblock}}, $o;
    }	

    $rest->print_serialized(\%ret);

}elsif ( $method eq 'POST' ){
    if ( $rrid ){
	# We're updating
	my $rr = RR->retrieve($rrid);
	$rest->throw(code=>Apache2::Const::NOT_FOUND, msg=>"RR not found")
	    unless $rr;
	
	unless ( $manager->can($user, 'edit', $rr) ){
	    $rest->throw_rest(code=>Apache2::Const::HTTP_FORBIDDEN, 
			      msg=>"User not allowed to edit this object");	    
	}
	my %args; # For update method
	# These are the only records we allow changing
	foreach my $rarg ( qw/name expiration info/ ){
	    $args{$rarg} = $ARGS{$rarg} if ( defined $ARGS{$rarg} );
	}

	# Hostname validation
	if ( $args{name} && $user_type ne "Admin" ) {
	    eval {
		RR->validate_name($args{name});
	    };
	    if ( my $e = $@ ){
		$rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
			     msg=>"Bad request: $e"); 
	    }
	}
	
	eval {
	    $rr->update(\%args);
	};
	if ( my $e = $@ ){
	    $rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
			 msg=>'Bad request: $e'); 
	}
	$rest->print_serialized($rest->get(obj=>$rr, depth=>0));

    }elsif ( $ipid ){
	# We're updating
	# We only allow user to edit end-node addresses
	# if they have permissions for it
	my $ipb = Ipblock->retrieve($ipid);
	$rest->throw(code=>Apache2::Const::NOT_FOUND, msg=>"IP not found")
	    unless $ipb;
	unless ( $manager->can($user, 'edit', $ipb) ){
	    $rest->throw_rest(code=>Apache2::Const::HTTP_FORBIDDEN, 
			      msg=>"User not allowed to edit this object");	    
	}
	unless ( $ipb->status->name eq 'Static' ){
	    $rest->throw_rest(code=>Apache2::Const::HTTP_FORBIDDEN, 
			      msg=>"User not allowed to edit this object");	    
	}
	# The only thing they can change here is the DHCP host ethernet or DUID
	if ( $ethernet || $duid ){
	    my %args;
	    $args{duid} = $duid if $duid;
	    $args{physaddr} = $ethernet if ( $ethernet && !$args{duid} );
	    
	    if ( my $host = $ipb->dhcp_scopes->first ){
		# Edit the MAC on this existing scope
		eval{
		    $host->update(\%args);
		};
		if ( my $e = $@ ){
		    $rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
				 msg=>'Bad request: $e'); 
		}
	    }else{
		# Create host scope with this info
		eval{
		    DhcpScope->insert({type     => 'host',
				       ipblock  => $ipb,
				       %args,
				      });
		};
		if ( my $e = $@ ){
		    $rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
				 msg=>'Bad request: $e'); 
		}
		
	    }
	}
	$rest->print_serialized($rest->get(obj=>$ipb, depth=>0));

    }else{
	# No rrid or ipid means We're adding a new host
	my %add_args;

	if ( $name && $user_type ne "Admin" ) {
	    # Hostname validation
	    eval {
		RR->validate_name($name);
	    };
	    if ( my $e = $@ ){
		$rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
			     msg=>"Bad request: $e"); 
	    }
	}
	$add_args{name} = $name;

	foreach my $arg (qw/subnet expiration aliases cpu os info/ ){
	    $add_args{$arg} = $ARGS{$arg};
	}
	# Choose either ethernet or duid, not both
	$add_args{duid} = $duid if $duid;
	$add_args{ethernet} = $ethernet if ( $ethernet && !$add_args{duid} );

	unless ( $subnet ){
	    if ( $address ){
		$subnet = Ipblock->get_covering_block(address=>$address);
	    }else{
		$rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
			     msg=>'Bad request: Need to pass either a subnet or IP address'); 
	    }
	}

	my $subnetobj = Ipblock->objectify($subnet) or
	    $rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
			 msg=>'Bad request: invalid subnet'); 

	unless ( $manager->can($user, 'edit', $subnetobj) ){
	    $rest->throw(code=>Apache2::Const::HTTP_FORBIDDEN, 
			 msg=>"User not allowed to edit this subnet");
	}

	# Zone that corresponds to this subnet. 
	# This is our preferred zone
	my $zoneobj = $subnetobj->forward_zone();

	# If not set above, use the default zone from config
	unless ( $zoneobj ){
	    my $dfzname = Netdot->config->get('DEFAULT_DNSDOMAIN');
	    $zoneobj = (Zone->search(name=>$dfzname))[0];
	}

	# Check if the given hostname falls within a given zone
	my $zone_from_name = (Zone->search(name=>$name))[0];

	# Our given zone name comes from either the $zone parameter
	# or from the hostname itself
	my $given_zone_name = $zone || $zone_from_name;
	if ( $given_zone_name ){
	    my $given_zone = Zone->objectify($given_zone_name) or
		$rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
			     msg=>'Bad request: invalid zone given'); 

	    if ( !$zoneobj || ($zoneobj->id != $given_zone->id) ){
		# We don't have a default zone, or it doesn't match
		# the given zone, make sure that this user 
		# has permissions to edit the given zone
		if ( $manager->can($user, 'edit', $given_zone) ){
		    $zoneobj = $given_zone;
		}else{
		    $rest->throw(code=>Apache2::Const::HTTP_FORBIDDEN, 
				 msg=>"User not allowed to edit this zone");
		}
	    }
	}

	# At this point we should have a zone object
	$rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
		     msg=>"Could not determine a zone")
	    unless $zoneobj;

	# In case that hostname contains zone name
	my $zname = $zoneobj->name;
	$add_args{name} =~ s/\.$zname$//;
	$add_args{zone} = $zoneobj; 

	if ( $address ){
	    # We were given a specific address
	    if ($manager->can($user, 'choose_ip', $subnetobj)){
		$add_args{address} = $address;
	    }else{
		$rest->throw(code=>Apache2::Const::HTTP_FORBIDDEN, 
			     msg=>"User not allowed to choose an address");
	    }
	}
	my $rr;
	eval {
	    $rr = RR->add_host(%add_args);
	};
	if ( my $e = $@ ){
	    $rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
			 msg=>"Bad request: $e"); 
	}
	$rest->print_serialized($rest->get(obj=>$rr, depth=>0));
    }
}elsif ( $method eq 'DELETE' ){
    
    my @objs_to_delete;
    
    if ( $rrid ){
    	my $rr = RR->retrieve($rrid);
    	$rest->throw(code=>Apache2::Const::NOT_FOUND, msg=>"RR not found")
    	    unless $rr;
	
    	push @objs_to_delete, $rr;
	
    }elsif ( $ipid ){
	
    	my $ipb = Ipblock->retrieve($ipid);
    	$rest->throw(code=>Apache2::Const::NOT_FOUND, msg=>"IP not found")
    	    unless $ipb;
	
    	# Make sure we are only dealing with host IPs, not blocks
	unless ( $ipb->is_address ){
	    $rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
			 msg=>"Bad request: Cannot operate on blocks of addresses"); 
	}
    	# Delete A records and PTR records
    	foreach my $ar ( $ipb->a_records ){
    	    push @objs_to_delete, $ar->rr;
    	}
    	foreach my $ptr ( $ipb->ptr_records ){
    	    push @objs_to_delete, $ptr->rr;
    	}
    	# Delete DHCP hosts
    	foreach my $scope ( $ipb->dhcp_scopes ){
    	    push @objs_to_delete, $scope;
    	}
	
   }elsif ( $ethernet ){
   	my $phy = PhysAddr->search(address=>$ethernet)->first;
   	$rest->throw(code=>Apache2::Const::NOT_FOUND, msg=>"MAC not found") 
   	    unless $phy;
	
   	# Delete DhcpScope objects associated with this MAC
   	foreach my $host ( $phy->dhcp_hosts ){
   	    push @objs_to_delete, $host;
   	}
    }
    
    # Delete objects (if any) as one transaction
    if ( @objs_to_delete ){
    	eval {
    	    Netdot::Model->do_transaction( sub{ 
    		foreach my $obj ( @objs_to_delete ){
		    # The object may have been cascade-deleted
		    next if ( ref($obj) eq 'Class::DBI::Object::Has::Been::Deleted' );
		    
		    # Make sure user can do this
    		    unless ( $manager->can($user, 'delete', $obj) ){
    			$rest->throw_rest(code=>Apache2::Const::HTTP_FORBIDDEN, 
    					  msg=>"User not allowed to delete this object");
    		    }
		    $obj->delete(); 
		    
    		}	
    					   });
    	};
    	if ( my $e = $@ ){
    	    $rest->throw(code=>Apache2::Const::HTTP_BAD_REQUEST, 
    			 msg=>"Bad request: $e"); 
    	}
    }
}
</%perl>
