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

#
# MX modifications
#
# Parameters (form or url):
#   - display domain selection page
#	- action : empty
#   - display MX edit page
#	- action : "edit"
#	- name : name of MX to edit
#	- domain : domain of MX to edit
#	- idview: view id
#   - store MX modifications
#	- action : "mod"
#	- name : name of MX to modify
#	- domain : domain of MX to modify
#	- idview: view id
#	- prio* : MX priority
#	- name* : MX name
#	- domain* : MX domain
#
# History
#   2003/04/24 : pda/jean : design
#   2003/05/13 : pda/jean : use auth base
#   2004/03/04 : pda/jean : check-mx is now common
#   2007/10/25 : jean     : log modify actions
#   2010/12/06 : pda      : i18n
#   2010/12/26 : pda      : use cgi-dispatch
#   2013/03/21 : pda      : add views
#

#
# Template pages used by this script
#

set conf(page-sel)	admmx-sel.html
set conf(page-edit)	admmx-edit.html
set conf(page-mod)	admmx-mod.html

#
# Next actions
# 

set conf(next)		"admmx"

#
# Script parameters
#

set conf(tableau) {
    global {
	chars {12 normal}
	columns {20 80}
	botbar {yes}
	align {left}
    }
    pattern Title {
	title {yes}
	topbar {yes}
	chars {bold}
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
    }
    pattern Normal {
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
    }
}

#
# Netmagis general library
#

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

# ::webapp::cgidebug ; exit

##############################################################################
# Utilities
##############################################################################

#
# Insert a MX list in the database
#
# Input:
#   - parameters:
#	- dbfd : database handle
#	- idrr : RR id
#	- lmx : list of MX
# Output:
#   - return value : empty string or error message
#
# History
#   2003/04/25 : pda/jean : design
#   2010/12/14 : pda      : minor simplification
#

proc insert-mx {dbfd idrr lmx} {
    set msg ""
    foreach mx $lmx {
	lassign $mx prio idmx
	set sql "INSERT INTO dns.rr_mx (idrr, prio, mx)
				VALUES ($idrr, $prio, $idmx)"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    break
	}
    }
    return $msg
}

##############################################################################
# Domain selection
##############################################################################

d cgi-register {action {}} {
} {
    global conf

    #
    # Get domains authorized for the user
    #

    set domain [menu-domain $dbfd $tabuid(idcor) "domain" "" ""]

    #
    # Get views authorized for the user
    #

    set menuview [mc "View"]
    append menuview " "
    lassign [menu-view $dbfd $tabuid(idcor) "idview" {}] disp html
    append menuview $html
    if {$disp} then {
	set dispview "inline"
    } else {
	set dispview "none"
    }

    #
    # End of script: output page and close database
    #

    d urlset "%URLFORM%" $conf(next) {}
    d result $conf(page-sel) [list \
				[list %DOMAIN%   $domain] \
				[list %DISPVIEW% $dispview] \
				[list %MENUVIEW% $menuview] \
			    ]
}

##############################################################################
# MX edit page
##############################################################################

d cgi-register {action edit} {
    {name	1 1}
    {domain	1 1}
    {idview	1 1}
} {
    global conf

    #
    # Initialization
    #

    set name   [lindex $ftab(name) 0]
    set domain [lindex $ftab(domain) 0]

    #
    # Check view
    #

    set msg [check-views [list $idview]]
    if {$msg ne ""} then {
	d error $msg
    }

    #
    # Check MX 
    #

    set msg [check-authorized-mx $dbfd $tabuid(idcor) $name iddom $domain $idview exists trr]
    if {$msg ne ""} then {
	d error $msg
    }

    #
    # Present MX informations
    #

    if {$exists} then {
	set idrr $trr(idrr)
    } else {
	set idrr -1
    }

    set cwidth {10 50 40}
    set ctitle [list \
		    [list "text" [mc "Priority"]] \
		    [list "text" [mc "Name"]] \
		    [list "text" [mc "Domain"]] \
		    ]
    set menudom [couple-domains $dbfd $tabuid(idcor) ""]
    set cspec [list \
		{prio {string 5}  {}} \
		{name {string 30} {}} \
		[list domain [list menu $menudom] {}] \
	    ]
    set sql "SELECT m.mx, m.prio, r.name, d.name AS domain
		FROM dns.rr_mx m, dns.rr r, dns.domain d
		WHERE m.idrr = $idrr
			AND m.mx = r.idrr
			AND r.iddom = d.iddom
			AND r.idview = $idview
		ORDER BY m.prio, d.name, r.name
		"
    set idnum "mx"

    set msg [display-tabular $cwidth $ctitle $cspec $dbfd $sql $idnum tableau]
    if {$msg ne ""} then {
	d error $msg
    }

    #
    # End of script: output page and close database
    #

    d urlset "%URLFORM%" $conf(next) {}
    d result $conf(page-edit) [list \
				[list %TABLEAU% $tableau] \
				[list %NAME%    $name] \
				[list %DOMAIN%  $domain] \
				[list %IDVIEW%  $idview] \
				[list %VIEW%    [u viewname $idview]] \
			    ]
}

##############################################################################
# Store MX modifications
##############################################################################

