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

#
# Import existing DNS data into Netmagis database
#
# Syntax:
#   netmagis-dbimport <op> <param> ... <param>
#
# See "conf(usage)" variable for exact syntax.
#
# History
#   2002/02/10 : pda      : design
#   2011/02/14 : pda      : update to netmagis database
#   2011/03/13 : pda      : end import programming
#   2011/06/20 : pda      : add dhcp keyword in networks import
#

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

package require ip

#
# Pattern to distinguish zone prologue (including non standard RRs) 
# from standard RRs
#

set conf(pattern)	{^; CUT HERE}

#
# Serial pattern
# The searched string should contain three parts, separated by parenthesis
# - string before serial number
# - serial number
# - string after serial number
# The searched pattern catch lines such as:
#	"      2011021801        ; Serial"
# The serial will be replaced by %ZONEVERSION%
# in the zone prologue in the database.
#

set conf(serial)	{^(\s+)(\d+)(\s*;\s*serial.*)}

#
# Authorized RR types and classes
#

set conf(types)		{A AAAA NS CNAME SOA PTR HINFO MINFO MX TXT}
set conf(classes)	{IN}

#
# Authorized values
#

set conf(syntax-group)	{^\w[-\w]+$}
set conf(syntax-user)	{^\w[-\w]+$}

#
# Self explanatory
#

set conf(usage) {usage: %1$s [-v] <op> <param> ... <param>
    To import groups (create groups and users):
	%1$s group <file>
    To import networks (create networks, organizations, communities)
	%1$s network <file>
    To import views (create views and associate permissions):
	%1$s view <file>
    To import domains (create domains and associate permissions):
	%1$s domain <file>
    To import zone data (import zone prologue, and zone RR into domain)
	%1$s zone <view> <zonename> <zonefile> <selector> <rrsupfile> <login>
	    view = view name (use "default" if you don't use views)
	    zonename = name of zone and name of file generated by mkzones
	    selector = domainname or cidr (172.16/16, 2001:db8:1234::/48)
	    rrsup = file containing some RRs which are added to every A/AAAA RR
	    login = login of an existing user
    To import mail relays (create mail relays for domains):
	%1$s mailrelay <view> <file>
    To import mail roles (create mail role):
	%1$s mailrole <file> <login>
}

##############################################################################
# Small utility functions
##############################################################################

set here(prog)	""
set here(file)	""
set here(line)	""

proc warning {msg} {
    global here

    set prefix ""
    if {$here(prog) ne ""} then {
	append prefix $here(prog)
	if {$here(file) ne ""} then {
	    append prefix "/$here(file)"
	    if {$here(line) ne ""} then {
		append prefix "($here(line))"
	    }
	}
	append prefix ": "
    }
    puts stderr "$prefix$msg"
}

proc fatal-error {msg} {
    warning $msg
    exit 1
}

proc usage {} {
    global conf here

    fatal-error [format $conf(usage) $here(prog)]
}

proc setprog {argv0} {
    global here

    regsub {.*/} $argv0 {} argv0
    set here(prog) $argv0
    set here(file) ""
    set here(line) ""
}
proc openfile {filename} {
    global here

    if {[catch {set fd [open $filename "r"]} msg]} then {
	fatal-error "Cannot open '$filename' ($msg)"
    }
    set here(file) $filename
    set here(line) 0
    return $fd
}
proc closefile {fd} {
    global here

    set here(file) ""
    set here(line) ""
    return [close $fd]
}
proc readline {fd _line {comment {}}} {
    global here
    upvar $_line line

    incr here(line)
    set r [gets $fd line]
    if {$r != -1 && $comment ne ""} then {
	regsub -all "${comment}.*" $line "" line
	set line [string trim $line]
	regsub {\s+} $line " " line
    }
    return $r
}

##############################################################################
# Various file reading
##############################################################################

#
# Read a key=value file
# and store result in an array indexed by:
#	tab(nrec)	<record count>
#	tab(<n>:<key>) <value>
#		where <n> is the record index (starting from 1)
#

proc read-key-value-file {file _tab lkeys} {
    upvar $_tab tab

    set err 0
    set fd [openfile $file]
    set nrec 0
    while {[readline $fd line "#"] > -1} {
	#
	# Empty line : new record
	#
	if {$line eq ""} then {
	    if {! [check-record nrec t tab $lkeys]} then {
		set err 1
	    }
	    catch {unset t}
	} else {
	    if {! [regexp {([^=]*)=(.*)} $line bidon kw val]} then {
		warning "Invalid syntax '$line'"
		set err 1
	    }

	    set found 0
	    foreach c $lkeys {
		lassign $c k min max
		if {$kw eq $k} then {
		    lappend t($kw) $val
		    set found 1
		    break
		}
	    }
	    if {! $found} then {
		warning "Invalid keyword '$kw' in '$line'"
		set err 1
	    }
	}
    }

    #
    # Special case: last record
    #
    if {! [check-record nrec t tab $lkeys]} then {
	set err 1
    }

    closefile $fd
    set tab(nrec) $nrec

    if {$err} then {
	fatal-error "Error(s) detected in '$file'. Abort."
    }
}

proc check-record {_nrec _t _tab lkeys} {
    upvar $_nrec nrec
    upvar $_t t
    upvar $_tab tab

    set r 1
    if {[llength [array names t]] > 0} then {
	incr nrec
	foreach c $lkeys {
	    lassign $c k min max
	    if {! [info exists t($k)]} then {
		set t($k) {}
	    }
	    set n [llength $t($k)]
	    if {$n < $min} then {
		set r 0
		warning "Keyword '$k' : specified less than $min times"
	    }
	    if {$n > $max} then {
		set r 0
		warning "Keyword '$k' : specified more than $max times"
	    }
	    set tab($nrec:$k) $t($k)
	}
    }
    return $r
}

##############################################################################
# Various database read
##############################################################################

proc read-idcor {dbfd login} {
    set qlogin [::pgsql::quote $login]
    set sql "SELECT idcor FROM global.nmuser WHERE login = '$qlogin'"
    set idcor -1
    pg_select $dbfd $sql tab {
	set idcor $tab(idcor)
    }
    return $idcor
}

#
# Read all views from database
#
# Input:
#   - parameters:
#	- dbfd: database handle
#	- _tabview: array to fill with view names
#	- _tabid: array to fill with view ids
# Output:
#   - parameter _tabview: tabview(<viewname>) <id>
#   - parameter _tabid: tabview(<id>) <viewname>
#
# History
#   2012/10/08 : pda/jean : views
#

proc read-all-views {dbfd _tabview _tabid} {
    upvar $_tabview tabview
    upvar $_tabid   tabid

    set sql "SELECT name, idview FROM dns.view"
    pg_select $dbfd $sql tab {
	set tabview($tab(name)) $tab(idview)
	set tabid($tab(idview)) $tab(name)
    }
}

##############################################################################
# Import group contents
##############################################################################

#
# Group definition file
# Format:
#	group login ... login
# Examples:
#	tech jim joe
#	sales arthur
#

proc read-group {file _tab} {
    global conf
    upvar $_tab tab

    set fd [openfile $file]
    while {[readline $fd line "#"] > -1} {
	if {$line ne ""} then {
	    set group [lindex $line 0]
	    if {! [regexp $conf(syntax-group) $group]} then {
		warning "Invalid group syntax for '$group'"
		continue
	    }
	    set tab($group) {}
	    foreach c [lreplace $line 0 0] {
		if {! [regexp $conf(syntax-user) $c]} then {
		    warning "Invalid user syntax for '$c'"
		    continue
		}
		if {[info exists tc($c)]} then {
		    warning "User '$c' already specified in group $tc($c)"
		} else {
		    set tc($c) $group
		    lappend tab($group) $c
		}
	    }
	}
    }
    closefile $fd
}

proc import-group {verbose argv dbfd} {
    #
    # Syntax checking
    #

    if {[llength $argv] != 1} then {
	usage
    }

    lassign $argv file

    if {$verbose} {
	puts stderr "Importing groups from $file"
    }

    #
    # Read file and database reference
    #

    read-group $file tabgrp

    #
    # Read group, user, realm and account definition from database
    #
    
    pg_select $dbfd "SELECT * FROM global.nmgroup" tab {
	set refg($tab(name)) $tab(idgrp)
    }
    pg_select $dbfd "SELECT * FROM global.nmuser" tab {
	set refu($tab(login)) [list $tab(idcor) $tab(idgrp)]
    }
    pg_select $dbfd "SELECT * FROM pgauth.user" tab {
	set refa($tab(login)) {}
    }
    pg_select $dbfd "SELECT * FROM pgauth.member" tab {
	lappend refa($tab(login)) $tab(realm)
    }

    #
    # Add groups not in database
    #

    set sql {}
    foreach g [array names tabgrp] {
	if {! [info exists refg($g)]} then {
	    set g [::pgsql::quote $g]
	    lappend sql "INSERT INTO global.nmgroup (name) VALUES ('$g')"
	}
    }
    if {[llength $sql] > 0} then {
	set sql [join $sql ";"]
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    return "$msg\nAbort"
	}

	# re-read idgrp
	pg_select $dbfd "SELECT * FROM global.nmgroup" tab {
	    set refg($tab(name)) $tab(idgrp)
	}
    }

    #
    # Create missing users or reset group membership for existing users
    #

    set sql {}
    foreach g [array names tabgrp] {
	set idgrp $refg($g)
	foreach c $tabgrp($g) {
	    if {[info exists refu($c)]} then {
		lassign $refu($c) idcor idg
		if {$idg != $idgrp} then {
		    lappend sql "UPDATE global.nmuser
					SET idgrp = $idgrp
					WHERE idcor = $idcor"
		}
	    } else {
		set c [::pgsql::quote $c]
		lappend sql "INSERT INTO global.nmuser (login, present, idgrp)
					VALUES ('$c', 1, $idgrp)"
	    }
	}
    }
    if {[llength $sql] > 0} then {
	set sql [join $sql ";"]
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    return "$msg\nAbort"
	}
    }

    #
    # For internal (postgresql) auth, create users
    # and add them into netmagis realm
    # Existing pgauth users are supposed to be already in
    # the netmagis realm.
    #

    set am [dnsconfig get "authmethod"]
    if {$am eq "pgsql"} then {
	set rlm [dnsconfig get "authpggroupes"]
	set qrlm [::pgsql::quote $rlm]
	set sql {}
	foreach g [array names tabgrp] {
	    foreach c $tabgrp($g) {
		if {! [info exists refa($c)]} then {
		    set p [pgauth-genpw]
		    puts stderr "Password for user '$c' is '$p'."
		    set pc [pgauth-crypt $p]
		    set qc [::pgsql::quote $c]
		    set qpc [::pgsql::quote $pc]
		    lappend sql "INSERT INTO pgauth.user
					(login, password, lastname, firstname)
					VALUES ('$qc', '$qpc', 'User', 'Joe')"
		    set refa($c) {}
		}
		if {[lsearch -exact $refa($c) $rlm] == -1} then {
		    lappend sql "INSERT INTO pgauth.member (login, realm)
					VALUES ('$qc', '$qrlm')"
		    lappend refa($c) $rlm
		}
	    }
	}
	if {[llength $sql] > 0} then {
	    set sql [join $sql ";"]
	    if {! [::pgsql::execsql $dbfd $sql msg]} then {
		return "$msg\nAbort"
	    }
	}
    }

    return ""
}

