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

#
# Store host modifications
#
# Parameters (form or url):
#   - display edit page
#	- action : (none)
#	- addr : pre-filled IP address if any
#	- naddr : number of IP addresses to add, if any
#   - add host
#	- action : "add-host"
#	- confirm : "no" or "yes" (if confirmation)
#	- name : name of host to add
#	- domain: domain of host to add
#	- idview: view id in which the host must be added
#	- addr: IP address
#	- mac : MAC address
#	- iddhcpprof : DHCP profil id, or 0
#	- hinfo : host type (text)
#	- sendsmtp : non-existent or non-empty
#	- ttl : value (or empty if not authorized)
#	- comment : comments
#	- respname : name of the person responsible for this host
#	- respmail : mail address of the person responsible for this host
#	- naddr : number of IP addresses to add, if any
#   - free address block search
#	- action : "add-multi"
#	- dosearch or domap : non-empty value (see add.html)
#	- tri : sort criterion ("naddr" or "addr")
#	- plage : selected network id
#	- naddr : desired block size
#   - add alias
#	- action : "add-alias"
#	- name : name of alias to add
#	- domain : domain of alias to add
#	- idview: view id in which the alias must be added
#	- nameref : name of canonical existing host
#	- domainref : domain of canonical existing host
#
# History
#   2002/04/11 : pda/jean : design
#   2002/04/19 : pda/jean : add confirmation
#   2002/05/03 : pda/jean : split 3 modification types
#   2002/05/23 : pda/jean : add responsible
#   2002/07/09 : pda      : add nologin
#   2002/07/09 : pda      : convert names into lowercase
#   2002/10/31 : pda/jean : bug fix if add an IP address to an existing alias
#   2002/11/06 : pda/jean : bug fix of the bug fix
#   2003/04/24 : pda/jean : cannot add an IP address to a MX
#   2003/05/13 : pda/jean : use auth base
#   2004/01/14 : pda/jean : add IPv6
#   2004/08/04 : pda/jean : add mac
#   2005/04/08 : pda/jean : add dhcpprofile
#   2007/10/25 : jean     : log modify actions
#   2008/02/13 : pda/jean : responsible person is the current user by default
#   2008/07/23 : pda/jean : add smtp emit right
#   2008/07/29 : pda      : use display-rr
#   2010/01/01 : pda      : add add-multi
#   2010/10/08 : pda      : add journey (via next)
#   2010/10/09 : pda      : end add-multi coding
#   2010/10/26 : pda      : check dhcpprofile case when no mac address
#   2010/12/14 : pda      : i18n
#   2010/12/25 : pda      : use cgi-dispatch
#   2012/09/20 : pda/jean : remove dns update interval
#   2012/10/30 : pda/jean : add views
#   2012/11/07 : pda/jean : add dumb idview for address map
#   2013/03/12 : pda      : add naddr parameter
#   2013/04/10 : pda/jean : accept only one view
#

#
# Template pages used by this script
#

set conf(page-add)	add.html
set conf(page-alias)	add-alias.html
set conf(page-exist)	add-exist.html
set conf(page-host)	add-host.html
set conf(page-smtp)	add-smtp.html
set conf(page-multi)	add-multi.html

#
# Next actions
# 

set conf(nextadd)	"add"
set conf(nextmap)	"net"

set conf(script-map)	"./net"

#
# Script parameters
#

# maximum size (in IP address count) of block to search
set conf(maxip)		65536

set conf(tableau-multi) {
    global {
	chars {10 normal}
	align {left}
	botbar {yes}
	columns {40 20 40}
    }
    pattern Title {
	vbar {yes}
	column {
	    format {raw}
	}
	vbar {yes}
	column {
	    format {raw}
	    align {center}
	}
	vbar {yes}
	column { }
	vbar {yes}
    }
    pattern Normal {
	vbar {yes}
	column { }
	vbar {yes}
	column {
	    align {center}
	}
	vbar {yes}
	column {
	    format {raw}
	}
	vbar {yes}
    }
}

#
# Netmagis general library
#

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

# ::webapp::cgidebug ; exit

##############################################################################
# Display page
##############################################################################

