/[smeserver]/rpms/e-smith-base/sme10/e-smith-base-5.8.0-bz11177-systemd.patch
ViewVC logotype

Diff of /rpms/e-smith-base/sme10/e-smith-base-5.8.0-bz11177-systemd.patch

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

Revision 1.1 by jpp, Tue Nov 17 02:56:00 2020 UTC Revision 1.2 by jpp, Tue Nov 17 16:57:45 2020 UTC
# Line 1  Line 1 
 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 => $_,  
 +               );  
 +       }  
 +    }  
 +}  
 +  
1  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  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
2  --- 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.old/root/sbin/e-smith/service-status     2020-11-16 01:04:00.182000000 -0500
3  +++ e-smith-base-5.8.0/root/sbin/e-smith/service-status 2020-11-16 21:55:20.898000000 -0500  +++ e-smith-base-5.8.0/root/sbin/e-smith/service-status 2020-11-16 21:55:20.898000000 -0500
# Line 163  diff -Nur e-smith-base-5.8.0.old/root/sb Line 13  diff -Nur e-smith-base-5.8.0.old/root/sb
13   fi   fi
14    
15   exit 0   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;  

Legend:
Removed lines/characters  
Changed lines/characters
  Added lines/characters
admin@koozali.org
 ViewVC Help
Powered by ViewVC 1.2.1 RSS 2.0 feed