##############################################################################
# Import networks
##############################################################################

#
# Network definition file
# Format:
#	key=val, where key is one of name, address, netmask, comment, org,
#		community, location, groups, dhcp
#	new networks are introduced by an empty line
# Examples:
#	name=Backbone
#	address=172.16.1.0	or address=172.16.1.0/24
#	netmask=255.255.255.0	or empty
#	gateway=172.16.1.254	or empty
#	comment=Backbone and servers
#	org=Example Corp
#	community=sales
#	location=Campus 1
#	groups=wheel tech
#	dhcp=example.com  172.16.11.100-172.16.11.119  172.16.11.140-172.16.11.149
#
# Note: to enable DHCP on a network, use "dhcp=" with a domain and any number
# of IPv4 address ranges. To just enable DHCP without any dynamic range, use
# a domain name.
#

proc read-network {file _tab} {
    upvar $_tab tab

    set keys {
	{name 1 1}
	{address 1 2}
	{netmask 0 2}
	{gateway 0 2}
	{comment 0 1}
	{org 1 1}
	{community 1 1}
	{location 0 1}
	{groups 1 1}
	{dhcp 0 1}
    }
    read-key-value-file $file tab $keys
}

proc ip-is-in-network {addr netaddr} {
    set mask [::ip::mask $netaddr]
    return [::ip::equal $netaddr "$addr/$mask"]
}

