#!/usr/local/bin/tclsh8.6

#
# Modify RR attributes of a host in Netmagis database
#
# Syntax:
#   dnsmodattr <fqdn> <view> <key> <val> [<key> <val> ...]
#
# Examples:
#   dnsmodattr www.example.com default MAC 00:68:fe....
#   dnsmodattr www.example.com external HINFO "PC/Unix"
#   dnsmodattr www.example.com internal TTL 3600      # 1 hour
#   dnsmodattr www.example.com internal TTL ""        # put back default value
#
# Modifiable attributes (keys):
#   MAC, HINFO, RESPNAME, RESPMAIL, COMMENT, DHCPPROFILE, TTL, SENDSMTP
#
# History
#   2004/09/29 : pda/jean : specification
#   2004/10/01 : pda/jean : coding
#   2005/04/08 : pda/jean : add DHCP profile
#   2007/10/25 : jean     : log modify actions
#   2008/12/09 : jean     : add TTL
#   2010/12/18 : pda      : use new install system
#   2013/04/05 : pda/jean : add views
#

source /usr/local/lib/netmagis/libnetmagis.tcl

set conf(attrs)		{mac hinfo respname respmail comment dhcpprofile ttl sendsmtp}

##############################################################################
# Small utility functions
##############################################################################

proc syntax-error {argv0} {
    global conf

    regsub {.*/} $argv0 {} argv0
    set msg "usage: $argv0 fqdn view key val \[key val ...\]\n"
    set attrs [string toupper [join $conf(attrs) ", "]]
    append msg "\tkey = $attrs"
    return $msg
}

##############################################################################
# Update RR attributes
##############################################################################

#
# Update RR attributes in the database
#
# Input:
#   - dbfd: database handle
#   - _trr: rr to modify (see read-rr-by-id)
#   - idview: view id
#   - _tattr: array with new attributes
# Output:
#   - return value: error message or empty string
#
# History
#   2004/10/01 : pda/jean : design
#   2013/04/05 : pda/jean : add views
#

proc update-rr {dbfd _trr idview _tattr} {
    upvar $_trr trr
    upvar $_tattr tattr

    #
    # Check SMTP rights
    #

    if {[info exists tattr(sendsmtp)]} then {
	set sendsmtp $tattr(sendsmtp)
	if {$sendsmtp ne "" && (![regexp {^[0-1]$} $sendsmtp])} {
	    return [mc "Invalid SMTP emit right (must be 0 or 1)"]
	}
    }

    #
    # Check TTL
    # Maximum value = 2^31 - 1 (see RFC 3181)
    # To remove TTL, give an empty string
    #

    if {[info exists tattr(ttl)]} then {
	if {$tattr(ttl) eq ""} then {
	    set tattr(ttl) -1
	}  else {
	    set msg [check-ttl $tattr(ttl)]
	    if {$msg ne ""} then {
		return $msg
	    }
	}
    }

    #
    # Check MAC address
    #

    if {[info exists tattr(mac)]} then {
	set msg [check-mac $dbfd $tattr(mac) trr $idview]
	if {$msg ne ""} then {
	    return $msg
	}
	set newmac $tattr(mac)
    } else {
	set newmac $trr(mac)
    }

    #
    # Check Hinfo
    #

    if {[info exists tattr(hinfo)]} then {
	set idhinfo [read-hinfo $dbfd $tattr(hinfo)]
	if {$idhinfo == -1} then {
	    return [mc "Invalid HINFO attribute '%s'" $tattr(hinfo)]
	}
	set tattr(hinfo) $idhinfo
    }

    #
    # Check DHCP profile
    #

    if {[info exists tattr(dhcpprofile)]} then {
	set iddhcpprof [read-dhcp-profile $dbfd $tattr(dhcpprofile)]
	if {$iddhcpprof == -1} then {
	    return [mc "Invalid DHCP profile '%s'" $tattr(dhcpprofile)]
	}
	set tattr(dhcpprofile) $iddhcpprof
	set newiddhcpprof $tattr(dhcpprofile)
    } else {
	set newiddhcpprof $trr(iddhcpprof)
    }


    if {($newmac eq "" && $newiddhcpprof != 0)} then {
	return [mc "You cannot set a DHCP profile without a MAC address"]
    }

    #
    # Build the SQL request
    #

    set mod {}
    foreach c [array names tattr] {
	set v $tattr($c)
	switch $c {
	    hinfo {
		# numeric value
		lappend mod "idhinfo = $v"
	    }
	    sendsmtp {
		# numeric value
		lappend mod "sendsmtp = $v"
	    }
	    dhcpprofile {
		# numeric value or empty string
		if {$v eq "" || $v == 0} then {
		    lappend mod "iddhcpprof = NULL"
		} else {
		    lappend mod "iddhcpprof = $v"
		}
	    }
	    ttl {
		# numeric value or empty string
		if {$v eq ""} then {
		    lappend mod "$c = -1"
		} else {
		    lappend mod "$c = $v"
		}
	    }
	    default {
		# string
		if {$v eq ""} then {
		    lappend mod "$c = NULL"
		} else {
		    lappend mod "$c = '[::pgsql::quote $v]'"
		}
	    }
	}
    }

    set mod [join $mod ", "]
    set sql "UPDATE dns.rr SET $mod WHERE idrr = $trr(idrr)"

    if {! [::pgsql::execsql $dbfd $sql msg]} then {
	return $msg
    }

    set msg [touch-rr $dbfd $trr(idrr)]
    if {$msg ne ""} then {
	return $msg
    }

    #
    # Update log
    #

    set m "modify $trr(name).$trr(domain):"
    foreach c [array names tattr] {
	append m " $c=$tattr($c)"
    }
    d writelog "modrr" $m

    return ""
}

