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

#
# Mail roles
#
# Parameters (form or url): none
#   - display selection page
#	- action : (empty)
#   - list existing mail addresses
#	- action : "list"
#	- domain : domain (last components of fqdn) of mail address
#	- idview: id of selected view
#   - add mail role
#	- action: "add"
#	- name : name (first component of fqdn) of mail address
#	- domain : domain (last components of fqdn) of mail address
#	- idview: view id of mail address
#	- namem : name (first component of fqdn) of mailbox host
#	- domainm : domain (last components of fqdn) of mailbox host
#	- idviewm: view id of mailbox host
#   - display mail host for a mail address
#	- action : "edit"
#	- name : name (first component of fqdn) of mail address (or empty)
#	- domain : domain (last components of fqdn) of mail address
#	- idview: id of selected view, or empty if no view has been selected
#   - modify mail host for a mail address
#	- action : "mod"
#	- name : name (first component of fqdn) of mail address
#	- domain : domain (last components of fqdn) of mail address
#	- namem : name (first component of fqdn) of mailbox host
#	- domainm : domain (last components of fqdn) of mailbox host
#
# History
#   2004/02/06 : pda/jean : design
#   2007/10/25 : jean     : log modify actions
#   2010/12/13 : pda      : i18n
#   2010/12/25 : pda      : use cgi-dispatch
#

#
# Template pages used by this script
#

set conf(page-sel)	mail-sel.html
set conf(page-list)	mail-list.html
set conf(page-view)	mail-view.html
set conf(page-edit)	mail-edit.html
set conf(page-mod)	mail-mod.html

#
# Next actions
# 

set conf(next)		"mail"

#
# Tabular format
# Columns :
#	- mail address
#	- mail host
#

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

#
# Netmagis general library
#

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

# ::webapp::cgidebug ; exit

##############################################################################
# Display page to select a mail address or to list all mail roles
##############################################################################

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

    #
    # Extract domains where user can declare "mail roles"
    #

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

    #
    # Extract domains where user can have mailbox hosts
    #

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

    #
    # View menus
    #

    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"
    }

    set menuviewm [mc "View"]
    append menuviewm " "
    lassign [menu-view $dbfd $tabuid(idcor) "idviewm" {}] disp html
    append menuviewm $html

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

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

##############################################################################
# List mail roles
##############################################################################

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

    set idcor $tabuid(idcor)

    #
    # Do we have permission for declaring mail roles in this domain?
    #

    set iddom -1
    set msg [check-domain $dbfd $idcor iddom domain "mailrole"]
    if {$msg ne ""} then {
	d error $msg
    }

    #
    # Check view
    #

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

    #
    # Get mail roles
    #

    set sql "
	SELECT r1.name AS namea, d1.name AS domaina,
		r2.name AS namem, d2.name AS domainm, v2.name AS viewnamem
	    FROM dns.mail_role, global.nmuser,
		dns.rr r1, dns.domain d1, dns.rr r2, dns.domain d2,
		dns.view v2
	    WHERE nmuser.idcor = $idcor
		AND mail_role.mailaddr = r1.idrr
		AND r1.iddom = d1.iddom
		AND d1.name = '$domain'
		AND r1.iddom =
			(SELECT p1.iddom FROM dns.p_dom p1
					WHERE p1.idgrp = nmuser.idgrp
					    AND p1.iddom = r1.iddom
					    AND p1.mailrole > 0
			    )
		AND mail_role.mboxhost = r2.idrr
		AND r2.iddom = d2.iddom
		AND r2.iddom =
			(SELECT p2.iddom FROM dns.p_dom p2
					WHERE p2.idgrp = nmuser.idgrp
					    AND p2.iddom = r2.iddom
			    )
		AND r2.idrr IN
			(SELECT r3.idrr FROM dns.rr_ip r3
					WHERE dns.check_ip_cor(addr, $idcor)
					    AND r3.idrr = r2.idrr
			    )
		AND r2.idrr NOT IN
			(SELECT r4.idrr FROM dns.rr_ip r4
					WHERE NOT dns.check_ip_cor(addr, $idcor)
					    AND r4.idrr = r2.idrr
			    )
		AND r1.idview = $idview
		AND r2.idview = v2.idview
		AND r2.idview IN
			(SELECT idview FROM dns.p_view pv
					WHERE pv.idgrp = nmuser.idgrp)
	    ORDER BY domaina ASC, namea ASC
		"
    set lroles {}
    pg_select $dbfd $sql tab {
	lappend lroles [list $tab(namea) $tab(domaina) \
				$tab(namem) $tab(domainm) $tab(viewnamem)]
    }

    if {[llength $lroles] == 0} then {
	set tableau [mc "No mail role found for '%s'" $domain]
    } else {
	set lines {}
	lappend lines [list "Title" \
				[mc "Mail address"]  \
				[mc "Mailbox host"]  \
			    ]
	foreach q $lroles {
	    # link "..../mail?action=edit&name=...&domain=...&idview=..."
	    lassign $q namea domaina namem domainm viewnamem

	    # only "RFC compatible" characters, no need to quote
	    d urlset "" $conf(next) [list \
						[list "action" "edit"] \
						[list "name" $namea] \
						[list "domain" $domaina] \
						[list "idview" $idview] \
					]
	    set url [d urlget ""]
	    set html [::webapp::helem "a" "$namea.$domaina" "href" $url]

	    lappend lines [list Normal $html "$namem.$domainm/$viewnamem"]
	}
	set tableau [::arrgen::output "html" $conf(tableau) $lines]
    }

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

    d result $conf(page-list) [list \
				    [list %TABLEAU% $tableau] \
				    [list %DOMAIN% $domain] \
				]
}