proc import-network {verbose argv dbfd} {

    #
    # Syntax checking
    #

    if {[llength $argv] != 1} then {
	usage
    }

    lassign $argv file

    if {$verbose} {
	puts stderr "Importing networks from $file"
    }

    #
    # Read file and database reference
    #

    read-network $file tabnet

    #
    # Read referential data from database
    #
    
    pg_select $dbfd "SELECT * FROM global.nmgroup" tab {
	set refgroup($tab(name)) [list $tab(idgrp) $tab(p_admin)]
    }
    pg_select $dbfd "SELECT * FROM dns.community" tab {
	set refcomm($tab(name)) $tab(idcomm)
    }
    pg_select $dbfd "SELECT * FROM dns.organization" tab {
	set reforg($tab(name)) $tab(idorg)
    }
    pg_select $dbfd "SELECT * FROM dns.domain" tab {
	set refdom($tab(name)) $tab(iddom)
    }

    #
    # Check that all groups exist
    #

    set r 0
    for {set i 1} {$i <= $tabnet(nrec)} {incr i} {
	foreach g [lindex $tabnet($i:groups) 0] {
	    if {! [info exists refgroup($g)]} then {
		set r 1
		warning "Unknown group '$g'"
	    }
	}
    }
    if {$r} then {
	return "Missing groups. Abort."
    }

    #
    # Add referential data (organisations, communities) not in database
    #

    set sql {}
    for {set i 1} {$i <= $tabnet(nrec)} {incr i} {
	set o [lindex $tabnet($i:org) 0]
	if {! [info exists reforg($o)]} then {
	    set qo [::pgsql::quote $o]
	    lappend sql "INSERT INTO dns.organization (name) VALUES ('$qo')"
	    set reforg($o) ""
	}
	set c [lindex $tabnet($i:community) 0]
	if {! [info exists refcomm($c)]} then {
	    set qc [::pgsql::quote $c]
	    lappend sql "INSERT INTO dns.community (name) VALUES ('$qc')"
	    set refcomm($c) ""
	}
    }
    if {[llength $sql] > 0} then {
	set sql [join $sql ";"]
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    return "$msg\nAbort"
	}

	# re-read referential data
	pg_select $dbfd "SELECT * FROM dns.community" tab {
	    set refcomm($tab(name)) $tab(idcomm)
	}
	pg_select $dbfd "SELECT * FROM dns.organization" tab {
	    set reforg($tab(name)) $tab(idorg)
	}
    }

    #
    # Add subnets
    #

    for {set i 1} {$i <= $tabnet(nrec)} {incr i} {
	set name [lindex $tabnet($i:name) 0]

	#
	# Normalize IPv4 and IPv6 addresses
	#

	set ad(4) ""
	set ad(6) ""
	set gw(4) ""
	set gw(6) ""
	set idxmask 0

	foreach a $tabnet($i:address) {
	    set version [::ip::version $a]
	    set mask [::ip::mask $a]
	    if {$mask eq ""} then {
		if {$version == 6} then {
		    return "IPv6 address '$a' without prefix length"
		}
		set netmask [lindex $tabnet($i:netmask) $idxmask]
		incr idxmask
		if {$netmask eq ""} then {
		    return "IP address '$a' without subnet mask"
		}
		set mask [::ip::maskToLength $netmask]
		append a "/$mask"
	    }

	    if {$ad($version) ne ""} then {
		return "IPv$version address supplied twice"
	    }
	    set ad($version) [::ip::normalize $a]
	}
	if {$idxmask < [llength $tabnet($i:netmask)]} then {
	    return "Unused netmask= line"
	}
	if {$ad(4) eq "" && $ad(6) eq ""} then {
	    return "Network '$name' without any IPv4 or IPv6 address"
	}

	#
	# Check gateway addresses if supplied
	#

	foreach g $tabnet($i:gateway) {
	    set version [::ip::version $g]
	    if {$ad($version) eq ""} then {
		return "IPv$version gateway supplied without IPv$version network"
	    }
	    if {! [ip-is-in-network $g $ad($version)]} then {
		return "Invalid gateway $g for network $ad($version)"
	    }
	    set gw($version) [::ip::normalize $g]
	}

	#
	# DHCP ranges
	# - check domain name
	# - check IP addresses
	#

	set d [lindex $tabnet($i:dhcp) 0]
	if {[regexp {^\s*(\S+)\s*([-0-9\. ]*)$} $d m domain lrange]} then {
	    set dhcpon 1

	    if {! [info exists refdom($domain)]} then {
		return "Unknown domain '$d' in network '$name'"
	    }
	    set iddom $refdom($domain)

	    foreach range $lrange {
		lassign [split $range "-"] min max
		if {[::ip::version $min] != 4 || [::ip::version $max] != 4} then {
		    return "Invalid IPv4 range '$range' in network '$name'"
		}

		if {$ad(4) eq ""} then {
		    return "Cannot set DHCP range on a not-IPv4 network '$name'"
		}

		if {! [ip-is-in-network $min $ad(4)]} then {
		    return "DHCP '$min' is not in network '$name' ($ad(4))"
		}
		if {! [ip-is-in-network $max $ad(4)]} then {
		    return "DHCP '$max' is not in network '$name' ($ad(4))"
		}

		# add DHCP range (without DHCP profile)
		set sql "INSERT INTO dns.dhcprange (min, max, iddom)
					VALUES ('$min', '$max', $iddom)"
		if {! [::pgsql::execsql $dbfd $sql msg]} then {
		    return "$msg\nAbort"
		}
	    }
	} elseif {[regexp {^\s*$} $d]} then {
	    set dhcpon 0
	} else {
	    return "Invalid dhcp directive '$d' in network '$name'"
	}

	#
	# Get organisation and community ids
	#

	set org   [lindex $tabnet($i:org) 0]
	set idorg $reforg($org)

	set comm [lindex $tabnet($i:community) 0]
	set idcomm $refcomm($comm)

	#
	# Other data
	#

	set qcomm  [::pgsql::quote [lindex $tabnet($i:comment) 0]]
	set qloc   [::pgsql::quote [lindex $tabnet($i:location) 0]]

	set qname  [::pgsql::quote $name]

	foreach v [array names ad] {
	    if {$ad($v) eq ""} then {
		set qad($v) NULL
	    } else {
		set qad($v) "'$ad($v)'"
	    }
	}
	foreach v [array names gw] {
	    if {$gw($v) eq ""} then {
		set qgw($v) NULL
	    } else {
		set qgw($v) "'$gw($v)'"
	    }
	}

	#
	# Network insertion
	#

	set sql "INSERT INTO dns.network (name, location, comment,
					idorg, idcomm,
					addr4, gw4, addr6, gw6,
					dhcp)
			VALUES ('$qname', '$qloc', '$qcomm', $idorg, $idcomm,
					$qad(4), $qgw(4), $qad(6), $qgw(6),
					$dhcpon)"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    return "$msg\nAbort"
	}

	set w {}
	if {$ad(4) ne ""} then {
	    lappend w "addr4 = '$ad(4)'"
	}
	if {$ad(6) ne ""} then {
	    lappend w "addr6 = '$ad(6)'"
	}
	set w [join $w " AND "]

	set idnet -1
	set sql "SELECT idnet FROM dns.network WHERE $w"
	pg_select $dbfd $sql tab {
	    set idnet $tab(idnet)
	}
	if {$idnet == -1} then {
	    return "Network '$name' inserted, but not found in database"
	}

	#
	# Insert group access to this network
	#

	set sql {}
	foreach g [lindex $tabnet($i:groups) 0] {
	    lassign $refgroup($g) idgrp admin
	    lappend sql "INSERT INTO dns.p_network (idgrp, idnet, sort, dhcp)
					VALUES ($idgrp, $idnet, 100, $dhcpon)"
	}
	if {[llength $sql] > 0} then {
	    set sql [join $sql ";"]
	    if {! [::pgsql::execsql $dbfd $sql msg]} then {
		return "$msg\nAbort"
	    }
	}

	#
	# Insert group IP rights
	# Default forbidden addresses are the network address itself,
	# broadcast address and, for non admin groups, gateway address.
	#

	set sql {}
	foreach g [lindex $tabnet($i:groups) 0] {
	    lassign $refgroup($g) idgrp admin
	    if {$ad(4) ne ""} then {
		lappend sql "INSERT INTO dns.p_ip (idgrp, addr, allow_deny)
				VALUES ($idgrp, '$ad(4)', 1)"
		set addr0 [::ip::prefix $ad(4)]
		lappend sql "INSERT INTO dns.p_ip (idgrp, addr, allow_deny)
				VALUES ($idgrp, '$addr0', 0)"
		set addrb [::ip::broadcastAddress $ad(4)]
		lappend sql "INSERT INTO dns.p_ip (idgrp, addr, allow_deny)
				VALUES ($idgrp, '$addrb', 0)"
		if {! $admin && $gw(4) ne ""} then {
		    lappend sql "INSERT INTO dns.p_ip (idgrp, addr, allow_deny)
				    VALUES ($idgrp, '$gw(4)/32', 0)"
		}
	    }
	    if {$ad(6) ne ""} then {
		lappend sql "INSERT INTO dns.p_ip (idgrp, addr, allow_deny)
				VALUES ($idgrp, '$ad(6)', 1)"
		if {! $admin && $gw(6) ne ""} then {
		    lappend sql "INSERT INTO dns.p_ip (idgrp, addr, allow_deny)
				    VALUES ($idgrp, '$gw(6)/128', 0)"
		}
	    }
	}
	if {[llength $sql] > 0} then {
	    set sql [join $sql ";"]
	    if {! [::pgsql::execsql $dbfd $sql msg]} then {
		return "$msg\nAbort"
	    }
	}
    }

    return ""
}

