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

#
# Store host modifications
#
# Parameters (form or url):
#   - display host selection page
#	- action : (none)
#   - display host edit page
#	- action : "edit"
#	- name : original name of the host
#	- domain : original domain of the host
#	- idview : view id (or empty if no view has been selected)
#   - modification of host informations
#	- action : "store"
#	- confirm : "no" or "yes" (if confirm ok)
#	- idrr : original idrr of host
#	- idview : view id
#	- name : modified name of the host
#	- domain : modified domain of the host
#	- mac : modified mac address
#	- iddhcpprof : modified DHCP profile (or 0)
#	- hinfo : host type (id)
#	- sendsmtp : non existant, or non empty
#	- ttl : value (or empty if now allowed)
#	- comment : comments
#	- respname : name of person responsible for this host
#	- respmail : mail of person responsible for this host
#
# History
#   2002/05/03 : pda/jean : design
#   2002/05/23 : pda/jean : add responsible
#   2002/07/09 : pda      : add nologin
#   2002/07/09 : pda      : convert names to lowercase
#   2003/05/13 : pda/jean : use auth base
#   2004/08/05 : pda/jean : add mac
#   2005/04/08 : pda/jean : add dhcppprofil
#   2007/10/25 : jean     : log modify actions
#   2008/02/13 : pda/jean : responsible person is the current user by default
#   2008/07/25 : pda/jean : add smtp emit right
#   2010/10/14 : pda      : add journey (via next)
#   2010/10/26 : pda      : check dhcpprofile case when no mac address
#   2010/10/26 : pda      : make name and domain editable
#   2010/10/31 : pda      : add ttl
#   2010/12/14 : pda      : i18n
#   2010/12/25 : pda      : use cgi-dispatch
#   2012/09/20 : pda/jean : remove dns update interval
#   2012/11/29 : pda/jean : add views
#

#
# Template pages used by this script
#

set conf(page-sel)	mod-sel.html
set conf(page-view)	mod-view.html
set conf(page-edit)	mod-edit.html
set conf(page-ok)	mod-ok.html
set conf(page-smtp)	mod-smtp.html

#
# Next actions
# 

set conf(next)		"mod"
set conf(nextmap)	"net"
set conf(nextlist)	"net"
set conf(nextadd)	"add"
set conf(nextdel)	"del"
set conf(nextsearch)	"search"

#
# Netmagis general library
#

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

# ::webapp::cgidebug ; exit

##############################################################################
# Display host selection page
##############################################################################

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

    #
    # Get domains authorized for the user
    #

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

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

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

##############################################################################
# Display host edit page
##############################################################################