##############################################################################
# Add mail role
##############################################################################

d cgi-register {action add} {
    {name	1 1}
    {domain	1 1}
    {idview	1 1}
    {namem	1 1}
    {domainm	1 1}
    {idviewm	1 1}
} {
    global conf

    set idcor $tabuid(idcor)

    set name    [string trim [lindex $ftab(name) 0]]
    set domain  [string trim [lindex $ftab(domain) 0]]
    set namem   [string trim [lindex $ftab(namem) 0]]
    set domainm [string trim [lindex $ftab(domainm) 0]]

    set fqdn "$name.$domain"
    set fqdnm "$namem.$domainm"

    #
    # Check view ids
    #

    foreach v {idview idviewm} {
	set msg [check-views [list [set $v]]]
	if {$msg ne ""} then {
	    d error $msg
	}
    }
    set vn  [u viewname $idview]
    set vnm [u viewname $idviewm]

    #
    # Check permission to declare a mail role
    #

    set msg [check-authorized-host $dbfd $idcor $name $domain $idview trr "add-mailaddr"]

    if {$msg ne ""} then {
	d error $msg
    }

    #
    # Check future mailbox host
    #

    set msg [check-authorized-host $dbfd $idcor $namem $domainm $idviewm trrm "existing-host"]
    if {$msg ne ""} then {
	d error $msg
    }

    #
    # Add the mail role
    #

    d dblock {dns.rr dns.mail_role}

    set action [mc "created"]

    if {$trr(idrr) eq ""} then {
	#
	# Name of mail address does not exist. Add appropriate RR.
	#
	set msg [add-rr $dbfd $name $trr(iddom) $idview "" 0 "" 0 -1 "" "" "" $idcor trr]
	if {$msg ne ""} then {
	    d dbabort [mc "add %s" $name] $msg
	}
    }

    set sql "INSERT INTO dns.mail_role (mailaddr, mboxhost)
				VALUES ($trr(idrr), $trrm(idrr))"
    if {! [::pgsql::execsql $dbfd $sql msg]} then {
	d dbabort [mc "add %s" [mc "mail role"]] $msg
    }

    #
    # We did not had any error while modifying database.
    # Finish transaction.
    #

    d dbcommit [mc "modify %s" [mc "mail role"]]
    d writelog "modmailrole" "add mail role $fqdn/$vn -> $fqdnm/$vnm"

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

    d result $conf(page-mod) [list \
				[list %NAME% $fqdn] \
				[list %ACTION% $action] \
			    ]
}

##############################################################################
# Select mail host
##############################################################################

#
# host found in only one view (or selected view): display host edition page
#