##############################################################################
# Import views permissions
##############################################################################

#
# Read a file with the ALLBUT/SET syntax
#
# Format:
#    <name> ALLBUT|SET <prio> <group> ... <group>
# ALLBUT : name is authorized for all groups except those specified
# SET : name is authorized for all specified groups
#

proc read-set-allbut-file {file _tab chkdom} {
    upvar $_tab tab

    set fd [openfile $file]
    while {[readline $fd line "#"] > -1} {
	if {$line ne ""} then {
	    set groups [lassign $line name op sort]
	    set err 0

	    if {$chkdom} then {
		set msg [check-fqdn-syntax "" $name f1 f2]
		if {$msg ne ""} then {
		    set err 1
		    warning $msg
		}
	    }
	    if {! ($op in {ALLBUT SET})} then {
		set err 1
		warning "unrecognized keyworkd '$op'"
	    }
	    if {! $err} then {
		lappend tab($name) [list $op $sort $groups]
	    }
	}
    }
    closefile $fd
}

#
# Check groups cited in the SET/ALLBUT file
# 

proc check-groups-in-set-allbut {dbfd _tabfile _tabgrp} {
    upvar $_tabfile tabfile
    upvar $_tabgrp tabgrp

    #
    # Read groups from database
    #

    pg_select $dbfd "SELECT * FROM global.nmgroup" tab {
	set tabgrp($tab(name)) $tab(idgrp)
    }

    #
    # Check existence of all specified groups
    # If a group doesn't exist, it is a fatal error
    #

    set allgroups {}
    foreach n [array names tabfile] {
	foreach l $tabfile($n) {
	    lassign $l op sort groups
	    set allgroups [concat $allgroups $groups]
	}
    }
    set allgroups [lsort -unique $allgroups]
    set err 0
    foreach g $allgroups {
	if {! [info exists tabgrp($g)]} then {
	    set err 1
	    warning "Group '$g' not in database"
	}
    }
    if {$err} then {
	return "Abort"
    }

    return ""
}

#
# View permissions file
# Format:
#	viewname op sortorder group group group...
#		where op = ALLBUT or SET
# Examples:
#	external ALLBUT 100 sales marketing
#	internal SET 200 tech engineering
#