d cgi-register {action {}} {
    {addr 0 1}
    {naddr 0 1}
} {
    global conf

    #
    # Get authorized views
    #

    lassign [menu-view $dbfd $tabuid(idcor) "idview" {}] disp viewval
    if {$disp} then {
	set viewlibelle [mc "View"]
    } else {
	set viewlibelle ""
    }
    # get one valid view to satisfy "map" requirements
    set dumbidview [lindex [u myviewids] 0]

    #
    # Get host types
    #

    set menuhinfo [menu-hinfo $dbfd hinfo ""]

    #
    # Get SMTP authorization, in order to display (or not display)
    # authorization button
    #

    lassign [menu-sendsmtp $dbfd "sendsmtp" tabuid 0] \
	    sendsmtplibelle sendsmtpmenu

    #
    # Get TTL permission in order to display (or not display) TTL field
    #

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

    #
    # Get authorized domains
    #

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

    #
    # Get DHCP profile informations
    #

    lassign [menu-dhcp-profile $dbfd "iddhcpprof" $tabuid(idcor) 0] \
				dhcpproflibelle dhcpprofmenu 

    #
    # Get network addresses
    #

    set lnet [read-networks $dbfd $tabuid(idgrp) "consult"]
    set taille [llength $lnet]
    if {$taille == 0} then {
	set menuplage [mc "No authorized network"]
    } else {
	set menuplage [::webapp::form-menu "plage" 1 0 $lnet {}]
    }

    #
    # Is an address already provided?
    #

    if {$addr eq ""} then {
	# no: show rest of page
	set display "block"
    } else {
	# yes: hide rest of page
	set display "none"
    }

    #
    # Is an address count provided?
    #

    if {! [regexp {^[0-9]+$} $naddr]} then {
	set naddr 1
    }

    #
    # Next scripts
    #

    d urlset "%URLFORM1%" $conf(nextadd) {}
    d urladdnext "%URLFORM1%"
    d urlset "%URLFORM2%" $conf(nextadd) {}

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

    d result $conf(page-add) [list \
				[list %VIEWLIBELLE% $viewlibelle] \
				[list %VIEWVAL% $viewval] \
				[list %DOMAIN% $domain] \
				[list %DOMAINREF% $domainref] \
				[list %MENUHINFO% $menuhinfo] \
				[list %TTLLIBELLE% $ttllibelle] \
				[list %TTLVAL% $ttlval] \
				[list %SENDSMTPLIBELLE% $sendsmtplibelle] \
				[list %SENDSMTPMENU% $sendsmtpmenu] \
				[list %DHCPPROFLIBELLE% $dhcpproflibelle] \
				[list %DHCPPROFMENU% $dhcpprofmenu] \
				[list %MENUPLAGE% $menuplage] \
				[list %DISPLAY% $display] \
				[list %DUMBIDVIEW% $dumbidview] \
				[list %ADDR% $addr] \
				[list %NADDR% $naddr] \
			    ]
}

##############################################################################
# Add a name
##############################################################################

# History
#   2002/04/11 : pda/jean : design
#   2002/04/19 : pda/jean : add confirmation
#   2002/05/02 : pda/jean : change hinfo format
#   2002/05/03 : pda/jean : store user in RR
#   2003/04/24 : pda/jean : cannot add an IP address to a MX
#   2004/08/04 : pda/jean : add mac
#   2005/04/08 : pda/jean : add iddhcpprof
#   2010/10/31 : pda      : add ttl
#   2010/12/16 : pda      : add fspec parameter
#