#
# 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 hvn [::webapp::html-string $vn]

    #
    # In order to display original name of host
    #

    set vname $trr(name)
    set vdomain $trr(domain)

    #
    # Default values for all fields
    #

    set name [::webapp::form-text name 1 20 64 $trr(name)]
    set domain [menu-domain $dbfd $tabuid(idcor) domain "" $trr(domain)]

    set val [::webapp::html-string $trr(mac)]
    set mac [::webapp::form-text mac 1 20 17 $val]
    lassign [menu-dhcp-profile $dbfd iddhcpprof $tabuid(idcor) $trr(iddhcpprof)] \
	dhcpproflibelle dhcpprofmenu

    set menuhinfo [menu-hinfo $dbfd hinfo $trr(hinfo)]

    lassign [menu-sendsmtp $dbfd "sendsmtp" tabuid $trr(sendsmtp)] \
	sendsmtplibelle sendsmtpmenu

    lassign [menu-ttl $dbfd "ttl" tabuid $trr(ttl)] ttllibelle ttlval

    set val [::webapp::html-string $trr(comment)]
    set comment [::webapp::form-text comment 1 50 50 $val]

    set val [::webapp::html-string $trr(respname)]
    set respname [::webapp::form-text respname 1 50 50 $val]

    set val [::webapp::html-string $trr(respmail)]
    set respmail [::webapp::form-text respmail 1 50 50 $val]

    #
    # Next script
    #

    d urlset "%URLFORM%" $conf(next) {}
    d urladdnext "%URLFORM%"

    d urlset "%URLADD%" $conf(nextadd) {}
    d urlset "%URLDEL%" $conf(nextdel) {}

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

    d result $conf(page-edit) [list \
					[list %IDRR% $trr(idrr)] \
					[list %IDVIEW% $idview] \
					[list %ONAME% $vname] \
					[list %ODOMAIN% $vdomain] \
					[list %VIEWNAME% $hvn] \
					[list %NAME% $name] \
					[list %DOMAIN% $domain] \
					[list %MAC% $mac] \
					[list %DHCPPROFLIBELLE% $dhcpproflibelle] \
					[list %DHCPPROFMENU% $dhcpprofmenu] \
					[list %MENUHINFO% $menuhinfo] \
					[list %SENDSMTPLIBELLE% $sendsmtplibelle] \
					[list %SENDSMTPMENU% $sendsmtpmenu] \
					[list %TTLLIBELLE% $ttllibelle] \
					[list %TTLVAL% $ttlval] \
					[list %COMMENT% $comment] \
					[list %RESPNAME% $respname] \
					[list %RESPMAIL% $respmail] \
			    ]
}

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

    #
    # Validate form input
    #

    set fqdn "$name.$domain"

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

    #
    # Get all possible views (if idview is not given) or get
    # only filtered views (if idview is given)
    #

    if {$idview == ""} then {
	set idviews {}
    } else {
	set idviews [list $idview]
    }
    set msg [filter-views $dbfd tabuid "host" $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] \
				]
    }
}

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

# History
#   2002/05/03 : pda/jean : design
#