proc import-view {verbose argv dbfd} {
    #
    # Syntax checking and read file
    #

    if {[llength $argv] != 1} then {
	usage
    }

    lassign $argv file

    if {$verbose} {
	puts stderr "Importing views from $file"
    }

    read-set-allbut-file $file tabview 0

    set msg [check-groups-in-set-allbut $dbfd tabview tabgrp]
    if {$msg ne ""} then {
	return $msg
    }

    #
    # Remove unused views
    #

    set unused {}
    pg_select $dbfd "SELECT * FROM dns.view" tab {
	set v $tab(name)
	if {! [info exists tabview($v)]} then {
	    lappend unused "'[::pgsql::quote $v]'"
	}
    }
    if {[llength $unused] > 0} then {
	set unused [join $unused ", "]
	set sql "DELETE FROM dns.view WHERE name in ($unused)"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    return "$msg\nAbort"
	}
    }

    #
    # Get views missing in database and update them
    #

    set sql {}
    foreach v [array names tabview] {
	set missing($v) yes
    }
    pg_select $dbfd "SELECT * FROM dns.view" tab {
	set v $tab(name)
	if {[info exists missing($v)]} then {
	    unset missing($v)
	}
    }
    foreach v [array names missing] {
	set v [::pgsql::quote $v]
	lappend sql "INSERT INTO dns.view (name, gendhcp) VALUES ('$v', 0)"
    }
    if {[llength $sql] > 0} then {
	set sql [join $sql ";"]
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    return "$msg\nAbort"
	}
    }

    #
    # Re-read views to get id of new views
    #

    read-all-views $dbfd tabidview tabid

    #
    # Empty view permissions
    #

    set sql "DELETE FROM dns.p_view"
    if {! [::pgsql::execsql $dbfd $sql msg]} then {
	return "$msg\nAbort"
    }

    #
    # Fill view permissions
    #

    set sql {}
    foreach v [array names tabview] {
	foreach l $tabview($v) {
	    lassign $l op sort groups

	    if {! [info exists tabidview($v)]} then {
		return "Unknown view '$v'. Abort"
	    }
	    set idview $tabidview($v)

	    switch -- $op {
		ALLBUT {
		    set w {}
		    foreach g $groups {
			if {! [info exists tabgrp($g)]} then {
			    return "Unknown group '$g'. Abort"
			}
			set idgrp $tabgrp($g)
			lappend w "idgrp <> $idgrp"
		    }
		    if {$w ne ""} then {
			set w [join $w " AND "]
			set w "WHERE $w"
		    }
		    lappend sql "INSERT INTO dns.p_view (idgrp, idview,
		    					sort, selected)
					(SELECT idgrp, $idview, $sort, 0
					    FROM global.nmgroup $w)"
		}
		SET {
		    foreach g $groups {
			if {! [info exists tabgrp($g)]} then {
			    return "Unknown group '$g'. Abort"
			}
			set idgrp $tabgrp($g)
			lappend sql "INSERT INTO dns.p_view (idgrp, idview,
							sort, selected)
					    VALUES ($idgrp, $idview, $sort, 0)"
		    }
		}
	    }
	}
    }

    if {[llength $sql] > 0} then {
	set sql [join $sql ";"]
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    return "$msg\nAbort"
	}
    }

    return ""
}

##############################################################################
# Import domain permissions
##############################################################################

#
# Domain permissions file
# Format: (see view file)
# Examples:
#	example.com ALLBUT 100 sales marketing
#	example.org SET 200 tech engineering
#	example.org SET 50 marketing
#

proc import-domain {verbose argv dbfd} {
    #
    # Syntax checking and read file
    #

    if {[llength $argv] != 1} then {
	usage
    }

    lassign $argv file

    if {$verbose} {
	puts stderr "Importing domains from $file"
    }

    read-set-allbut-file $file tabdom 1

    set msg [check-groups-in-set-allbut $dbfd tabview tabgrp]
    if {$msg ne ""} then {
	return $msg
    }

    #
    # Get domains missing in database and update them
    #

    foreach d [array names tabdom] {
	set missing($d) yes
    }
    pg_select $dbfd "SELECT * FROM dns.domain" tab {
	set d $tab(name)
	if {[info exists missing($d)]} then {
	    unset missing($d)
	}
    }
    set sql {}
    foreach d [array names missing] {
	set d [::pgsql::quote $d]
	lappend sql "INSERT INTO dns.domain (name) VALUES ('$d')"
    }
    if {[llength $sql] > 0} then {
	set sql [join $sql ";"]
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    return "$msg\nAbort"
	}
    }

    #
    # Re-read domains to get id of new domain
    #

    read-all-domains $dbfd tabiddom tabid

    #
    # Empty domain permissions
    #

    set sql "DELETE FROM dns.p_dom"
    if {! [::pgsql::execsql $dbfd $sql msg]} then {
	return "$msg\nAbort"
    }

    #
    # Fill domain permissions
    #

    set sql {}
    foreach d [array names tabdom] {
	foreach l $tabdom($d) {
	    lassign $l op sort groups

	    if {! [info exists tabiddom($d)]} then {
		return "Unknown domain '$d'. Abort"
	    }
	    set iddom $tabiddom($d)

	    switch -- $op {
		ALLBUT {
		    set w {}
		    foreach g $groups {
			if {! [info exists tabgrp($g)]} then {
			    return "Unknown group '$g'. Abort"
			}
			set idgrp $tabgrp($g)
			lappend w "idgrp <> $idgrp"
		    }
		    if {$w ne ""} then {
			set w [join $w " AND "]
			set w "WHERE $w"
		    }
		    lappend sql "INSERT INTO dns.p_dom (idgrp, iddom, sort)
					(SELECT idgrp, $iddom, $sort
					    FROM global.nmgroup $w)"
		}
		SET {
		    foreach g $groups {
			if {! [info exists tabgrp($g)]} then {
			    return "Unknown group '$g'. Abort"
			}
			set idgrp $tabgrp($g)
			lappend sql "INSERT INTO dns.p_dom (idgrp, iddom, sort)
					    VALUES ($idgrp, $iddom, $sort)"
		    }
		}
	    }
	}
    }
    if {[llength $sql] > 0} then {
	set sql [join $sql ";"]
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    return "$msg\nAbort"
	}
    }

    return ""
}

##############################################################################
# Import zone data
##############################################################################