proc disp-edit {dbfd _chkv _tabuid} {
    global conf
    upvar $_chkv chkv
    upvar $_tabuid tabuid

    #
    # Get id of found view
    #

    set idview [lindex $chkv(ok) 0]
    lassign $chkv($idview) vn msg t
    array set trr $t

    set viewname [::webapp::html-string $vn]

    #
    # In order to display mail address
    #

    set name $trr(name)
    set domain $trr(domain)

    #
    # Get RR of existing mailbox host
    #

    set rm [rr-mailrole-by-view trr $idview]
    lassign $rm idrr idviewm

    if {! [read-rr-by-id $dbfd $idrr trrm]} then {
	d error [mc "Internal error: id '%s' doesn't exists for a mail host" $idrr]
    }

    set namem $trrm(name)
    set domm $trrm(domain)
    set domainm [menu-domain $dbfd $tabuid(idcor) "domainm" "" $domm]

    set m [menu-view $dbfd $tabuid(idcor) "idviewm" [list $idviewm]]
    lassign $m disp viewval
    if {$disp} then {
	set viewlibelle [mc "View"]
    } else {
	set viewlibelle ""
    }

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

    d result $conf(page-edit) [list \
				    [list %NAME%      $name] \
				    [list %DOMAIN%    $domain] \
				    [list %IDVIEW%    $idview] \
				    [list %VIEWNAME%  $viewname] \
				    [list %NAMEM%     $namem] \
				    [list %DOMAINM%   $domainm] \
				    [list %VIEWLIBELLEM% $viewlibelle] \
				    [list %VIEWVALM%  $viewval] \
				]
}


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

    set idcor $tabuid(idcor)

    #
    # Do we have permission for declaring mail roles in this domain?
    #

    set iddom -1
    set msg [check-domain $dbfd $idcor iddom domain "mailrole"]
    if {$msg ne ""} then {
	d error $msg
    }

    set namem ""
    set domm ""

    #
    # Check mail address syntax
    #

    set msg [check-name-syntax $name]
    if {$msg ne ""} then {
	d error $msg
    }

    #
    # Do we have permission for this mail role (may be in this particular view)
    #

    set fqdn "$name.$domain"
    if {$idview eq ""} then {
	set idviews {}
    } else {
	set idviews [list $idview]
    }

    set msg [filter-views $dbfd tabuid "mailrole" $fqdn $idviews chkv]
    if {$msg ne ""} then {
	d error $msg
    }

    #
    # If only one view is found to be correct, go directly to the
    # modify form
    #

    if {[llength $chkv(ok)] == 1} then {
	disp-edit $dbfd chkv tabuid
    } else {
	set html [html-select-view chkv $conf(next)]
	d result $conf(page-view) [list \
					[list %LIST% $html] \
				]
    }
}

##############################################################################
# Modify mail host
##############################################################################

d cgi-register {action mod} {
    {name	1 1}
    {domain	1 1}
    {idview	1 1}
    {namem	1 1}
    {domainm	1 1}
    {idviewm	1 1}
} {
    global conf

    set idcor $tabuid(idcor)

    set name    [string trim [lindex $ftab(name) 0]]
    set domain  [string trim [lindex $ftab(domain) 0]]
    set namem   [string trim [lindex $ftab(namem) 0]]
    set domainm [string trim [lindex $ftab(domainm) 0]]

    set fqdn "$name.$domain"
    set fqdnm "$namem.$domainm"

    #
    # Do we have permission for this mail role
    #

    set msg [filter-views $dbfd tabuid "mailrole" $fqdn [list $idview] chkv]
    if {$msg ne ""} then {
	d error $msg
    }
    if {[llength $chkv(ok)] != 1} then {
	d error "Internal error"
    }

    set idv [lindex $chkv(ok) 0]
    lassign $chkv($idv) vn msg t
    array set trr $t
    set idrr $trr(idrr)

    #
    # Check new mailbox host
    #

    if {$namem ne ""} then {
	set msg [check-authorized-host $dbfd $tabuid(idcor) $namem $domainm $idviewm trrm "existing-host"]
	if {$msg ne ""} then {
	    d error $msg
	}
    }

    #
    # Insert data in database: if namem is empty, it is a removal,
    # else it is a modification.
    #

    d dblock {dns.rr dns.mail_role}

    if {$namem eq ""} then {
	#
	# Mail role removal
	#

	set action [mc "deleted"]

	set msg [del-mailrole-by-id $dbfd $idrr]
	if {$msg ne ""} then {
	    d dbabort [mc "delete %s" [mc "mail role"]] $msg
	}

	#
	# RR removal (if possible)
	#
	set msg [del-orphaned-rr $dbfd $idrr]
	if {$msg ne ""} then {
	    d dbabort [mc "delete %s" [mc "RR"]] $msg
	}

	set lm "delete mail role $fqdn"
    } else {
	#
	# Mail role modification
	#

	set action [mc "modified"]

	set sql "UPDATE dns.mail_role
			    SET mboxhost = $trrm(idrr)
			    FROM dns.rr
			    WHERE mail_role.mailaddr = rr.idrr
				AND rr.idrr = $idrr
				AND rr.idview = $idview"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    d dbabort [mc "modify %s" [mc "mail role"]] $msg
	}
	set lm "modify mail role $fqdn -> $fqdnm"
    }

    #
    # We did not had any error while modifying database.
    # Finish transaction.
    #

    d dbcommit [mc "modify %s" [mc "mail role"]]
    d writelog "modmailrole" $lm

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

    d result $conf(page-mod) [list \
				[list %NAME% $fqdn] \
				[list %ACTION% $action] \
			    ]
}

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

d cgi-dispatch "dns" ""
