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 } ; + 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 @@ -22,8 +22,9 @@ if [[ "$STATUS" != 'enabled' ]] then - echo "$SERVICE will not start (service status not enabled)" - exit 5 + echo "$SERVICE status not enabled in configuration db." + exit 0 + # change this one to 5 if you want systemd to fail on ExecStartPre 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 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 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 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 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 () + { + (/^$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. +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, "; + 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, ; + + 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 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;