proc read-zone {file selector reverse _prologue _serial _tabaddr _tabcname} {
    global conf
    upvar $_prologue prologue
    upvar $_serial serial
    upvar $_tabaddr tabaddr
    upvar $_tabcname tabcname

    set fd [openfile $file]

    #
    # Look for the prologue
    # 

    set prologue ""
    set serialfound 0
    set endprol 0
    while {! $endprol && [readline $fd line ""] > -1} {
	if {[regexp -- $conf(pattern) $line]} then {
	    set endprol 1
	} else {
	    if {[regexp -nocase $conf(serial) $line x p1 curserial p2]} then {
		set serial $curserial
		set line "$p1%ZONEVERSION%$p2"
		set serialfound 1
	    }
	    append prologue $line
	    append prologue "\n"
	}
    }
    if {! $endprol} then {
	fatal-error "End of prologue pattern '$conf(pattern)' not found"
    }
    if {! $serialfound} then {
	fatal-error "Serial pattern '$conf(serial)' not found"
    }

    #
    # Analyze zone RR
    #

    if {! $reverse} then {
	set oldname ""
	while {[readline $fd line ""] > -1} {
	    lassign [zone-analyze-rr $line $oldname] type name data
	    switch $type {
		NS -
		MX -
		NOTHING {
		    # nothing. Surprising, eh?
		}
		A -
		AAAA {
		    if {[info exists tabcname($name)]} then {
			warning "$name is already a CNAME: $tabcname($name) (CNAME ignored)"
			unset tabcname($name)
		    }
		    set data [::ip::normalize $data]
		    if {! [existing-rr-ip $name $data]} then {
			lappend tabaddr($name) $data
		    }
		}
		CNAME {
		    # Example: a CNAME b.example.com.
		    # or:      a CNAME b
		    if {[info exists tabcname($name)]} then {
			warning "$name already has a CNAME: $tabcname($name) (ignored)"
		    } elseif {[info exists tabaddr($name)]} then {
			warning "$name already has an IP address: $tabaddr($name) (CNAME ignored)"
		    } else {
			# cname(a) => b.example.com. or b
			if {[string range $data end end] ne "."} then {
			    # selector is domain name for forward zones
			    append data ".$selector."
			}
			if {! [existing-rr-cname $name $data]} then {
			    set tabcname($name) $data
			}
		    }
		}
		default {
		    warning "Unrecognized RR type '$type' (ignored)"
		}
	    }
	    set oldname $name
	}
    }

    closefile $fd
}

proc zone-get-token {rrpart} {
    global conf

    if {[regexp "^\[0-9]+$" $rrpart]} then {
	return TTL
    }
    set rrpart [string toupper $rrpart]
    if {$rrpart in $conf(classes)} then {
	return CLASS
    }
    if {$rrpart in $conf(types)} then {
	return TYPE
    }
    return OTHER
}

proc zone-analyze-rr {line oldname} {
    # Remove comments and blank characters at end of line (blanks
    # at the beginning of the line must not be removed since they
    # are significant!).
    regsub -all -- ";.*" $line "" line
    set line [string trimright $line]

    # remove empty lines
    if {$line eq ""} then {
	return [list "NOTHING" $oldname ""]
    }

    # split line
    regsub -all -- {\s+} $line " " line
    set l [split $line " "]

    # Find the RR name. If the RR begins with a blank character,
    # name is previous RR name (RFC 1035, page 34)
    set name [string tolower [lindex $l 0]]
    if {$name eq ""} then {
	set name $oldname
    }
    if {$name ne ""} then {
	set msg [check-name-syntax $name]
	if {$msg ne ""} then {
	    fatal-error $msg
	}
    }

    # Skip TTL and Class, until RR type is found
    set i 1
    set typefound 0
    while {$i <= [llength $l]-1 && ! $typefound} {
	set tok [zone-get-token [lindex $l $i]]
	switch $tok {
	    TTL -
	    CLASS {
		# do nothing. Just skip to next token
		incr i
	    }
	    TYPE {
		# break
		set typefound 1
	    }
	    default {
		fatal-error "Unrecognized RR ($line)"
	    }
	}
    }
    if {! $typefound} then {
	fatal-error "RR without type ($line)"
    }

    set type [string toupper [lindex $l $i]]
    set data [string tolower [lrange $l [expr $i + 1] end]]

    return [list $type $name $data]
}

proc get-existing-rr {dbfd idview iddom} {
    global existingrr

    set sql "SELECT r.name, i.addr
			FROM dns.rr r, dns.rr_ip i
			WHERE r.idrr = i.idrr
			    AND r.idview = $idview
			    AND iddom = $iddom"
    pg_select $dbfd $sql tab {
	lappend existingrr(ip:$tab(name)) [::ip::normalize $tab(addr)]
    }

    set sql "SELECT r1.name AS name, r2.name AS cname1, d.name AS cname2
			FROM dns.rr r1, dns.rr_cname c, dns.rr r2, dns.domain d
			WHERE r1.idrr = c.idrr
				AND c.cname = r2.idrr
				AND r1.idview = $idview
				AND r2.iddom = d.iddom
				AND r1.iddom = $iddom"
    pg_select $dbfd $sql tab {
	set existingrr(cname:$tab(name)) "$tab(cname1).$tab(cname2)."
    }
}

proc existing-rr {name} {
    global existingrr

    return [expr [info exists existingrr(ip:$name)] \
			|| [info exists existingrr(cname:$name)] ]
}

proc existing-rr-ip {name addr} {
    global existingrr

    set r 0
    set i ip:$name
    if {[info exists existingrr($i)]} then {
	if {$addr in $existingrr($i)} then {
	    set r 1
	}
    }
    return $r
}

proc existing-rr-cname {name cname} {
    global existingrr

    set r 0
    set i cname:$name
    if {[info exists existingrr($i)]} then {
	if {$existingrr($i) eq $cname} then {
	    set r 1
	} else {
	    warning "$name is already a CNAME pointing to $existingrr($i) (ignored)"
	    set r 1
	}
    }
    return $r
}