d cgi-register {action add-host} {
    {confirm	1 1}
    {name	1 1}
    {domain	1 1}
    {idview	1 1}
    {addr	1 1}
    {mac	1 1}
    {iddhcpprof 1 1}
    {sendsmtp	0 1}
    {ttl	1 1}
    {hinfo	1 1}
    {comment	1 1}
    {respname	1 1}
    {respmail	1 1}
    {naddr	1 1}
} {
    global conf

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

    #
    # Check 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 trr "host"]
    if {$msg ne ""} then {
	d error $msg
    }
    set iddom $trr(iddom)

    #
    # Is this name an existing RR?
    # Does it already have at least one IP address?
    #

    set exip 0
    set rrexist 0
    if {$trr(idrr) ne ""} then {
	set rrexist 1
	if {$trr(ip) ne ""} then {
	    set exip 1
	}
    } else {
	if {$respname eq "" && $respmail eq ""} then {
	    set respname "$tabuid(lastname) $tabuid(firstname)"
	    set respmail $tabuid(mail)
	}
    }

    #
    # Check IP address
    #

    set msg [check-ip-syntax $dbfd $addr "inet"]
    if {$msg ne ""} then {
	d error $msg
    }

    if {! [check-authorized-ip $dbfd $idcor $addr]} then {
	d error [mc "You don't have rights on '%s'" $addr]
    }

    if {[read-rr-by-ip $dbfd $addr $idview tabrrbidon]} then {
	d error [mc "IP address '%s' already exists" $addr]
    }

    #
    # Check MAC address
    #

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

    set mactotest $mac
    if {$exip} then {
	set mactotest $trr(mac)
    }
    set msg [check-static-dhcp $dbfd $mactotest [list $addr]]
    if {$msg ne ""} then {
	d error $msg
    }

    #
    # Check DHCP profile
    #

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

    #
    # Check host type
    #

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

    #
    # Check SMTP emit right
    #

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

    #
    # Check TTL
    #

    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
    }

    #
    # At this point:
    # - if name does not exist, and user asked for SMTP emit right
    #		=> ask for confirmation
    # - if there is already an IP address
    #		=> ask for confirmation
    # - in all other cases
    #		=> do task
    #

    #
    # Common code for confirmation
    #

    set l {name domain addr idview mac iddhcpprof sendsmtp ttl hinfo
			    comment respname respmail naddr}
    set hidden [::webapp::hide-parameters $l ftab]

    #
    # Ask for confirmation if user asked for SMTP emit right
    #

    if {! $exip && $sendsmtp && $confirm ne "yes"} then {
	#
	# Confirmation page
	#

	d urlset "%URLFORM%" $conf(nextadd) {}
	d urladdnext "%URLFORM%"
	d result $conf(page-smtp) [list \
					    [list %HIDDEN% $hidden] \
				]
	return 0
    }

    #
    # If name already exists, ask for confirmation, else insert object
    #

    if {$exip && $confirm ne "yes"} then {
	#
	# Output a page with attribute list of the identified object
	#

	set host [display-rr $dbfd -1 trr $idview {}]
	d urlset "%URLFORM%" $conf(nextadd) {}
	d urladdnext "%URLFORM%"
	d result $conf(page-exist) [list \
						[list %NAME%    $name] \
						[list %DOMAIN%  $domain] \
						[list %ADDR%    $addr] \
						[list %HIDDEN%  $hidden] \
						[list %MACHINE% $host] \
			    ]
	return 0
    }

    #
    # Insert object
    #

    set msg [add-host $dbfd trr $name $iddom $idview $addr \
    			$mac $iddhcpprof $idhinfo $sendsmtp $ttl \
			$comment $respname $respmail $idcor]
    if {$msg ne ""} then {
	d error $msg
    }

    #
    # Is there any address still to add?
    #

    if {[regexp {^[0-9]+$} $naddr]} then {
	incr naddr -1
    } else {
	set naddr 0
    }

    if {$naddr > 0} then {
	set sql "SELECT INET('$addr')+1 AS addr"
	pg_select $dbfd $sql tab {
	    set nextaddr $tab(addr)
	}
	d urlset "%URLSUITE%" $conf(nextadd) [list \
						    [list "addr" $nextaddr] \
						    [list "naddr" $naddr] \
						]
	d urladdnext "%URLSUITE%"
    } else {
	#
	# Prepare next step in journey
	#
	 
	switch -- [d nextprog] {
	    map {
		d urlset "%URLSUITE%" $conf(nextmap) [list {domap yes} [d nextargs]]
	    }
	    default {
		d urlset "%URLSUITE%" $conf(nextadd) {}
	    }
	}
    }

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

    set machine [display-rr $dbfd $trr(idrr) trr $idview {}]
    d result $conf(page-host) [list \
					    [list %MACHINE% $machine] \
			    ]
}

##############################################################################
# Search for a block
##############################################################################

# History
#   2010/01/01 : pda      : design
#   2010/10/09 : pda      : end of design
#   2010/12/16 : pda      : add fspec parameter
#