d cgi-register {action store} {
    {confirm	1 1}
    {idrr	1 1}
    {idview	1 1}
    {name	1 1}
    {domain	1 1}
    {mac	1 1}
    {iddhcpprof 1 1}
    {hinfo	1 1}
    {sendsmtp	0 1}
    {ttl	1 1}
    {comment	1 1}
    {respname	1 1}
    {respmail	1 1}
} {
    global conf

    set login $tabuid(login)
    set idcor $tabuid(idcor)

    #
    # Check host idrr
    # It must not be an alias, and user must own all addresses
    #

    if {! [regexp {^\d+$} $idrr]} then {
	d error [mc "Invalid input '%s'" $idrr]
    }
    if {! [read-rr-by-id $dbfd $idrr trr]} then {
	d error [mc "Cannot read host-id %s" $idrr]
    }
    # test if host exists
    if {$trr(idrr) eq ""} then {
	d error [mc "Host id %s not found" $idrr]
    }

    #
    # Check authorized access for host in view
    #

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

    #
    # Check new name and domain
    #

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

    set msg [check-authorized-host $dbfd $idcor $name $domain $idview ntrr "host"]
    if {$msg ne ""} then {
	d error $msg
    }
    set nidrr $ntrr(idrr)
    if {$nidrr != $idrr} then {
	#
	# New host or domain. We must check it does not already exist.
	#
	set nlip [rr-ip-by-view ntrr $idview]
    	if {[llength $nlip] > 0} then {
	    d error [mc "Host '%s' already exists" "$name.$domain"]
	}
    }
    set iddom $ntrr(iddom)

    #
    # Check various informations
    #

    set msg [check-mac $dbfd $mac trr $idview]
    if {$msg ne ""} then {
	d error $msg
    }

    if {! [check-iddhcpprof $dbfd $iddhcpprof dhcpprofile msg]} then {
	d error $msg
    }
    if {$mac eq "" && $iddhcpprof != 0} then {
	d error [mc "You cannot set a DHCP profile without a MAC address"]
    }

    set idhinfo [read-hinfo $dbfd $hinfo]
    if {$idhinfo == -1} then {
	d error [mc "Host type '%s' not found" $hinfo]
    }

    if {$tabuid(p_smtp)} then {
	if {$sendsmtp eq ""} then {
	    set sendsmtp 0
	} else {
	    set sendsmtp 1
	}
    } else {
	set sendsmtp 0
    }

    if {$tabuid(p_ttl)} then {
	if {$ttl eq ""} then {
	    set ttl -1
	} else {
	    set msg [check-ttl $ttl]
	    if {$msg ne ""} then {
		d error $msg
	    }
	}
    } else {
	set ttl -1
    }

    #
    # If responsible person is not specified, this is the user by default
    #

    if {$respname eq "" && $respmail eq ""} then {
	set respname "$tabuid(lastname) $tabuid(firstname)"
	set respmail $tabuid(mail)
    }

    #
    # Ask for confirmation if user asked for SMTP emit right
    # (and this right was now allowed before)
    #

    if {! $trr(sendsmtp) && $sendsmtp && $confirm ne "yes"} then {
	#
	# Confirmation page
	#

	set l {idrr idview name domain mac iddhcpprof hinfo sendsmtp ttl
			comment respname respmail}
	set hidden [::webapp::hide-parameters $l ftab]
	d urlset "%URLFORM%" $conf(next) {}
	d urladdnext "%URLFORM%"
	d result $conf(page-smtp) [list \
						[list %HIDDEN% $hidden] \
			    ]
	return 0
    }

    #
    # Store modificationas
    #

    d dblock {dns.rr}

    if {! $tabuid(p_smtp)} then {
	set sendsmtp $trr(sendsmtp)
    }
    if {! $tabuid(p_ttl)} then {
	set ttl $trr(ttl)
    }

    #
    # Differentiate 3 cases:
    #							
    #	Case							ntrr(idrr) = ?
    #	------------------------------------------		---------------
    #	name does not change => use same RR			old $idrr
    #	name changes and there is no RR for new name		empty
    #	name changes and there is an existing RR for new name	value != $idrr
    #

    if {$nidrr eq ""} then {
	#
	# Case "name changes and there is no RR for new name"
	# Create a new RR for the new name.
	# Remove MAC from old RR first, since there is a unicity
	# constraint on it.
	#

	set sql "UPDATE dns.rr SET mac = NULL WHERE idrr = $idrr"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	   d dbabort [mc "modify %s" "$name.$domain"] $msg
	}

	set msg [add-rr $dbfd $name $iddom $idview $mac $iddhcpprof $idhinfo \
					$sendsmtp $ttl \
					$comment $respname $respmail \
					$tabuid(idcor) ntrr]
	if {$msg ne ""} then {
	    d dbabort [mc "modify %s" [mc "RR"]] $msg
	}
	set nidrr $ntrr(idrr)

	#
	# Update all references to the host in this view
	#

	set msg [update-host-refs $dbfd $idrr $nidrr]
	if {$msg ne ""} then {
	    d dbabort [mc "modify %s" [mc "RR"]] $msg
	}

	#
	# Remove old RR if possible
	#

	set msg [del-orphaned-rr $dbfd $idrr]
	if {$msg ne ""} then {
	    d dbabort [mc "modify %s" [mc "RR"]] $msg
	}

	set idrr $nidrr

    } else {
	if {$mac eq ""} then {
	    set qmac NULL
	} else {
	    set qmac "'[::pgsql::quote $mac]'"
	}
	if {$iddhcpprof == 0} then {
	    set qiddhcpprof NULL
	} else {
	    set qiddhcpprof $iddhcpprof
	}
	set qname     [::pgsql::quote $name]
	set qcomment  [::pgsql::quote $comment]
	set qrespname [::pgsql::quote $respname]
	set qrespmail [::pgsql::quote $respmail]

	if {$nidrr eq $idrr} then {
	    #
	    # Name does not change
	    #
	    set sql "UPDATE dns.rr SET
				    name = '$qname',
				    iddom = $iddom,
				    mac = $qmac,
				    iddhcpprof = $qiddhcpprof,
				    idhinfo = $idhinfo,
				    sendsmtp = $sendsmtp,
				    ttl = $ttl,
				    comment = '$qcomment',
				    respname = '$qrespname',
				    respmail = '$qrespmail'
				WHERE idrr = $idrr"
	    if {! [::pgsql::execsql $dbfd $sql msg]} then {
	       d dbabort [mc "modify %s" "$name.$domain"] $msg
	    }
	} else {
	    #
	    # Case "name changes and there is an existing RR for new name"
	    # Remove old MAC since there is a unicity constraint on it.
	    #

	    set sql "UPDATE dns.rr SET mac = NULL WHERE idrr = $idrr ;
		     UPDATE dns.rr SET
				    mac = $qmac,
				    iddhcpprof = $qiddhcpprof,
				    idhinfo = $idhinfo,
				    sendsmtp = $sendsmtp,
				    ttl = $ttl,
				    comment = '$qcomment',
				    respname = '$qrespname',
				    respmail = '$qrespmail'
				WHERE idrr = $nidrr
				"
	    if {! [::pgsql::execsql $dbfd $sql msg]} then {
	       d dbabort [mc "modify %s" "$name.$domain"] $msg
	    }

	    #
	    # Update all references to the host in this view
	    #

	    set msg [update-host-refs $dbfd $idrr $nidrr]
	    if {$msg ne ""} then {
		d dbabort [mc "modify %s" [mc "RR"]] $msg
	    }

	    #
	    # Update old RR "last mod" values, and attempt to delete
	    # it (updating is done in case deletion does not succeed)
	    #

	    set msg [touch-rr $dbfd $idrr]
	    if {$msg ne ""} then {
		d dbabort [mc "modify %s" [mc "RR"]] $msg
	    }
	    set msg [del-orphaned-rr $dbfd $idrr]
	    if {$msg ne ""} then {
		d dbabort [mc "modify %s" [mc "RR"]] $msg
	    }

	    set idrr $nidrr
	}
    }

    #
    # Update RR "last mod" values
    # idrr points to the new RR (or the original RR if there is no new RR)
    #

    set msg [touch-rr $dbfd $idrr]
    if {$msg ne ""} then {
	d dbabort [mc "modify %s" [mc "RR"]] $msg
    }

    d dbcommit [mc "modify %s" "$name.$domain"]

    #
    # Update log
    #

    set m "modify $trr(name).$trr(domain):"
    foreach c {name domain mac dhcpprofile hinfo sendsmtp ttl comment respname respmail} {
	append m " $c=[set $c]"
    }
    d writelog "modrr" $m

    #
    # Display result
    #

    set comment  [html-tab-string $comment]
    set respname [html-tab-string $respname]
    set respmail [html-tab-string $respmail]

    if {$ttl == -1} then {
	set httl [mc "(default zone value)"]
    } else {
	set httl $ttl
    }

    if {$sendsmtp} then {
	set sendsmtp [mc "Yes"]
    } else {
	set sendsmtp [mc "No"]
    }

    #
    # Prepare next step in journey
    #

    switch -- [d nextprog] {
	search {
	    d urlset "%URLSUITE%" $conf(nextsearch) [list [d nextargs]]
	}
	map {
	    d urlset "%URLSUITE%" $conf(nextmap) [list {domap {yes}} [d nextargs]]
	}
	list {
	    d urlset "%URLSUITE%" $conf(nextlist) [list {dolist {yes}} [d nextargs]]
	}
	default {
	    d urlset "%URLSUITE%" $conf(next) {}
	}
    }

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

    d result $conf(page-ok) [list \
					[list %NAME% $name] \
					[list %DOMAIN% $domain] \
					[list %MAC% $mac] \
					[list %DHCPPROFILE% $dhcpprofile] \
					[list %HINFO% $hinfo] \
					[list %SENDSMTP% $sendsmtp] \
					[list %TTL% $httl] \
					[list %COMMENT% $comment] \
					[list %RESPNAME% $respname] \
					[list %RESPMAIL% $respmail] \
			    ]
    return 0
}

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

d cgi-dispatch "dns" ""