proc import-zone {verbose argv dbfd} {
    #
    # Syntax checking and read file
    #

    if {[llength $argv] != 6} then {
	usage
    }
    lassign $argv viewname zonename file selector rrsupfile login

    if {$verbose} {
	puts stderr "Importing zone for $zonename (view $viewname) from $file"
    }

    #
    # Read user id
    #

    set idcor [read-idcor $dbfd $login]
    if {$idcor == -1} then {
	fatal-error "Login '$login' not found"
    }

    #
    # Read existing views and look for our view
    #

    read-all-views $dbfd tabview tabidv
    if {! [info exists tabview($viewname)]} then {
	fatal-error "View '$viewname' not found"
    }
    set idview $tabview($viewname)

    #
    # Read existing domains
    #

    read-all-domains $dbfd tabdom tabid

    #
    # Read zone RRs for normal domains
    #

    set version [::ip::version $selector]
    if {$version == -1} then {
	if {! [info exists tabdom($selector)]} then {
	    fatal-error "Domain '$selector' not found"
	}
	set iddom $tabdom($selector)
	get-existing-rr $dbfd $idview $iddom
	set reverse 0
    } else {
	set reverse 1
    }

    #
    # Read zone file :
    # - parse prologue and get existing serial
    # - parse all A/AAAA records and place them in tabaddr
    # - parse all CNAME records and place them in tabcname 
    #

    read-zone $file $selector $reverse prologue serial tabaddr tabcname

    if {$verbose >= 3} then {
	if {[array exists tabaddr]} then {
	    parray tabaddr
	}
	if {[array exists tabcname]} then {
	    parray tabcname
	}
    }

    #
    # Import addresses and CNAMEs into database
    #

    set err 0

    if {$version == -1} then {
	#
	# Import IP addresses
	#

	foreach name [lsort [array names tabaddr]] {
	    catch {unset trr}
	    if {! [read-rr-by-name $dbfd $name $iddom $idview trr]} then {
		if {$verbose >= 2} then {
		    puts stderr "Adding RR $name"
		}
		set msg [add-rr $dbfd $name $iddom $idview "" 0 "" 0 -1 "" "" "" $idcor trr]
		if {$msg ne ""} then {
		    warning "Unable to add $name ($msg)"
		    set err 1
		    continue
		}
	    }
	    foreach a $tabaddr($name) {
		if {$verbose >= 2} then {
		    puts stderr "Adding IP $name / $a"
		}
		set sql "INSERT INTO dns.rr_ip (idrr, addr)
					VALUES ($trr(idrr), '$a')"
		if {! [::pgsql::execsql $dbfd $sql msg]} then {
		    warning "Unable to add $name/$a ($msg)"
		    set err 1
		}
	    }
	}

	#
	# Get all CNAME read from the file
	#

	foreach name [lsort [array names tabcname]] {
	    catch {unset trr}
	    if {! [read-rr-by-name $dbfd $name $iddom $idview trr]} then {
		if {$verbose >= 2} then {
		    puts stderr "Adding RR $name"
		}
		set msg [add-rr $dbfd $name $iddom $idview "" 0 "" 0 -1 "" "" "" $idcor trr]
		if {$msg ne ""} then {
		    warning "Unable to add $name ($msg)"
		    set err 1
		    continue
		}
	    }

	    set ref $tabcname($name)
	    if {[regexp {^([^.]+)\.(.+).$} $ref x n dom]} then {
		if {[info exists tabdom($dom)]} then {
		    catch {unset tref}
		    if {[read-rr-by-name $dbfd $n $tabdom($dom) $idview tref]} then {
			if {$verbose >= 2} then {
			    puts stderr "Adding CNAME $name / $a"
			}
			set sql "INSERT INTO dns.rr_cname (idrr, cname)
				    	VALUES ($trr(idrr), $tref(idrr))"
			if {! [::pgsql::execsql $dbfd $sql msg]} then {
			    warning "Unable to add CNAME $name -> $ref ($msg)"
			    set err 1
			}
		    } else {
			warning "CNAME '$name' points to non existant '$ref'. Ignored.\nImport zone $zonename one more time when '$dom' zone is imported"
		    }
		} else {
		    warning "Illegal CNAME domain ($name -> $ref)"
		    set err 1
		}
	    } else {
		warning "Illegal CNAME syntax ($name -> $ref)"
		set err 1
	    }
	}
    }

    #
    # Reads rrsup file
    #

    set fd [open $rrsupfile "r"]
    set rrsup [read $fd]
    close $fd

    #
    # Import zone prologue
    #

    set qzonename [::pgsql::quote $zonename]
    set qprologue [::pgsql::quote $prologue]
    set qrrsup [::pgsql::quote $rrsup]
    set qselector [::pgsql::quote $selector]

    switch $version {
	-1 { set table "dns.zone_forward" }
	4 { set table "dns.zone_reverse4" }
	6 { set table "dns.zone_reverse6" }
    }

    # use same id if it already exists
    set idzone -1
    set sql "SELECT idzone FROM $table
    			WHERE name = '$qzonename' AND idview = $idview"
    pg_select $dbfd $sql tab {
	set idzone $tab(idzone)
    }
    if {$idzone == -1} then {
	set sql "INSERT INTO $table (name, idview, version, prologue,
					rrsup, gen, selection)
			VALUES ('$qzonename', $idview, $serial, '$qprologue',
					'$qrrsup', 1, '$qselector')"
    } else {
	set sql "UPDATE $table SET version = $serial,
				    prologue = '$qprologue',
				    rrsup = '$qrrsup',
				    gen = 1,
				    selection = '$qselector'
				WHERE idzone = $idzone"
    }
    if {! [::pgsql::execsql $dbfd $sql msg]} then {
	warning "Unable to change '$zonename' zone specification"
	set err 1
    }

    #
    # Returns (with or without an error"
    #

    if {$err} then {
	return "Error(s) detected. Abort."
    }

    return ""
}

##############################################################################
# Import mail relays
##############################################################################

#
# Mail relay file
# Format:
#	domain prio relay prio relay ...
# Examples:
#	example.com 10 mailhost1.example.com 20 mailhost2.example.com
#

proc read-mailrelay {file} {
    set l {}
    set err 0
    set fd [openfile $file]
    while {[readline $fd line "#"] > -1} {
	if {$line ne ""} then {
	    if {[llength $line] % 2 != 1} then {
		set err 1
		warning "Invalid syntax"
		continue
	    }
	    set line [string tolower $line]
	    set domain [lindex $line 0]
	    if {[info exists tab($domain)]} then {
		set err 1
		warning "Relays for domain '$domain' already specified"
	    }
	    set tab($domain) ""
	    set l2 [list $domain]
	    foreach {prio relay} [lreplace $line 0 0] {
		if {! [regexp {^\d+$} $prio]} then {
		    set err 1
		    warning "Invalid priority syntax '$prio'"
		}
		lappend l2 [list $prio $relay]
	    }
	    lappend l $l2
	}
    }
    closefile $fd
    if {$err} then {
	fatal-error "Abort."
    }
    return $l
}