d cgi-register {action add-multi} {
    {dosearch	0 1}
    {domap	0 1}
    {tri	0 1}
    {plage	1 1}
    {naddr	1 1}
    {idview	1 1}
} {
    global conf

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

    #
    # Validate form input
    #

    set lcidr [check-netid $dbfd $plage $idgrp "consult" {4} msg]
    if {[llength $lcidr] != 1} then {
       d error $msg
    }
    set cidr [lindex $lcidr 0]

    #
    # Special case for address map: we redirect to another CGI script
    #

    if {$domap ne ""} then {
	set nftab(cidr) $lcidr
	set nftab(idview) $idview
	set nftab(domap) {yes}
	puts stdout [::webapp::call-cgi $conf(script-map) nftab]
	return 0
    }

    #
    # Continue to validate form input
    #

    if {! [regexp {^[0-9]+$} $naddr] || $naddr < 1} then {
       d error [mc "Invalid address count '%s'" $naddr]
    }

    switch -- $tri {
	naddr { set order "ORDER BY n ASC, a ASC" }
	addr -
	default { set order "ORDER BY a ASC, n ASC" }
    }

    #
    # Look for free blocks
    #

    set sql "SELECT *
		FROM dns.ipranges ('$cidr', $conf(maxip), $idgrp)
		WHERE n >= $naddr
		$order"
    set lranges {}
    pg_select $dbfd $sql tab {
	lappend lranges [list $tab(a) $tab(n)]
    }

    if {[llength $lranges] == 0} then {
       d error [mc "No block of %s free IPv4 address(es) found" $naddr]
    }

    #
    # Display information
    #

    set lines {}

    # base URL to perform sort
    set largs [list {action add-multi} \
		    [list "plage" $plage] \
		    [list "naddr" $naddr] \
		]

    # first line (with sort URLs)
    d urlset "" $conf(nextadd) [concat $largs {{tri addr}}]
    set url [d urlget ""]
    set c1 [::webapp::helem "a" [mc "First available IP address"] "href" $url]

    d urlset "" $conf(nextadd) [concat $largs {{tri naddr}}]
    set url [d urlget ""]
    set c2 [::webapp::helem "a" [mc "Size of block"] "href" $url]

    lappend lines [list Title $c1 $c2 ""]

    # block traversal
    foreach l $lranges {
	lassign $l a n

	set hidden [::webapp::form-hidden "addr" $a]
	append hidden [::webapp::form-hidden "naddr" $naddr]

	# explicit choice button
	switch [expr $naddr==$n][expr $naddr==1] {
	    11 { set fmt [mc "Choose this address"] }
	    10 { set fmt [mc "Choose these %s addresses"] }
	    01 { set fmt [mc "Choose the first address"] }
	    00 { set fmt [mc "Choose the %s first addresses"] }
	}
	set msg [format $fmt $naddr]
	set button [::webapp::form-submit "" $msg]

	d urlset "" $conf(nextadd) {}
	d urlsetnext "" "sequence" ""
	set c [::webapp::helem "form" "$hidden$button" \
					    "method" "post" \
					    "action" [d urlget ""] \
			]
	lappend lines [list Normal $a $n $c]
    }

    set list [::arrgen::output "html" $conf(tableau-multi) $lines]

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

    d result $conf(page-multi) [list \
					    [list %LIST% $list] \
			    ]
    return 0
}

##############################################################################
# Add an alias
##############################################################################

# History
#   2002/04/19 : pda/jean : design
#   2010/12/16 : pda      : add fspec parameter
#

d cgi-register {action add-alias} {
    {name	1 1}
    {domain	1 1}
    {nameref	1 1}
    {domainref	1 1}
    {idview	1 1}
} {
    global conf

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

    #
    # Check names of alias and host
    #

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

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

    #
    # Add alias
    #

    set msg [add-alias $dbfd $name $domain $idview $nameref $domainref $idcor]
    if {$msg ne ""} then {
	d error $msg
    }

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

    d result $conf(page-alias) [list \
				    [list %FQDN%    "$name.$domain"] \
				    [list %FQDNREF% "$nameref.$domainref"] \
			    ]
    return 0
}

##############################################################################
# Central dispatching
##############################################################################

d cgi-dispatch "dns" ""
