--- rpms/e-smith-base/sme10/e-smith-base-5.8.0-bz11177-systemd.patch	2020/11/17 02:56:00	1.1
+++ rpms/e-smith-base/sme10/e-smith-base-5.8.0-bz11177-systemd.patch	2020/11/17 16:57:45	1.2
@@ -1,153 +1,3 @@
-diff -Nur e-smith-base-5.8.0.old/root/etc/e-smith/events/actions/adjust-services e-smith-base-5.8.0/root/etc/e-smith/events/actions/adjust-services
---- e-smith-base-5.8.0.old/root/etc/e-smith/events/actions/adjust-services	1969-12-31 19:00:00.000000000 -0500
-+++ e-smith-base-5.8.0/root/etc/e-smith/events/actions/adjust-services	2020-11-16 01:15:19.192000000 -0500
-@@ -0,0 +1,146 @@
-+#!/usr/bin/perl -w
-+#----------------------------------------------------------------------
-+# copyright (C) 2005 Mitel Networks Corporation
-+# 
-+# This program is free software; you can redistribute it and/or modify
-+# it under the terms of the GNU General Public License as published by
-+# the Free Software Foundation; either version 2 of the License, or
-+# (at your option) any later version.
-+# 		
-+# This program is distributed in the hope that it will be useful,
-+# but WITHOUT ANY WARRANTY; without even the implied warranty of
-+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-+# GNU General Public License for more details.
-+# 		
-+# You should have received a copy of the GNU General Public License
-+# along with this program; if not, write to the Free Software
-+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
-+# 
-+#----------------------------------------------------------------------
-+package esmith;
-+
-+use strict;
-+use Errno;
-+use DirHandle;
-+
-+my $event = shift || die "must give event name parameter";
-+chdir "/etc/e-smith/events/$event" or die "Couldn't chdir to event directory /etc/e-smith/events/$event: $!";
-+my $dh = DirHandle->new("services2adjust");
-+
-+exit(0) unless $dh; # Nothing to do
-+
-+use esmith::ConfigDB;
-+use esmith::util;
-+
-+my %param2char = (
-+	down => 'd',
-+	stop => 'd',
-+	up => 'u',
-+	start => 'u',
-+	restart => 't',
-+	sigterm => 't',
-+	adjust => 'h',
-+	reload => 'h',
-+	sighup => 'h',
-+	sigusr1 => '1',
-+	sigusr2 => '2',
-+	once => 'o',
-+	pause => 'p',
-+	alarm => 'a',
-+	interrupt => 'i',
-+	quit => 'q',
-+	kill => 'k',
-+	exit => 'x',
-+    );
-+
-+sub adjust_supervised_service
-+{
-+    my ($s, @actions) = @_;
-+    my $m = "control fifo for service $s: ";
-+    unless (open(C, ">/service/$s/supervise/control"))
-+    {
-+	warn "Couldn't open $m$!";
-+	return;
-+    }
-+    foreach my $p (@actions)
-+    {
-+	my $c = $param2char{$p};
-+	unless ($c)
-+	{
-+	    warn "Unrecognised param $p for service $s\n";
-+	    next;
-+	}
-+	warn "adjusting supervised $s ($p)\n";
-+	unless (print C $c)
-+	{
-+	    warn "Couldn't write to $m$!";
-+	    return;
-+	}
-+    }
-+    warn  "Couldn't close $m$!" unless close(C);
-+}
-+
-+my $conf = esmith::ConfigDB->open_ro || die "Couldn't open config db";
-+
-+foreach my $service (grep { !/^\./ } $dh->read())
-+{
-+    my $s = $conf->get($service);
-+    unless ($s)
-+    {
-+	warn "No conf db entry for service $service\n";
-+	next;
-+    }
-+    my $f =  "services2adjust/$service";
-+    
-+    my @actions;
-+    if (-l "$f")
-+    {
-+	@actions = ( readlink "$f" );
-+    }
-+    else
-+    {
-+	if (open(F, $f))
-+	{
-+	    # Read list of actions from the file, and untaint
-+	    @actions = map { chomp; /([a-z]+[12]?)/ ; $1 } <F>;
-+	    close(F);
-+	}
-+	else
-+	{
-+	    warn "Could not open $f: $!";
-+	}
-+    }
-+
-+    # if service is supervised and not handled by systemd
-+    if (-d "/service/$service" && glob("/etc/rc7.d/S??$service"))
-+    {
-+	my $enabled = ($s->prop('status') || 'disabled') eq 'enabled';
-+	adjust_supervised_service($service,
-+		# stop the service if it is now disabled
-+		$enabled ? () : 'down',
-+		# Send the specified signal(s) to the running daemon
-+		@actions,
-+		# bring the service up if it is enabled (and we're not
-+		# stopping it or running it once)
-+		($enabled && !grep { /^(down|stop|d|once|o)$/ } @actions) ? 'up' : (),
-+	    );
-+    }
-+    # for service handled by former sysvinit or directly with systemd
-+    else
-+    {
-+        my $enabled = ($s->prop('status') || 'disabled') eq 'enabled';
-+        # stop the service if it is now disabled
-+        unshift(@actions,'stop') unless  $enabled;
-+        # bring the service up if it is enabled (and we're not stopping it or running it once)
-+        push(@actions,'start') if ($enabled && !grep { /^(down|stop|d|once|o|start|restart|reload-or-restart)$/ } @actions) ;
-+	foreach (@actions)
-+	{
-+	    warn "adjusting non-supervised $service ($_)\n";
-+	    esmith::util::serviceControl(
-+		    NAME => $service,
-+		    ACTION => $_,
-+		);
-+	}
-+    }
-+}
-+
 diff -Nur e-smith-base-5.8.0.old/root/sbin/e-smith/service-status e-smith-base-5.8.0/root/sbin/e-smith/service-status
 --- e-smith-base-5.8.0.old/root/sbin/e-smith/service-status	2020-11-16 01:04:00.182000000 -0500
 +++ e-smith-base-5.8.0/root/sbin/e-smith/service-status	2020-11-16 21:55:20.898000000 -0500
@@ -163,1411 +13,3 @@ diff -Nur e-smith-base-5.8.0.old/root/sb
  fi
  
  exit 0