proc import-mailrelay {verbose argv dbfd} {
    #
    # Syntax checking and read file
    #

    if {[llength $argv] != 2} then {
	usage
    }

    lassign $argv viewname file

    if {$verbose} {
	puts stderr "Importing mail relays (view $viewname) from $file"
    }

    #
    # Read existing views and look for our view
    #

    read-all-views $dbfd tabview tabidv
    if {! [info exists tabview($viewname)]} then {
	fatal-error "View '$viewname' not found"
    }
    set idview $tabview($viewname)

    #
    # Read file
    #

    set lmr [read-mailrelay $file]

    #
    # Read domains
    #

    read-all-domains $dbfd tabdom tabid

    #
    # Postprocess input to check syntax, and to insert mail relays
    # in database
    #

    set err 0
    foreach mr $lmr {
	set domain [lindex $mr 0]
	if {! [info exists tabdom($domain)]} then {
	    set err 1
	    warning "Unknown domain '$domain'"
	} else {
	    set iddom $tabdom($domain)

	    #
	    # Update permissions for all groups which have
	    # access to this domain
	    #

	    set sql "UPDATE dns.p_dom SET mailrole = 1 WHERE iddom = $iddom"
	    if {! [::pgsql::execsql $dbfd $sql msg]} then {
		return "$msg\nAbort"
	    }

	    #
	    # Process each relay
	    #

	    foreach rl [lreplace $mr 0 0] {
		lassign $rl prio relay

		set msg [check-fqdn-syntax $dbfd $relay namer domr iddomr]
		if {$msg ne ""} then {
		    set err 1
		    warning $msg
		} else {
		    if {[read-rr-by-name $dbfd $namer $iddomr $idview trr]} then {
			set sql "INSERT INTO dns.relay_dom
						(iddom, prio, mx)
					VALUES ($iddom, $prio, $trr(idrr))"
			if {! [::pgsql::execsql $dbfd $sql msg]} then {
			    return "$msg\nAbort"
			}
		    } else {
			set err 1
			warning "Relay '$relay' not found for domain '$domain'"
		    }
		}
	    }
	}
    }

    if {$err} then {
	return "Abort."
    }

    return ""
}

##############################################################################
# Import mail roles
##############################################################################

#
# Mail role file
# Format:
#	mail-address mailbox-host[/viewname]
# Examples:
#	mktg.example.com mboxhost.example.com
#	sales.example.com mboxhost.example.com/internal
#

proc read-mailrole {file} {
    set l {}
    set err 0
    set fd [openfile $file]
    while {[readline $fd line "#"] > -1} {
	if {$line ne ""} then {
	    set line [string tolower $line]
	    set viewname ""
	    if {[regexp {^([^.]+)\.(\S+)\s+([^.]+)\.([^/]+)(/(.+))?$} $line x n1 d1 n2 d2 dummy viewname]} then {
		set mailaddr "$n1.$d1"
		if {[info exists tab($mailaddr)]} then {
		    set err 1
		    warning "Mail address '$mailaddr' already specified"
		} else {
		    set tab($mailaddr) ""
		    lappend l [list $n1 $d1 $n2 $d2 $viewname]
		}
	    } else {
		set err 1
		warning "Invalid line '$line'"
	    }
	}
    }
    closefile $fd
    if {$err} then {
	fatal-error "Abort."
    }
    return $l
}

proc import-mailrole {verbose argv dbfd} {
    #
    # Syntax checking and read file
    #

    if {[llength $argv] != 3} then {
	usage
    }

    lassign $argv viewname file login

    if {$verbose} {
	puts stderr "Importing mail roles from $file"
    }

    #
    # Read user id
    #

    set idcor [read-idcor $dbfd $login]
    if {$idcor == -1} then {
	return "Login '$login' not found"
    }

    #
    # Read existing views and look for our view
    #

    read-all-views $dbfd tabview tabidv
    if {! [info exists tabview($viewname)]} then {
	fatal-error "View '$viewname' not found"
    }
    set idview $tabview($viewname)

    #
    # Read file
    #

    set lmr [read-mailrole $file]

    #
    # Read domains
    #

    read-all-domains $dbfd tabdom tabid

    #
    # Postprocess input to check syntax, and to insert mail roles
    # in database (no check if mail roles already exist)
    #

    set err 0
    foreach mr $lmr {
	lassign $mr n1 d1 n2 d2 viewmbox

	if {! [info exists tabdom($d1)]} then {
	    set err 1
	    warning "Unknown domain '$d1' for '$n1.$d1'"
	} else {
	    set iddom1 $tabdom($d1)
	    if {! [read-rr-by-name $dbfd $n1 $iddom1 $idview trr1]} then {
		set msg [add-rr $dbfd $n1 $iddom1 $idview "" 0 "" 0 -1 "" "" "" $idcor trr1]
		if {$msg ne ""} then {
		    set err 1
		    warning $msg
		}
	    }
	}

	if {$viewmbox eq ""} then {
	    # default view is current view
	    set viewmbox $viewname
	}

	if {! [info exists tabview($viewmbox)]} then {
	    set err 1
	    warning "Unknown view '$viewmbox' for '$n1.$d1->$n2.$d2/$viewmbox'"
	} elseif {! [info exists tabdom($d2)]} then {
	    set err 1
	    warning "Unknown domain '$d2' for '$n2.$d2'"
	} else {
	    set idviewmbox $tabview($viewmbox)
	    set iddom2 $tabdom($d2)
	    if {[read-rr-by-name $dbfd $n2 $iddom2 $idviewmbox trr2]} then {
		if {[llength [rr-ip-by-view trr2 $idviewmbox]] == 0} then {
		    set err 1
		    warning "'$n2.$d2' is not a host"
		}
	    } else {
		set err 1
		warning "Unknown host '$n2.$d2'"
	    }
	}

	if {! $err} then {
	    set sql "INSERT INTO dns.mail_role (mailaddr, mboxhost)
			VALUES ($trr1(idrr), $trr2(idrr))"
	    if {! [::pgsql::execsql $dbfd $sql msg]} then {
		return "$msg\nAbort"
	    }
	}
    }

    if {$err} then {
	return "Abort."
    }

    return ""
}

##############################################################################
# Main program
##############################################################################

proc main {argv0 argv} {
    global conf

    setprog $argv0

    #
    # Netmagis database access
    #

    set msg [d init-script dbfd $argv0 true tabcor]
    if {$msg ne ""} then {
	fatal-error "$msg\nAborted."
    }

    #
    # Argument checking
    #

    set verbose 0
    while {[llength $argv] > 0} {
	set a [lindex $argv 0]
	switch -glob -- $a {
	    -v {
		incr verbose
		set argv [lreplace $argv 0 0]
	    }
	    -* {
		warning "Unknown option '$a'"
		usage
	    }
	    default {
		break
	    }
	}
    }

    set op [lindex $argv 0]
    set fct [info procs "import-$op"]
    if {[llength $fct] != 1} then {
	usage
    }

    #
    # Lock database, do the work, and commit modifications
    #

    set msg [d dblock {}]
    if {$msg ne ""} then {
	fatal-error $msg
    }

    set msg [$fct $verbose [lreplace $argv 0 0] $dbfd]
    if {$msg ne ""} then {
	set msg [d dbabort "import" $msg]
	fatal-error $msg
    }

    set msg [d dbcommit "import"]
    if {$msg ne ""} then {
	fatal-error $msg
    }

    d end
    return 0
}

exit [main $argv0 $argv]