d cgi-register {action mod} {
    {name		1 1}
    {domain		1 1}
    {idview		1 1}

    {prio[0-9]+		0 9999}
    {name[0-9]+		0 9999}
    {domain[0-9]+	0 9999}

    {prion[0-9]+	0 9999}
    {namen[0-9]+	0 9999}
    {domainn[0-9]+	0 9999}
} {
    global conf

    #
    # Initialization
    #

    set name   [lindex $ftab(name) 0]
    set domain [lindex $ftab(domain) 0]
    set fqdn   "$name.$domain"

    #
    # Check view
    #

    set msg [check-views [list $idview]]
    if {$msg ne ""} then {
	d error $msg
    }

    #
    # Check MX
    #

    set msg [check-authorized-mx $dbfd $tabuid(idcor) $name iddom $domain $idview exists trr]
    if {$msg ne ""} then {
	d error $msg
    }

    #
    # Traverse list of form variables and build a list:
    #		{{prio idmx} ... }
    # where :
    #  - prio = numeric priority
    #  - idmx = id of an existing RR
    #

    set lmx {}
    foreach c [array names ftab] {
	if {[regexp {^prio(n?)([0-9]+)$} $c bidon n idmx]} then {
	    set idxprio prio$n$idmx
	    set idxname name$n$idmx
	    set idxdom  domain$n$idmx
	    if {[info exists ftab($idxprio)] && \
			    [info exists ftab($idxname)] && \
			    [info exists ftab($idxdom)] \
		    } then {
		set fprio [string trim [lindex $ftab($idxprio) 0]]
		set fname [string trim [lindex $ftab($idxname) 0]]
		set fdom  [string trim [lindex $ftab($idxdom)  0]]
		if {$fprio ne ""} then {
		    set mx [check-mx-target $dbfd $fprio $fname $fdom $idview $tabuid(idcor) msg]
		    if {$msg ne ""} then {
			d error $msg
		    }
		    if {[info exists tmx([lindex $mx 1])]} then {
			d error [mc "'%s' specified more than once" "$fname.$fdom"]
		    }
		    lappend lmx $mx
		}
	    } else {
		d error [mc "Invalid form values (%s)" "$idxprio, $idxname, $idxdom"]
	    }
	}
    }

    #
    # Insert and delete operations
    #

    d dblock {}

    if {$exists} then {
	#
	# Delete all previous MX
	#

	set sql "DELETE FROM dns.rr_mx WHERE idrr = $trr(idrr)"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    d dbabort [mc "delete %s" [mc "old MX"]] $msg
	}

	#
	# If lmx list is empty, delete RR
	#

	if {[llength $lmx] == 0} then {
	    #
	    # Delete RR
	    #

	    set msg [del-orphaned-rr $dbfd $trr(idrr)]
	    if {$msg ne ""} then {
		d dbabort [mc "delete %s" $fqdn] $msg
	    }
	} else {
	    #
	    # Insert MX RRs
	    #
	    set msg [insert-mx $dbfd $trr(idrr) $lmx]
	    if {$msg ne ""} then {
		d dbabort [mc "add %s" "MX"] $msg
	    }
	}
    } else {
	#
	# RR does not exist yet
	#

	if {[llength $lmx] == 0} then {
	    #
	    # This case should not happen: user has asked for MX
	    # creation, but did not imput any MX.
	    #
	    d dbabort [mc "add %s" "MX"] [mc "No MX given for %s" $fqdn]
	} else {
	    #
	    # Create RR
	    #

	    # XXX : No comment, nor any responsible. May be later...
	    set msg [add-rr $dbfd $name $iddom $idview "" 0 "" 0 -1 "" "" "" \
				$tabuid(idcor) trr]
	    if {$msg ne ""} then {
		d dbabort [mc "add %s" $fqdn] $msg
	    }

	    #
	    # Insert MX RRs
	    #
	    set msg [insert-mx $dbfd $trr(idrr) $lmx]
	    if {$msg ne ""} then {
		d dbabort [mc "add %s" "MX"] $msg
	    }
	}
    }

    #
    # Unlock and commit modifications
    #

    d dbcommit [mc "modify %s" "MX"]

    #
    # Present informations stored in database
    #

    if {[llength $lmx] > 0} then {
	set lines {}
	lappend lines [list "Title" [mc "Priority"] [mc "Name"]]
	set lm {}
	foreach mx $lmx {
	    lassign $mx prio idmx
	    read-rr-by-id $dbfd $idmx tabmx
	    set n "$tabmx(name).$tabmx(domain)"
	    lappend lines [list "Normal" $prio $n]
	    lappend lm $n
	}
	set tableau [::arrgen::output "html" $conf(tableau) $lines]
	d writelog "addmx" "add mx [join $lm {, }] for $fqdn"
    } else {
	set tableau [mc "MX deleted"]
	d writelog "supprmx" "delete MX $fqdn"
    }

    #
    # End of script: output page and close database
    #

    d result $conf(page-mod) [list \
				[list %TABLEAU% $tableau] \
				[list %NAME%    $name] \
				[list %DOMAIN%  $domain] \
				[list %VIEW%    [u viewname $idview]] \
			    ]
}

##############################################################################
# Main procedure
##############################################################################

d cgi-dispatch "admin" "admin"