-diff -Nur e-smith-base-5.8.0.old/root/usr/share/perl5/vendor_perl/esmith/util.pm e-smith-base-5.8.0/root/usr/share/perl5/vendor_perl/esmith/util.pm
---- e-smith-base-5.8.0.old/root/usr/share/perl5/vendor_perl/esmith/util.pm	1969-12-31 19:00:00.000000000 -0500
-+++ e-smith-base-5.8.0/root/usr/share/perl5/vendor_perl/esmith/util.pm	2020-11-16 01:05:33.057000000 -0500
-@@ -0,0 +1,1404 @@
-+#----------------------------------------------------------------------
-+# Copyright 1999-2003 Mitel Networks Corporation
-+# This program is free software; you can redistribute it and/or
-+# modify it under the same terms as Perl itself.
-+#----------------------------------------------------------------------
-+
-+package esmith::util;
-+
-+use strict;
-+
-+use Text::Template 'fill_in_file';
-+use POSIX qw (setsid);
-+use Errno;
-+use Carp;
-+use esmith::config;
-+use esmith::db;
-+use esmith::DB;
-+use esmith::ConfigDB;
-+use Net::IPv4Addr qw(:all);
-+use Taint::Util;
-+use File::Basename;
-+use File::stat;
-+use FileHandle;
-+use Data::UUID;
-+=pod
-+
-+=head1 NAME
-+
-+esmith::util - Utilities for e-smith server and gateway development
-+
-+=head1 VERSION
-+
-+This file documents C<esmith::util> version B<1.4.0>
-+
-+=head1 SYNOPSIS
-+
-+    use esmith::util;
-+
-+=head1 DESCRIPTION
-+
-+This module provides general utilities of use to developers of the
-+e-smith server and gateway.
-+
-+=head1 GENERAL UTILITIES
-+
-+=head2 setRealToEffective()
-+
-+Sets the real UID to the effective UID and the real GID to the effective
-+GID.
-+
-+=begin testing
-+
-+use_ok('esmith::util');
-+
-+=end testing
-+
-+=cut
-+
-+sub setRealToEffective ()
-+{
-+    $< = $>;
-+    $( = $);
-+}
-+
-+=pod
-+
-+=head2 processTemplate({ CONFREF => $conf, TEMPLATE_PATH => $path })
-+
-+B<Depreacted> interface to esmith::templates::processTemplate().
-+
-+=cut
-+
-+sub processTemplate
-+{
-+    require esmith::templates;
-+    goto &esmith::templates::processTemplate;
-+}
-+
-+#------------------------------------------------------------
-+
-+=pod
-+
-+=head2 chownfile($user, $group, $file)
-+
-+This routine changes the ownership of a file, automatically converting
-+usernames and groupnames to UIDs and GIDs respectively.
-+
-+=cut
-+
-+sub chownFile ($$$)
-+{
-+    my ( $user, $group, $file ) = @_;
-+
-+    unless ( -e $file )
-+    {
-+        warn("can't chownFile $file: $!\n");
-+        return;
-+    }
-+    my $uid = defined $user  ? getpwnam($user)  : stat($file)->uid;
-+    my $gid = defined $group ? getgrnam($group) : stat($file)->gid;
-+
-+    chown( $uid, $gid, $file );
-+}
-+
-+=pod
-+
-+=head2 determineRelease()
-+
-+Returns the current release version of the software.
-+
-+=cut
-+
-+sub determineRelease()
-+{
-+    my $unknown = "(unknown version)";
-+
-+    my $db = esmith::ConfigDB->open() or return $unknown;
-+
-+    my $sysconfig = $db->get("sysconfig") or return $unknown;
-+
-+    my $release = $sysconfig->prop("ReleaseVersion") || $unknown;
-+
-+    return $release;
-+}
-+
-+=pod
-+
-+=head1 NETWORK ADDRESS TRANSLATION UTILITIES
-+
-+=head2 IPquadToAddr($ip)
-+
-+Convert IP address from "xxx.xxx.xxx.xxx" notation to a 32-bit
-+integer.
-+
-+=cut
-+
-+sub IPquadToAddr ($)
-+{
-+    my ($quad) = @_;
-+    return 0 unless defined $quad;
-+    if ( $quad =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ )
-+    {
-+        return ( $1 << 24 ) + ( $2 << 16 ) + ( $3 << 8 ) + $4;
-+    }
-+    return 0;
-+}
-+
-+=pod
-+
-+=head2 IPaddrToQuad($address)
-+
-+Convert IP address from a 32-bit integer to "xxx.xxx.xxx.xxx"
-+notation.
-+
-+=cut
-+
-+sub IPaddrToQuad ($)
-+{
-+    my ($addrBits) = @_;
-+    return sprintf( "%d.%d.%d.%d",
-+        ( $addrBits >> 24 ) & 0xff,
-+        ( $addrBits >> 16 ) & 0xff,
-+        ( $addrBits >> 8 ) & 0xff,
-+        $addrBits & 0xff );
-+}
-+
-+=pod
-+
-+=head2 IPaddrToBackwardQuad($address)
-+
-+Convert IP address from a 32-bit integer to reversed
-+"xxx.xxx.xxx.xxx.in-addr.arpa" notation for BIND files.
-+
-+=cut
-+
-+sub IPaddrToBackwardQuad ($)
-+{
-+    my ($addrBits) = @_;
-+    return sprintf(
-+        "%d.%d.%d.%d.in-addr.arpa.",
-+        $addrBits & 0xff,
-+        ( $addrBits >> 8 ) & 0xff,
-+        ( $addrBits >> 16 ) & 0xff,
-+        ( $addrBits >> 24 ) & 0xff
-+    );
-+}
-+
-+=pod
-+
-+=head2 computeNetworkAndBroadcast($ipaddr, $netmask)
-+
-+Given an IP address and netmask (both in "xxx.xxx.xxx.xxx" format)
-+compute the network and broadcast addresses and output them in the
-+same format.
-+
-+=cut
-+
-+sub computeNetworkAndBroadcast ($$)
-+{
-+    my ( $ipaddr, $netmask ) = @_;
-+
-+    my ( $network, $msk ) = ipv4_network( $ipaddr, $netmask );
-+    my $broadcast = ipv4_broadcast( $ipaddr, $netmask );
-+
-+    return ( $network, $broadcast );
-+}
-+
-+=pod
-+
-+=head2 computeLocalNetworkPrefix($ipaddr, $netmask)
-+
-+Given an IP address and netmask, the computeLocalNetworkPrefix
-+function computes the network prefix for local machines.
-+
-+i.e. for an IP address of 192.168.8.4 and netmask of 255.255.255.0,
-+this function will return "192.168.8.".
-+
-+This string is suitable for use in configuration files (such as
-+/etc/proftpd.conf) when the more precise notation
-+
-+    xxx.xxx.xxx.xxx/yyy.yyy.yyy.yyy
-+
-+is not supported.
-+
-+=cut
-+
-+sub computeLocalNetworkPrefix ($$)
-+{
-+    my ( $ipaddr, $netmask ) = @_;
-+
-+    my ( $net, $msk ) = ipv4_network( $ipaddr, $netmask );
-+    $net =~ s/(\d{1,3}\.\d{1,3}\.\d{1,3}\.)(\d{1,3})/$1/;
-+
-+    return $net;
-+}
-+
-+=pod
-+
-+=head2 computeAllLocalNetworkPrefixes ($ipaddress, $netmask)
-+
-+ Given an IP address and netmask, the computeAllLocalNetworkPrefixes
-+ function computes the network prefix or list of prefixes that
-+ fully describe the network to which the IP address belongs.
-+
-+ examples:
-+
-+ - for an IP address of 192.168.8.4 and netmask of 255.255.255.0,
-+ will return an array with a first (and only) element of "192.168.8".
-+
-+ - for an IP address of 192.168.8.4 and netmask of 255.255.254.0,
-+ will return the array [ '192.168.8', '192.168.9' ].
-+
-+ This array is suitable for use in configuration of tools such as
-+ djbdns where other network notations are not supported.
-+
-+=begin testing
-+
-+is_deeply(
-+    [esmith::util::computeAllLocalNetworkPrefixes("192.168.8.4",
-+                            "255.255.254.0")],
-+    ['192.168.8', '192.168.9' ],
-+    "/23 network"
-+    );
-+
-+is_deeply(
-+    [esmith::util::computeAllLocalNetworkPrefixes("192.168.8.4",
-+                            "255.255.255.255")],
-+    ['192.168.8.4'],
-+    "/32 network"
-+    );
-+
-+is_deeply(
-+    [esmith::util::computeAllLocalNetworkPrefixes("192.168.8.4",
-+                            "255.255.255.0")],
-+    ['192.168.8'],
-+    "/24 network"
-+    );
-+
-+=end testing
-+
-+=cut
-+
-+sub computeAllLocalNetworkPrefixes
-+{
-+    my ( $ipaddr, $netmask ) = @_;
-+
-+    my $ipaddrBits  = IPquadToAddr($ipaddr);
-+    my $netmaskBits = IPquadToAddr($netmask);
-+    my $networkBits = $ipaddrBits & $netmaskBits;
-+
-+    # first, calculate the prefix (/??) given the netmask
-+    my $len = 0;
-+    for ( my $bits = $netmaskBits ; $bits & 0xFFFFFFFF ; $bits <<= 1 )
-+    {
-+        $len++;
-+    }
-+
-+    # Here's where the magic starts...
-+    #
-+    # next, calculate the number of networks we expect to generate and
-+    # the incrementing value for each network.
-+    my $number_of_nets = 1 << ( ( 32 - $len ) % 8 );
-+    my $one_net = 1 << ( 3 - ( int $len / 8 ) ) * 8;
-+    my @networks;
-+    while ( $number_of_nets-- )
-+    {
-+        my $network = IPaddrToQuad($networkBits);
-+
-+        # we want to strip off the trailing ``.0'' for /24 or larger networks
-+        if ( $len <= 24 )
-+        {
-+            $network =~ s/\.0$//;
-+        }
-+
-+        # we want to continue to strip off trailing ``.0'', one more for
-+        # /9 to /16, two more for /1 to /8
-+        $network =~ s/\.0$// if ( $len <= 16 );
-+        $network =~ s/\.0$// if ( $len <= 8 );
-+
-+        # push the resulting network into an array that we'll return;
-+        push @networks, $network;
-+
-+        # increment the network by ``one'', relative to the size of networks
-+        # we're dealing with
-+        $networkBits += $one_net;
-+    }
-+    return (@networks);
-+}
-+
-+=pod
-+
-+=head2 computeLocalNetworkShortSpec($ipaddr, $netmask)
-+
-+Given an IP address and netmask, the computeLocalNetworkShortSpec
-+function computes a valid xxx.xxx.xxx.xxx/yyy specifier where yyy
-+is the number of bits specifying the network.
-+
-+i.e. for an IP address of 192.168.8.4 and netmask of 255.255.255.0,
-+this function will return "192.168.8.0/24".
-+
-+This string is suitable for use in configuration files (such as
-+/etc/proftpd.conf) when the more precise notation
-+
-+    xxx.xxx.xxx.xxx/yyy.yyy.yyy.yyy
-+
-+is not supported.
-+
-+=cut
-+
-+sub computeLocalNetworkShortSpec ($$)
-+{
-+    my ( $ipaddr, $netmask ) = @_;
-+    my ( $net, $mask ) = ipv4_network( $ipaddr, $netmask );
-+    return "$net/$mask";
-+}
-+
-+=pod
-+
-+=head2 computeLocalNetworkSpec($ipaddr, $netmask)
-+
-+Given an IP address and netmask, the computeLocalNetworkSpec function
-+computes a valid xxx.xxx.xxx.xxx/yyy.yyy.yyy.yyy specifier.
-+
-+=cut
-+
-+sub computeLocalNetworkSpec ($$)
-+{
-+    my ( $ipaddr, $netmask ) = @_;
-+    my ( $net, $mask ) = ipv4_network( $ipaddr, $netmask );
-+    $mask = ipv4_cidr2msk($mask);
-+    return "$net/$mask";
-+}
-+
-+=pod
-+
-+=head2 computeNetmaskFromBits ($bits)
-+
-+Given a number of bits of network address, calculate the appropriate
-+netmask.
-+
-+=cut
-+
-+sub computeNetmaskFromBits ($)
-+{
-+    my ($ones) = @_;
-+
-+    return ipv4_cidr2msk($ones);
-+}
-+
-+=pod
-+
-+=head2 computeLocalNetworkReversed($ipaddr, $netmask)
-+
-+Given an IP address and netmask, the computeLocalNetworkReversed
-+function computes the appropriate DNS domain field.
-+
-+NOTE: The return value is aligned to the next available byte boundary, i.e.
-+
-+     192.168.8.4/255.255.255.0 returns "8.168.192.in-addr.arpa."
-+     192.168.8.4/255.255.252.0 returns "168.192.in-addr.arpa."
-+     192.168.8.4/255.255.0.0   returns "168.192.in-addr.arpa."
-+     192.168.8.4/255.252.0.0   returns "192.in-addr.arpa."
-+     192.168.8.4/255.0.0.0     returns "192.in-addr.arpa."
-+
-+This string is suitable for use in BIND configuration files.
-+
-+=cut
-+
-+sub computeLocalNetworkReversed ($$)
-+{
-+    my ( $ipaddr, $netmask ) = @_;
-+
-+    my @addressBytes = split ( /\./, $ipaddr );
-+    my @maskBytes    = split ( /\./, $netmask );
-+
-+    my @result;
-+
-+    push ( @result, "in-addr.arpa." );
-+
-+    foreach (@maskBytes)
-+    {
-+        last unless ( $_ eq "255" );
-+
-+        unshift ( @result, shift (@addressBytes) );
-+    }
-+
-+    return join ( '.', @result );
-+}
-+
-+=pod
-+
-+=head2 computeHostRange($ipaddr, $netmask)
-+
-+Given a network specification (IP address and netmask), compute
-+the total number of hosts in that network, as well as the first
-+and last IP addresses in the range.
-+
-+=cut
-+
-+sub computeHostRange ($$)
-+{
-+    my ( $ipaddr, $netmask ) = @_;
-+
-+    my $ipaddrBits   = IPquadToAddr($ipaddr);
-+    my $netmaskBits  = IPquadToAddr($netmask);
-+    my $hostmaskBits = ( ( ~$netmaskBits ) & 0xffffffff );
-+
-+    my $firstAddrBits = $ipaddrBits & $netmaskBits;
-+    my $lastAddrBits  = $ipaddrBits | $hostmaskBits;
-+
-+    my $totalHosts = 1;
-+
-+    for ( ; $hostmaskBits ; $hostmaskBits /= 2 )
-+    {
-+        if ( ( $hostmaskBits & 0x1 ) == 0x1 )
-+        {
-+            $totalHosts *= 2;
-+        }
-+    }
-+
-+    return ( $totalHosts, IPaddrToQuad($firstAddrBits),
-+        IPaddrToQuad($lastAddrBits) );
-+}
-+
-+=pod
-+
-+=head2 ldapBase($domain)
-+
-+Given a domain name such as foo.bar.com, generate the
-+LDAP base name "dc=foo,dc=bar,dc=com".
-+
-+=cut
-+
-+sub ldapBase ($)
-+{
-+    my ($domainName) = @_;
-+    $domainName =~ s/\./,dc=/g;
-+    return "dc=" . $domainName;
-+}
-+
-+=pod
-+
-+=head2 backgroundCommand($delaySec, @command)
-+
-+Run command in background after a specified delay.
-+
-+=cut
-+
-+sub backgroundCommand ($@)
-+{
-+    my ( $delaySec, @command ) = @_;
-+
-+    # now would be a good time to flush output buffers, so the partial
-+    # buffers don't get copied
-+
-+    $| = 1;
-+    print "";
-+
-+    # create child process
-+    my $pid = fork;
-+
-+    # if fork failed, bail out
-+    die "Cannot fork: $!" unless defined($pid);
-+
-+    # If fork succeeded, make parent process return immediately.
-+    # We are not waiting on the child, so it will become a zombie
-+    # process when it completes. However, this subroutine is only
-+    # intended for use by the e-smith signal-event program, which
-+    # doesn't run very long. Once the parent terminates, the zombie
-+    # will become owned by "init" and will be reaped automatically.
-+
-+    return if ($pid);
-+
-+    # detach ourselves from the terminal
-+    setsid || die "Cannot start a new session: $!";
-+
-+    # change working directory
-+    chdir "/";
-+
-+    # clear file creation mask
-+    umask 0;
-+
-+    # close STDIN, STDOUT, and STDERR
-+    close STDIN;
-+    close STDOUT;
-+    close STDERR;
-+
-+    # reopen stderr, stdout, stdin
-+    open( STDIN, '/dev/null' );
-+
-+    my $loggerPid = open( STDOUT, "|-" );
-+    die "Can't fork: $!\n" unless defined $loggerPid;
-+
-+    unless ($loggerPid)
-+    {
-+        exec qw(/usr/bin/logger -p local1.info -t e-smith-bg);
-+    }
-+
-+    open( STDERR, '>&STDOUT' );
-+
-+    # make child wait for specified delay.
-+    sleep $delaySec;
-+
-+    # execute command
-+    exec { $command[0] } @command or warn "Can't @command : $!\n";   
-+}
-+
-+=pod
-+
-+=head1 PASSWORD UTILITIES
-+
-+Low-level password-changing utilities. These utilities each
-+change passwords for a single underlying password database,
-+for example /etc/passwd, /etc/samba/smbpasswd, etc.
-+
-+=head2 validatePassword($password, $strength)
-+
-+Validate Unix password.
-+
-+=cut
-+
-+sub validatePassword($$)
-+{
-+    my ( $password, $strength ) = @_;
-+    use Crypt::Cracklib;
-+
-+    $strength ||= 'normal';
-+
-+    my $reason = 'ok';
-+    $reason = 'it is too short' unless (length($password) > 6);
-+    return $reason if ($reason ne 'ok' || $strength eq 'none');
-+
-+    $reason = 'it does not contain numbers' if (not $password =~ /\d/);
-+    $reason = 'it does not contain uppercase characters' if (not $password =~ /[A-Z]/);
-+    $reason = 'it does not contain lowercase characters' if (not $password =~ /[a-z]/);
-+    $reason = 'it does not contain special characters' if (not $password =~ /\W|_/);
-+    return $reason if ($reason ne 'ok' && $strength eq 'strong');
-+
-+    if ( -f '/usr/lib64/cracklib_dict.pwd' ) {
-+        $reason = fascist_check($password, '/usr/lib64/cracklib_dict');
-+    } else {
-+        $reason = fascist_check($password, '/usr/lib/cracklib_dict');
-+    }
-+    $reason ||= 'the password check failed';
-+
-+    return 'ok' if (lc($reason) eq 'ok');
-+    return $reason;
-+}
-+
-+=pod
-+
-+=head2 setUnixPassword($username, $password)
-+
-+Set Unix password
-+
-+=cut
-+
-+sub setUnixPassword($$)
-+{
-+    my ( $username, $password ) = @_;
-+    setUnixPasswordRequirePrevious( $username, undef, $password );
-+}
-+
-+=pod
-+
-+=head2 authenticateUnixPassword ($username, $password)
-+
-+Check if the given username/password pair is correct.  
-+Return 1 if they are correct, return 0 otherwise.
-+
-+=cut
-+
-+sub authenticateUnixPassword ($$)
-+{
-+    my ( $username, $password ) = @_;
-+
-+    my $pam_auth_func = sub {
-+        return ( PAM_SUCCESS(), $password, PAM_SUCCESS() );
-+    };
-+    my $pamh = new Authen::PAM( 'passwd', $username, $pam_auth_func );
-+
-+    unless ( ref($pamh) )
-+    {
-+        warn "WARN: Couldn't open Authen::PAM handle for user $username";
-+        return 0;
-+    }
-+    my $res = $pamh->pam_authenticate();
-+    return ( $res == PAM_SUCCESS() ) || 0;
-+}
-+
-+=pod
-+
-+=head2 setUnixPasswordRequirePrevious($username, $oldpassword, $newpassword)
-+
-+Set Unix password but require previous password for authentication.
-+
-+=cut
-+
-+# setUnixPasswordRequirePrevious is left as an exercise for the reader :-)
-+sub setUnixPasswordRequirePrevious ($$$)
-+{
-+    my ( $username, $oldpassword, $newpassword ) = @_;
-+    use Authen::PAM;
-+    my $state;
-+
-+    my $my_conv_func = sub {
-+        my @res;
-+        while (@_)
-+        {
-+            my $code = shift;
-+            my $msg  = shift;
-+            my $ans  = "";
-+
-+            $ans = $username if ( $code == PAM_PROMPT_ECHO_ON() );
-+            if ( $code == PAM_PROMPT_ECHO_OFF() )
-+            {
-+                if ( $< == 0 || $state >= 1 )
-+                {
-+                    # are we asked for a new password
-+                    $ans = $newpassword;
-+                }
-+                else
-+                {
-+                    # asked for old password before we can set a new one.
-+                    $ans = $oldpassword;
-+                }
-+                $state++;
-+            }
-+
-+           #print("code is $code, ans is $ans, msg is $msg, state is $state\n");
-+            push @res, ( PAM_SUCCESS(), $ans );
-+        }
-+        push @res, PAM_SUCCESS();
-+        return @res;
-+    };
-+
-+    my $pamh = new Authen::PAM( "passwd", $username, $my_conv_func );
-+    unless ( ref($pamh) )
-+    {
-+        warn "Autopasswd: error code $pamh during PAM init!";
-+        warn "Failed to set Unix password for account $username.\n";
-+        return 0;
-+    }
-+
-+    # Require the old password to be correct before proceeding to set a new
-+    # one.
-+    # This does that, except if you're already root, such as from the
-+    # bootstrap-console
-+    $state = 0;
-+    unless ( $< == 0 or $pamh->pam_authenticate == 0 )
-+    {
-+        warn
-+"PAM authentication failed for user \"$username\", old password invalid!\n";
-+        return 0;
-+    }
-+
-+    $state = 0;
-+    my $res = $pamh->pam_chauthtok;
-+    unless ( $res == PAM_SUCCESS() )
-+    {
-+        my $err = $pamh->pam_strerror($res);
-+        warn "Failed to set Unix password for account $username: $err\n";
-+        return 0;
-+    }
-+    return 1;    # success
-+}
-+
-+=pod
-+
-+=head2 setSambaPassword($username, $password)
-+
-+Set Samba password
-+
-+=cut
-+
-+sub setSambaPassword ($$)
-+{
-+    my ( $username, $password ) = @_;
-+
-+    #----------------------------------------
-+    # then set the password
-+    #----------------------------------------
-+
-+    my $smbPasswdProg = '/usr/bin/smbpasswd';
-+
-+    # see perldoc perlipc (search for 'Safe Pipe Opens')
-+    my $pid = open( DISCARD, "|-" );
-+
-+    if ($pid)    # parent
-+    {
-+        print DISCARD "$password\n$password\n";
-+        close(DISCARD) || die "Child exited early.";
-+    }
-+    else         # child
-+    {
-+        my $retval = system("$smbPasswdProg -a -s $username >/dev/null");
-+        ( $retval / 256 )
-+          && die "Failed to set Samba password for account $username.\n";
-+        exit 0;
-+    }
-+    # Now we enable the account
-+    return system("$smbPasswdProg -e $username >/dev/null") ? 0 : 1;
-+}
-+
-+=pod
-+
-+=head2 cancelSambaPassword($username)
-+
-+Cancel Samba password
-+
-+=cut
-+
-+sub cancelSambaPassword ($)
-+{
-+    my ($username) = @_;
-+
-+    #----------------------------------------
-+    # Gordon Rowell <gordonr@e-smith.com> June 7, 2000
-+    # We really should maintain old users, which would mean we can just use
-+    # smbpasswd -d, but the current policy is to remove them. If we are
-+    # doing that (see below), there is no need to disable them first.
-+    #----------------------------------------
-+    #    my $discard = `/usr/bin/smbpasswd -d -s $username`;
-+    #    if ($? != 0)
-+    #    {
-+    #   die "Failed to disable Samba account $username.\n";
-+    #    }
-+
-+    #----------------------------------------
-+    # Delete the smbpasswd entry. If we don't, re-adding the same
-+    # username will result in a mismatch of UIDs between /etc/passwd
-+    # and /etc/smbpasswd
-+    #----------------------------------------
-+    # Michael Brader <mbrader@stoic.com.au> June 2, 2000
-+    # We have a locking problem here.
-+    # If two copies of this are run at once you could see your entry reappear
-+    # Proposed solution (file locking):
-+
-+    # If we do a 'use Fcntl, we'll probably get the locking constants
-+    # defined, but for now:
-+
-+    # NB. hard to test
-+
-+    my $LOCK_EX = 2;
-+    my $LOCK_UN = 8;
-+
-+    my $smbPasswdFile = '/etc/samba/smbpasswd';
-+
-+    open( RDWR, "+<$smbPasswdFile" ) ||    # +< == fopen(path, "r+",...
-+      die "Cannot open file $smbPasswdFile: $!\n";
-+
-+    my $nolock = 1;
-+    my $attempts;
-+    for ( $attempts = 1 ; ( $attempts <= 5 && $nolock ) ; $attempts++ )
-+    {
-+        if ( flock( RDWR, $LOCK_EX ) )
-+        {
-+            $nolock = 0;
-+        }
-+        else
-+        {
-+            sleep $attempts;
-+        }
-+    }
-+
-+    $nolock && die "Could not get exclusive lock on $smbPasswdFile\n";
-+
-+    my $outputString = '';
-+    while (<RDWR>)
-+    {
-+        (/^$username:/) || ( $outputString .= $_ );
-+    }
-+
-+    # clear file and go to beginning
-+    truncate( RDWR, 0 ) || die "truncate failed";    # not 'strict' safe why???
-+    seek( RDWR, 0, 0 ) || die "seek failed";
-+    print RDWR $outputString;
-+    flock( RDWR, $LOCK_UN )
-+      || warn "Couldn't remove exclusive lock on $smbPasswdFile\n";
-+    close RDWR || die "close failed";
-+
-+    chmod 0600, $smbPasswdFile;
-+
-+    return 1;                                        # success
-+}
-+
-+=pod
-+
-+=head2 LdapPassword()
-+
-+Returns the LDAP password from the file C</etc/openldap/ldap.pw>.
-+If the file does not exist, a suitable password is created, stored
-+in the file, then returned to the caller.
-+
-+Returns undef if the password could not be generated/retrieved.
-+
-+=cut
-+
-+sub genLdapPassword ()
-+{
-+
-+    # Otherwise generate a suitable new password, store it in the
-+    # correct file, and return it to the caller.
-+
-+    use MIME::Base64 qw(encode_base64);
-+
-+    unless ( open( RANDOM, "/dev/urandom" ) )
-+    {
-+        warn "Could not open /dev/urandom: $!";
-+        return undef;
-+    }
-+
-+    my $buf = "not set";
-+
-+    # 57 bytes is a full line of Base64 coding, and contains
-+    # 456 bits of randomness - given a perfectly random /dev/urandom
-+    if ( read( RANDOM, $buf, 57 ) != 57 )
-+    {
-+        warn("Short read from /dev/urandom: $!");
-+        return undef;
-+    }
-+    close RANDOM;
-+
-+    my $umask    = umask 0077;
-+    my $password = encode_base64($buf, "");
-+
-+    unless ( open( WR, ">/etc/openldap/ldap.pw" ) )
-+    {
-+        warn "Could not write LDAP password file.\n";
-+        return undef;
-+    }
-+
-+    print WR "$password\n";
-+    close WR;
-+    umask $umask;
-+
-+    chmod 0600, "/etc/openldap/ldap.pw";
-+
-+    return $password;
-+}
-+
-+sub LdapPassword ()
-+{
-+
-+    # Read the password from the file /etc/openldap/ldap.pw if it
-+    # exists.
-+    if ( -f "/etc/openldap/ldap.pw" )
-+    {
-+        open( LDAPPW, "</etc/openldap/ldap.pw" )
-+          || die "Could not open LDAP password file.\n";
-+        my $password = <LDAPPW>;
-+        chomp $password;
-+        close LDAPPW;
-+        return $password;
-+    }
-+    else
-+    {
-+        return genLdapPassword();
-+    }
-+}
-+
-+=pod
-+
-+=head2 set_secret()
-+
-+Shortcut method to create and set a password property on a record without having to extract the record first.
-+
-+The password creation is based on an UID of 64 bits (Data::UUID). If the optional type option is passed, 
-+it will be used to create the record if it does not already exist. Otherwise, a default 'service' type 
-+will be used to create the record.
-+
-+The $DB is expected to be an already open esmith::DB object, so that an open DB in the caller can be re-used. 
-+Therefore in a migrate fragment you could just use $DB.
-+
-+         esmith::util::set_secret($DB, '$key','$property'[,type=>'$type']);
-+
-+For example in /etc/e-smith/db/configuration/migrate/90roundcube
-+     {
-+         esmith::util::set_secret($DB, 'foo','DbPassword',type=>'service');
-+     }
-+
-+The password will be generated to the property 'DbPassword' in the 'foo' key.
-+
-+If you want to change the database then you must open another esmith::DB objet
-+     {
-+         my $database = esmith::ConfigDB->open('accounts') or
-+                die esmith::DB->error;
-+         esmith::util::set_secret($database, 'foo','DbPassword',type=>'user');
-+     }
-+
-+=cut
-+
-+sub set_secret
-+
-+{
-+    my ($db, $key, $prop, %options) = @_;
-+    %options = (type => 'service', %options);
-+
-+    my $record = $db->get($key) ||
-+                 $db->new_record($key, \%options) or
-+                 die "Error creating new record";
-+
-+    return if $db->get_prop($key,$prop);
-+
-+    $record->merge_props(%options, $prop =>
-+       Data::UUID->new->create_b64());
-+}
-+
-+
-+
-+=pod
-+
-+=head1 HIGH LEVEL PASSWORD UTILITIES
-+
-+High-level password-changing utilities. These utilities
-+each change passwords for a single e-smith entity (system,
-+user or ibay). Each one works by calling the appropriate
-+low-level password changing utilities.
-+
-+=head2 setUnixSystemPassword($password)
-+
-+Set the e-smith system password
-+
-+=cut
-+
-+sub setUnixSystemPassword ($)
-+{
-+    my ($password) = @_;
-+
-+    setUnixPassword( "root",  $password );
-+    setUnixPassword( "admin", $password );
-+}
-+
-+=pod
-+
-+=head2 setServerSystemPassword($password)
-+
-+Set the samba administrator password.
-+
-+=cut
-+
-+sub setServerSystemPassword ($)
-+{
-+    my ($password) = @_;
-+
-+    setSambaPassword( "admin", $password );
-+}
-+
-+=pod
-+
-+=head2 setUserPassword($username, $password)
-+
-+Set e-smith user password
-+
-+=cut
-+
-+sub setUserPassword ($$)
-+{
-+    my ( $username, $password ) = @_;
-+
-+    setUnixPassword( $username, $password );
-+    setSambaPassword( $username, $password );
-+}
-+
-+=pod
-+
-+=head2 setUserPasswordRequirePrevious($username, $oldpassword, $newpassword)
-+
-+Set e-smith user password - require previous password
-+
-+=cut
-+
-+sub setUserPasswordRequirePrevious ($$$)
-+{
-+    my ( $username, $oldpassword, $newpassword ) = @_;
-+
-+    # We need to suid to the user, instead of root, so that PAM will
-+    # prompt us for the old password.
-+    my @pwent = getpwnam($username);
-+    return 0 unless ( $pwent[2] > 0 );    # uid must be non-zero
-+    my $uid = $<;
-+    $< = $pwent[2];
-+
-+    # Return if this function call fails, we didn't change passwords
-+    # successfully.
-+    my $ret =
-+      setUnixPasswordRequirePrevious( $username, $oldpassword, $newpassword );
-+    $< = $uid;
-+    return 0 unless $ret;
-+
-+    # if we get this far, the old password must have been valid
-+    setSambaPassword( $username, $newpassword );
-+}
-+
-+=pod
-+
-+=head2 cancelUserPassword
-+
-+Cancel user password. This is called when a user is deleted from the
-+system. We assume that the Unix "useradd/userdel" programs are
-+called separately. Since "userdel" automatically removes the
-+/etc/passwd entry, we only need to worry about the /etc/samba/smbpasswd
-+entry.
-+
-+=cut
-+
-+sub cancelUserPassword ($)
-+{
-+    my ($username) = @_;
-+
-+    cancelSambaPassword($username);
-+}
-+
-+=pod
-+
-+=head2 setIbayPassword($ibayname, $password)
-+
-+Set ibay password
-+
-+=cut
-+
-+sub setIbayPassword ($$)
-+{
-+    my ( $ibayname, $password ) = @_;
-+
-+    setUnixPassword( $ibayname, $password );
-+}
-+
-+=pod
-+
-+=head1 SERVICE MANAGEMENT UTILITIES
-+
-+=head2 serviceControl()
-+
-+Manage services - stop/start/restart/reload/graceful
-+
-+Returns 1 for success, 0 if something went wrong, fatal exception on bad
-+arguments.
-+
-+    serviceControl(
-+        NAME=>serviceName,
-+        ACTION=>start|stop|restart|reload|graceful
-+        [ BACKGROUND=>true|false (default is false) ]
-+    );
-+
-+EXAMPLE:
-+
-+    serviceControl( NAME=>'httpd-e-smith', ACTION=>'reload' );
-+
-+NOTES:
-+
-+The BACKGROUND parameter is optional and can be set to true if
-+start/stop/restart/etc. is to be done in the background (with
-+backgroundCommand()) rather than synchronously.
-+
-+CONVENTIONS:
-+
-+This command is the supported method for action scripts, blade handlers, etc.,
-+to start/stop/restart their services. Currently this is done via the rc7
-+symlinks, but this may change one day. Using this function gives us one
-+location to change this behaviour if desired, instead of hunting all over
-+every scrap of code. Please use it.
-+
-+=cut
-+
-+sub serviceControl
-+{
-+    my %params = @_;
-+
-+    my $serviceName = $params{NAME};
-+    unless ( defined $serviceName )
-+    {
-+        die "serviceControl: NAME must be specified";
-+    }
-+
-+    my $serviceAction = $params{ACTION};
-+    unless (defined $serviceAction)
-+    {
-+        die "serviceControl: ACTION must be specified";
-+    }
-+
-+    if ( $serviceAction =~ /^(start|stop|restart|reload|graceful|adjust|svdisable|reload-or-restart|try-restart|try-reload-or-restart|enable -now|sigterm|sighup|sigusr1|sigusr2)$/ )
-+    {
-+        my ($startScript) = glob("/etc/rc.d/rc7.d/S*$serviceName") ||'' ;
-+        my ($systemdScript) = "/usr/lib/systemd/system/$serviceName.service" ||'';
-+
-+        unless ( -e $startScript or -e $systemdScript)
-+        {
-+            warn "serviceControl: startScript not found "
-+              . "for service $serviceName\n";
-+            return 0;
-+        }
-+
-+        if (-e $systemdScript and ! -e $startScript){
-+	    # systemd is not aware of adjust, sigusr1, sigusr2, sigterm, sighup
-+	    $serviceAction = ( $serviceAction =~/^(adjust|graceful|sighup|sigusr1|sigusr2)$/ ) ? "reload" : $serviceAction; 
-+            $serviceAction = ( $serviceAction eq "sigterm" ) ? "restart" : $serviceAction;
-+            if ($serviceAction =~/^(start|stop|restart|reload|reload-or-restart|try-restart|try-reload-or-restart|enable -now)$/) {
-+                system('/usr/bin/systemctl',"$serviceAction","$serviceName.service") == '0'
-+                ||    warn "serviceControl: Couldn't " .
-+                "system( /usr/bin/systemctl $serviceAction $serviceName.service): $!\n";
-+            }
-+            else {
-+                die "serviceControl: systemd doesn't know : systemctl $serviceAction $serviceName.service";
-+            }
-+        }
-+
-+        elsif (-e $startScript) {
-+            my  $background = $params{'BACKGROUND'} || 'false';
-+
-+            die "serviceControl: Unknown serviceAction $serviceAction" if ($serviceAction =~/^(reload-or-restart|try-restart|try-reload-or-restart|enable -now|sigterm|sighup|sigusr1|sigusr2)$/);
-+            if ( $background eq 'true' )
-+            {
-+            backgroundCommand( 0, $startScript, $serviceAction );
-+            }
-+            elsif ( $background eq 'false' )
-+            {
-+                unless ( system( $startScript, $serviceAction ) == 0 )
-+                {
-+                warn "serviceControl: "
-+                  . "Couldn't system($startScript, $serviceAction): $!\n";
-+                return 0;
-+                }
-+           }
-+           else
-+           {
-+            die "serviceControl: Unsupported BACKGROUND=>$background";
-+           }
-+        }
-+    }
-+    else
-+    {
-+        die "serviceControl: Unknown serviceAction $serviceAction";
-+    }
-+    return 1;
-+}
-+
-+=head2 getLicenses()
-+
-+Return all available licenses
-+
-+In scalar context, returns one string combining all licenses
-+In array context, returns an array of individual licenses
-+
-+Optionally takes a language tag to be used for retrieving the licenses,
-+defaulting to the locale of the server.
-+
-+=for testing
-+$ENV{ESMITH_LICENSE_DIR} = "10e-smith-lib/licenses";
-+ok(-d $ENV{ESMITH_LICENSE_DIR}, "License dir for testing exists");
-+like($l = esmith::util::getLicenses("fr_CA"), qr/Je suis/, "Found french license");
-+like($l = esmith::util::getLicenses("en_US"), qr/I am/,    "Found english license");
-+
-+=cut
-+
-+sub getLicenses
-+{
-+    my ($locale) = @_;
-+
-+    if ($locale)
-+    {
-+        $locale =~ s/-(\S\S)/_\U$1/;
-+    }
-+    else
-+    {
-+        my $db = esmith::ConfigDB->open();
-+
-+        my ( $lang, @rest ) = $db->getLocale();
-+
-+        $lang = $lang || "en_US";
-+
-+        $locale = $lang;
-+    }
-+
-+    my $base_dir = $ENV{ESMITH_LICENSE_DIR} || "/etc/e-smith/licenses";
-+
-+    $locale = "en_US" unless ( -d "${base_dir}/${locale}" );
-+
-+    my $dir = "${base_dir}/${locale}";
-+
-+    my @licenses;
-+
-+    opendir( DIR, $dir ) || die "Couldn't open licenses directory\n";
-+
-+    foreach my $license ( readdir(DIR) )
-+    {
-+        my $file = "${dir}/${license}";
-+
-+        next unless ( -f $file );
-+
-+        open( LICENSE, $file ) || die "Couldn't open license $file\n";
-+
-+        push @licenses, <LICENSE>;
-+
-+        close LICENSE;
-+    }
-+
-+    return wantarray ? @licenses : "@licenses";
-+}
-+
-+=head2 getLicenseFile()
-+
-+Return the license filename.
-+
-+Optionally takes a language tag to be used for retrieving the license,
-+defaulting to the locale of the server.
-+
-+If more than one license file than return the first alphabetically.
-+
-+=cut
-+
-+sub getLicenseFile
-+{
-+    my ($locale) = @_;
-+
-+    if ($locale)
-+    {
-+        $locale =~ s/-(\S\S)/_\U$1/s;
-+    }
-+    else
-+    {
-+        my $db = esmith::ConfigDB->open();
-+
-+        my ( $lang, @rest ) = $db->getLocale();
-+
-+        $lang = $lang || 'en_US';
-+
-+        $locale = $lang;
-+    }
-+
-+    my $base_dir = $ENV{ESMITH_LICENSE_DIR} || '/etc/e-smith/licenses';
-+
-+    $locale = 'en_US' unless ( -d "${base_dir}/${locale}" );
-+
-+    my $dir = "${base_dir}/${locale}";
-+
-+    opendir( DIR, $dir ) || die "Couldn't open licenses directory\n";
-+
-+    my @licenses;
-+    foreach my $license ( readdir DIR )
-+    {
-+        untaint ($license);
-+        my $file = "${dir}/${license}";
-+        next unless ( -f $file );
-+        push @licenses, $file;
-+    }
-+
-+    @licenses = sort @licenses;
-+
-+    return shift @licenses;
-+}
-+
-+
-+=item B<initialize_default_databases>
-+
-+Initialize all databases located at /etc/e-smith/db.
-+
-+=cut
-+
-+sub initialize_default_databases
-+{
-+
-+    # Optionally take an argument to the db root, for testing purposes.
-+    my %defaults = (
-+        dbroot => '/etc/e-smith/db',
-+        dbhome => '/home/e-smith/db',
-+        old_dbhome => '/home/e-smith',
-+    );
-+    my %args   = ( %defaults, @_ );
-+    my $dbroot = $args{dbroot};
-+    my $dbhome = $args{dbhome};
-+    my $old_dbhome = $args{old_dbhome};
-+
-+    local *DH;
-+    opendir DH, $dbroot
-+      or die "Could not open $dbroot: $!";
-+
-+    my @dirs = readdir(DH);
-+
-+    # Move all databases to new home first them migrate data
-+    # Untaint db names while we are at it.
-+    foreach my $file ( map { /(.+)/ ; $1 } grep !/^\./, @dirs )
-+    {
-+        if (-f "${old_dbhome}/$file")
-+        {
-+            if (-l "${old_dbhome}/$file")
-+            {
-+                warn "symlink called ${old_dbhome}/$file exists\n";
-+		next;
-+            }
-+
-+            if (-s "${dbhome}/$file")
-+            {
-+                warn "${old_dbhome}/$file and ${dbhome}/$file exist\n";
-+                rename "${dbhome}/$file", "${dbhome}/$file." . time;
-+            }
-+
-+	    warn "Rename ${old_dbhome}/$file => ${dbhome}/$file\n";
-+	    rename "${old_dbhome}/$file", "${dbhome}/$file";
-+        }
-+    }
-+
-+    foreach my $file ( grep !/^\./, @dirs )
-+    {
-+        # Untaint the result of readdir. As we're expecting filenames like
-+        # 'configuration' and 'ipphones', lets restrict input to those.
-+        if ($file =~ /(^[A-Za-z0-9_\.-]+$)/)
-+        {
-+            $file = $1;
-+        }
-+        else
-+        {
-+	    warn "Not processing unexpected file $file\n";
-+            next;
-+        }
-+
-+        eval
-+        {
-+            my $h = esmith::ConfigDB->open($file);
-+            if ($h)
-+            {
-+                warn "Migrating existing database $file\n";
-+
-+                # Convert old data to new format, and add any new defaults. Note
-+                # that migrate returns FALSE on fatal errors. Report those to
-+                # syslog. The error should still be in $@.
-+                unless ( $h->migrate() )
-+                {
-+                    warn "Migration of db $file failed: " . esmith::DB->error;
-+                }
-+            }
-+            else
-+            {
-+                warn "Creating database $file and setting defaults\n";
-+
-+                # create() and load defaults
-+                unless ( $h = esmith::ConfigDB->create($file) )
-+                {
-+                    warn "Could not create $file db: " . esmith::DB->error;
-+                }
-+            }
-+
-+            $h->close;
-+
-+            esmith::util::chownFile( "root", "admin", "$dbhome/$file" );
-+        };
-+        if ($@)
-+        {
-+            warn "Fatal error while processing db $file: $@\n";
-+        }
-+    }
-+    return 1;
-+}
-+
-+
-+=head1 AUTHOR
-+
-+Mitel Networks Corp.
-+
-+For more information, see http://www.e-smith.org/
-+
-+=cut
-+
-+1;