##############################################################################
# Main program
##############################################################################

proc main {argv0 argv} {
    global conf

    #
    # Initialization
    #

    set msg [d init-script dbfd $argv0 false tabcor]
    if {$msg ne ""} then {
	d error $msg
    }

    #
    # Check arguments
    #

    set nargs [llength $argv]
    if {[expr $nargs % 2] != 0 || $nargs < 4} then {
	d error [syntax-error $argv0]
    }
    set fqdn [lindex $argv 0]
    set view [lindex $argv 1]
    set argv [lreplace $argv 0 1]

    #
    # Check access to view
    #

    set idview [u viewid $view]
    if {$idview == -1} then {
	d error [mc "Invalid view '%s'" $view]
    }
    if {! [u isallowedview $idview]} then {
	d error [mc "Access denied to view '%s'" $view]
    }

    #
    # Host name validation
    #

    set fqdn [string tolower $fqdn]
    set msg [check-fqdn-syntax $dbfd $fqdn name domain iddom]
    if {$msg ne ""} then {
	d error $msg
    }
    set name [string tolower $name]

    #
    # Lock database in order to work on consistent data
    #

    d dblock {dns.rr dns.rr_ip}

    #
    # Check access to name
    #

    set msg [check-authorized-host $dbfd $tabcor(idcor) $name $domain $idview trr "existing-host"]
    if {$msg ne ""} then {
        d error $msg
    }

    #
    # Create an array indexed by keys given on the argument line
    #
    
    foreach {key val} $argv {
	set key [string tolower $key]
	# is the key an authorized key?
	if {[lsearch -exact $conf(attrs) $key] == -1} then {
	    d error [syntax-error $argv0]
	}
	# is the key given twice?
	if {[info exists tabattr($key)]} then {
	    d error [syntax-error $argv0]
	}
	set tabattr($key) $val
    }

    #
    # Process to the modification
    #

    set msg [update-rr $dbfd trr $idview tabattr]
    if {$msg ne ""} then {
	d error [d dbabort "modify" $msg]
    }
    d dbcommit "modify"

    #
    # End
    #

    d end
    return 0
}

exit [main $argv0 $argv]
