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

#
# Modification of mail relays
#
# Parameters (form or url):
#   - display domain selection page
#	- action : empty
#   - display edit page
#	- action : "edit"
#	- domain : domain name to edit
#   - store MX modifications
#	- action : "mod"
#	- domain : domain name to modify
#	- prio* : MX priority for this domain
#	- name* : MX name for this domain
#	- domain* : MX domain for this domain
#
# History
#   2004/03/04 : pda/jean : design
#   2007/10/25 : jean     : log modify actions
#   2010/12/09 : pda      : i18n
#   2010/12/26 : pda      : use cgi-dispatch
#   2013/03/20 : pda      : add views
#

#
# Template pages used by this script
#

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

#
# Next actions
# 

set conf(next)		"admmrel"

#
# 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 list of mail relays in the database
#
# Input:
#   - parameters:
#	- dbfd : database handle
#	- iddom : domain id
#	- lrel : list of relays
# Output:
#   - return value: empty string or error message
#
# History
#   2004/03/04 : pda/jean : copy from MX function
#

proc insert-relay {dbfd iddom lrel} {
    foreach rel $lrel {
	lassign $rel prio idmx
	set sql "INSERT INTO dns.relay_dom (iddom, prio, mx)
				    VALUES ($iddom, $prio, $idmx)"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    return [mc "Relay insertion failed: %s" $msg]
	}
    }
    return ""
}

##############################################################################
# Display domain selection page
##############################################################################

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

    #
    # Get domains authorized for the user
    #

    set w "p_dom.mailrole <> 0"
    set domain [menu-domain $dbfd $tabuid(idcor) "domain" $w ""]

    #
    # 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] \
			    ]
}

##############################################################################
# Display domain edit page
##############################################################################

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

    set idcor $tabuid(idcor)
    set domain [lindex $ftab(domain) 0]

    #
    # Check view
    #

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

    #
    # Check domain
    #

    set iddom -1
    set msg [check-domain-relay $dbfd $tabuid(idcor) iddom $domain $idview]
    if {$msg ne ""} then {
	d error $msg
    }

    #
    # Display existing relay information
    #

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

    set msg [display-tabular $width $titles $spec $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 %DOMAIN%  $domain] \
				[list %IDVIEW%  $idview] \
				[list %VIEW%    [u viewname $idview]] \
			    ]
}

##############################################################################
# Store modifications
##############################################################################

d cgi-register {action mod} {
    {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 domain [string trim [lindex $ftab(domain) 0]]

    #
    # Check view
    #

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

    #
    # Check domain
    #

    set iddom -1
    set msg [check-domain-relay $dbfd $tabuid(idcor) iddom $domain $idview]
    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 lrel {}
    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 lrel $mx
		}
	    } else {
		d error [mc "Invalid form values (%s)" "$idxprio, $idxname, $idxdom"]
	    }
	}
    }

    #
    # Start transaction
    #

    d dblock {}

    #
    # First, delete all previous relays
    #

    set sql "DELETE FROM dns.relay_dom
    			USING dns.rr
			WHERE rr.idrr = relay_dom.mx
			    AND relay_dom.iddom = $iddom
			    AND rr.idview = $idview"
    if {! [::pgsql::execsql $dbfd $sql msg]} then {
	d dbabort [mc "delete %s" [mc "old mail relays"]] $msg
    }

    #
    # Insert relay RRs
    #

    set msg [insert-relay $dbfd $iddom $lrel]
    if {$msg ne ""} then {
	d dbabort [mc "add %s" [mc "new mail relays"]] $msg
    }

    #
    # Unlock and commit modifications
    #

    d dbcommit [mc "modify %s" [mc "mail relays"]]

    #
    # Present informations stored in database
    #

    set lm {}
    if {[llength $lrel] > 0} then {
	set lines {}
	lappend lines [list "Title" [mc "Priority"] [mc "Name"]]
	foreach mx $lrel {
	    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 "modrelay" "relay replacement for $domain: [join $lm {, }]"
    } else {
	set tableau [mc "Mail relays deleted"]
	d writelog "modrelay" "relay deleted for $domain"
    }

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

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

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

d cgi-dispatch "admin" "admin"
