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

Annotation 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


Revision 1.1 - (hide annotations) (download)
Tue Nov 17 02:56:00 2020 UTC (3 years, 11 months ago) by jpp
Branch: MAIN
CVS Tags: e-smith-base-5_8_0-52_el7_sme
* Mon Nov 16 2020 Jean-Philipe Pialasse <tests@pialasse.com> 5.8.0-52.sme
- allow more systemctl controls [SME: 11177]
  convert unrecognized signals from service2adjust in events for systemd
  handle unsupervised services the same way supervised were in adjust-services
  make service-status only log when service disabled and not fail it

1 jpp 1.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
2     --- e-smith-base-5.8.0.old/root/etc/e-smith/events/actions/adjust-services 1969-12-31 19:00:00.000000000 -0500
3     +++ e-smith-base-5.8.0/root/etc/e-smith/events/actions/adjust-services 2020-11-16 01:15:19.192000000 -0500
4     @@ -0,0 +1,146 @@
5     +#!/usr/bin/perl -w
6     +#----------------------------------------------------------------------
7     +# copyright (C) 2005 Mitel Networks Corporation
8     +#
9     +# This program is free software; you can redistribute it and/or modify
10     +# it under the terms of the GNU General Public License as published by
11     +# the Free Software Foundation; either version 2 of the License, or
12     +# (at your option) any later version.
13     +#
14     +# This program is distributed in the hope that it will be useful,
15     +# but WITHOUT ANY WARRANTY; without even the implied warranty of
16     +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17     +# GNU General Public License for more details.
18     +#
19     +# You should have received a copy of the GNU General Public License
20     +# along with this program; if not, write to the Free Software
21     +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22     +#
23     +#----------------------------------------------------------------------
24     +package esmith;
25     +
26     +use strict;
27     +use Errno;
28     +use DirHandle;
29     +
30     +my $event = shift || die "must give event name parameter";
31     +chdir "/etc/e-smith/events/$event" or die "Couldn't chdir to event directory /etc/e-smith/events/$event: $!";
32     +my $dh = DirHandle->new("services2adjust");
33     +
34     +exit(0) unless $dh; # Nothing to do
35     +
36     +use esmith::ConfigDB;
37     +use esmith::util;
38     +
39     +my %param2char = (
40     + down => 'd',
41     + stop => 'd',
42     + up => 'u',
43     + start => 'u',
44     + restart => 't',
45     + sigterm => 't',
46     + adjust => 'h',
47     + reload => 'h',
48     + sighup => 'h',
49     + sigusr1 => '1',
50     + sigusr2 => '2',
51     + once => 'o',
52     + pause => 'p',
53     + alarm => 'a',
54     + interrupt => 'i',
55     + quit => 'q',
56     + kill => 'k',
57     + exit => 'x',
58     + );
59     +
60     +sub adjust_supervised_service
61     +{
62     + my ($s, @actions) = @_;
63     + my $m = "control fifo for service $s: ";
64     + unless (open(C, ">/service/$s/supervise/control"))
65     + {
66     + warn "Couldn't open $m$!";
67     + return;
68     + }
69     + foreach my $p (@actions)
70     + {
71     + my $c = $param2char{$p};
72     + unless ($c)
73     + {
74     + warn "Unrecognised param $p for service $s\n";
75     + next;
76     + }
77     + warn "adjusting supervised $s ($p)\n";
78     + unless (print C $c)
79     + {
80     + warn "Couldn't write to $m$!";
81     + return;
82     + }
83     + }
84     + warn "Couldn't close $m$!" unless close(C);
85     +}
86     +
87     +my $conf = esmith::ConfigDB->open_ro || die "Couldn't open config db";
88     +
89     +foreach my $service (grep { !/^\./ } $dh->read())
90     +{
91     + my $s = $conf->get($service);
92     + unless ($s)
93     + {
94     + warn "No conf db entry for service $service\n";
95     + next;
96     + }
97     + my $f = "services2adjust/$service";
98     +
99     + my @actions;
100     + if (-l "$f")
101     + {
102     + @actions = ( readlink "$f" );
103     + }
104     + else
105     + {
106     + if (open(F, $f))
107     + {
108     + # Read list of actions from the file, and untaint
109     + @actions = map { chomp; /([a-z]+[12]?)/ ; $1 } <F>;
110     + close(F);
111     + }
112     + else
113     + {
114     + warn "Could not open $f: $!";
115     + }
116     + }
117     +
118     + # if service is supervised and not handled by systemd
119     + if (-d "/service/$service" && glob("/etc/rc7.d/S??$service"))
120     + {
121     + my $enabled = ($s->prop('status') || 'disabled') eq 'enabled';
122     + adjust_supervised_service($service,
123     + # stop the service if it is now disabled
124     + $enabled ? () : 'down',
125     + # Send the specified signal(s) to the running daemon
126     + @actions,
127     + # bring the service up if it is enabled (and we're not
128     + # stopping it or running it once)
129     + ($enabled && !grep { /^(down|stop|d|once|o)$/ } @actions) ? 'up' : (),
130     + );
131     + }
132     + # for service handled by former sysvinit or directly with systemd
133     + else
134     + {
135     + my $enabled = ($s->prop('status') || 'disabled') eq 'enabled';
136     + # stop the service if it is now disabled
137     + unshift(@actions,'stop') unless $enabled;
138     + # bring the service up if it is enabled (and we're not stopping it or running it once)
139     + push(@actions,'start') if ($enabled && !grep { /^(down|stop|d|once|o|start|restart|reload-or-restart)$/ } @actions) ;
140     + foreach (@actions)
141     + {
142     + warn "adjusting non-supervised $service ($_)\n";
143     + esmith::util::serviceControl(
144     + NAME => $service,
145     + ACTION => $_,
146     + );
147     + }
148     + }
149     +}
150     +
151     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
152     --- e-smith-base-5.8.0.old/root/sbin/e-smith/service-status 2020-11-16 01:04:00.182000000 -0500
153     +++ e-smith-base-5.8.0/root/sbin/e-smith/service-status 2020-11-16 21:55:20.898000000 -0500
154     @@ -22,8 +22,9 @@
155    
156     if [[ "$STATUS" != 'enabled' ]]
157     then
158     - echo "$SERVICE will not start (service status not enabled)"
159     - exit 5
160     + echo "$SERVICE status not enabled in configuration db."
161     + exit 0
162     + # change this one to 5 if you want systemd to fail on ExecStartPre
163     fi
164    
165     exit 0
166     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
167     --- e-smith-base-5.8.0.old/root/usr/share/perl5/vendor_perl/esmith/util.pm 1969-12-31 19:00:00.000000000 -0500
168     +++ e-smith-base-5.8.0/root/usr/share/perl5/vendor_perl/esmith/util.pm 2020-11-16 01:05:33.057000000 -0500
169     @@ -0,0 +1,1404 @@
170     +#----------------------------------------------------------------------
171     +# Copyright 1999-2003 Mitel Networks Corporation
172     +# This program is free software; you can redistribute it and/or
173     +# modify it under the same terms as Perl itself.
174     +#----------------------------------------------------------------------
175     +
176     +package esmith::util;
177     +
178     +use strict;
179     +
180     +use Text::Template 'fill_in_file';
181     +use POSIX qw (setsid);
182     +use Errno;
183     +use Carp;
184     +use esmith::config;
185     +use esmith::db;
186     +use esmith::DB;
187     +use esmith::ConfigDB;
188     +use Net::IPv4Addr qw(:all);
189     +use Taint::Util;
190     +use File::Basename;
191     +use File::stat;
192     +use FileHandle;
193     +use Data::UUID;
194     +=pod
195     +
196     +=head1 NAME
197     +
198     +esmith::util - Utilities for e-smith server and gateway development
199     +
200     +=head1 VERSION
201     +
202     +This file documents C<esmith::util> version B<1.4.0>
203     +
204     +=head1 SYNOPSIS
205     +
206     + use esmith::util;
207     +
208     +=head1 DESCRIPTION
209     +
210     +This module provides general utilities of use to developers of the
211     +e-smith server and gateway.
212     +
213     +=head1 GENERAL UTILITIES
214     +
215     +=head2 setRealToEffective()
216     +
217     +Sets the real UID to the effective UID and the real GID to the effective
218     +GID.
219     +
220     +=begin testing
221     +
222     +use_ok('esmith::util');
223     +
224     +=end testing
225     +
226     +=cut
227     +
228     +sub setRealToEffective ()
229     +{
230     + $< = $>;
231     + $( = $);
232     +}
233     +
234     +=pod
235     +
236     +=head2 processTemplate({ CONFREF => $conf, TEMPLATE_PATH => $path })
237     +
238     +B<Depreacted> interface to esmith::templates::processTemplate().
239     +
240     +=cut
241     +
242     +sub processTemplate
243     +{
244     + require esmith::templates;
245     + goto &esmith::templates::processTemplate;
246     +}
247     +
248     +#------------------------------------------------------------
249     +
250     +=pod
251     +
252     +=head2 chownfile($user, $group, $file)
253     +
254     +This routine changes the ownership of a file, automatically converting
255     +usernames and groupnames to UIDs and GIDs respectively.
256     +
257     +=cut
258     +
259     +sub chownFile ($$$)
260     +{
261     + my ( $user, $group, $file ) = @_;
262     +
263     + unless ( -e $file )
264     + {
265     + warn("can't chownFile $file: $!\n");
266     + return;
267     + }
268     + my $uid = defined $user ? getpwnam($user) : stat($file)->uid;
269     + my $gid = defined $group ? getgrnam($group) : stat($file)->gid;
270     +
271     + chown( $uid, $gid, $file );
272     +}
273     +
274     +=pod
275     +
276     +=head2 determineRelease()
277     +
278     +Returns the current release version of the software.
279     +
280     +=cut
281     +
282     +sub determineRelease()
283     +{
284     + my $unknown = "(unknown version)";
285     +
286     + my $db = esmith::ConfigDB->open() or return $unknown;
287     +
288     + my $sysconfig = $db->get("sysconfig") or return $unknown;
289     +
290     + my $release = $sysconfig->prop("ReleaseVersion") || $unknown;
291     +
292     + return $release;
293     +}
294     +
295     +=pod
296     +
297     +=head1 NETWORK ADDRESS TRANSLATION UTILITIES
298     +
299     +=head2 IPquadToAddr($ip)
300     +
301     +Convert IP address from "xxx.xxx.xxx.xxx" notation to a 32-bit
302     +integer.
303     +
304     +=cut
305     +
306     +sub IPquadToAddr ($)
307     +{
308     + my ($quad) = @_;
309     + return 0 unless defined $quad;
310     + if ( $quad =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ )
311     + {
312     + return ( $1 << 24 ) + ( $2 << 16 ) + ( $3 << 8 ) + $4;
313     + }
314     + return 0;
315     +}
316     +
317     +=pod
318     +
319     +=head2 IPaddrToQuad($address)
320     +
321     +Convert IP address from a 32-bit integer to "xxx.xxx.xxx.xxx"
322     +notation.
323     +
324     +=cut
325     +
326     +sub IPaddrToQuad ($)
327     +{
328     + my ($addrBits) = @_;
329     + return sprintf( "%d.%d.%d.%d",
330     + ( $addrBits >> 24 ) & 0xff,
331     + ( $addrBits >> 16 ) & 0xff,
332     + ( $addrBits >> 8 ) & 0xff,
333     + $addrBits & 0xff );
334     +}
335     +
336     +=pod
337     +
338     +=head2 IPaddrToBackwardQuad($address)
339     +
340     +Convert IP address from a 32-bit integer to reversed
341     +"xxx.xxx.xxx.xxx.in-addr.arpa" notation for BIND files.
342     +
343     +=cut
344     +
345     +sub IPaddrToBackwardQuad ($)
346     +{
347     + my ($addrBits) = @_;
348     + return sprintf(
349     + "%d.%d.%d.%d.in-addr.arpa.",
350     + $addrBits & 0xff,
351     + ( $addrBits >> 8 ) & 0xff,
352     + ( $addrBits >> 16 ) & 0xff,
353     + ( $addrBits >> 24 ) & 0xff
354     + );
355     +}
356     +
357     +=pod
358     +
359     +=head2 computeNetworkAndBroadcast($ipaddr, $netmask)
360     +
361     +Given an IP address and netmask (both in "xxx.xxx.xxx.xxx" format)
362     +compute the network and broadcast addresses and output them in the
363     +same format.
364     +
365     +=cut
366     +
367     +sub computeNetworkAndBroadcast ($$)
368     +{
369     + my ( $ipaddr, $netmask ) = @_;
370     +
371     + my ( $network, $msk ) = ipv4_network( $ipaddr, $netmask );
372     + my $broadcast = ipv4_broadcast( $ipaddr, $netmask );
373     +
374     + return ( $network, $broadcast );
375     +}
376     +
377     +=pod
378     +
379     +=head2 computeLocalNetworkPrefix($ipaddr, $netmask)
380     +
381     +Given an IP address and netmask, the computeLocalNetworkPrefix
382     +function computes the network prefix for local machines.
383     +
384     +i.e. for an IP address of 192.168.8.4 and netmask of 255.255.255.0,
385     +this function will return "192.168.8.".
386     +
387     +This string is suitable for use in configuration files (such as
388     +/etc/proftpd.conf) when the more precise notation
389     +
390     + xxx.xxx.xxx.xxx/yyy.yyy.yyy.yyy
391     +
392     +is not supported.
393     +
394     +=cut
395     +
396     +sub computeLocalNetworkPrefix ($$)
397     +{
398     + my ( $ipaddr, $netmask ) = @_;
399     +
400     + my ( $net, $msk ) = ipv4_network( $ipaddr, $netmask );
401     + $net =~ s/(\d{1,3}\.\d{1,3}\.\d{1,3}\.)(\d{1,3})/$1/;
402     +
403     + return $net;
404     +}
405     +
406     +=pod
407     +
408     +=head2 computeAllLocalNetworkPrefixes ($ipaddress, $netmask)
409     +
410     + Given an IP address and netmask, the computeAllLocalNetworkPrefixes
411     + function computes the network prefix or list of prefixes that
412     + fully describe the network to which the IP address belongs.
413     +
414     + examples:
415     +
416     + - for an IP address of 192.168.8.4 and netmask of 255.255.255.0,
417     + will return an array with a first (and only) element of "192.168.8".
418     +
419     + - for an IP address of 192.168.8.4 and netmask of 255.255.254.0,
420     + will return the array [ '192.168.8', '192.168.9' ].
421     +
422     + This array is suitable for use in configuration of tools such as
423     + djbdns where other network notations are not supported.
424     +
425     +=begin testing
426     +
427     +is_deeply(
428     + [esmith::util::computeAllLocalNetworkPrefixes("192.168.8.4",
429     + "255.255.254.0")],
430     + ['192.168.8', '192.168.9' ],
431     + "/23 network"
432     + );
433     +
434     +is_deeply(
435     + [esmith::util::computeAllLocalNetworkPrefixes("192.168.8.4",
436     + "255.255.255.255")],
437     + ['192.168.8.4'],
438     + "/32 network"
439     + );
440     +
441     +is_deeply(
442     + [esmith::util::computeAllLocalNetworkPrefixes("192.168.8.4",
443     + "255.255.255.0")],
444     + ['192.168.8'],
445     + "/24 network"
446     + );
447     +
448     +=end testing
449     +
450     +=cut
451     +
452     +sub computeAllLocalNetworkPrefixes
453     +{
454     + my ( $ipaddr, $netmask ) = @_;
455     +
456     + my $ipaddrBits = IPquadToAddr($ipaddr);
457     + my $netmaskBits = IPquadToAddr($netmask);
458     + my $networkBits = $ipaddrBits & $netmaskBits;
459     +
460     + # first, calculate the prefix (/??) given the netmask
461     + my $len = 0;
462     + for ( my $bits = $netmaskBits ; $bits & 0xFFFFFFFF ; $bits <<= 1 )
463     + {
464     + $len++;
465     + }
466     +
467     + # Here's where the magic starts...
468     + #
469     + # next, calculate the number of networks we expect to generate and
470     + # the incrementing value for each network.
471     + my $number_of_nets = 1 << ( ( 32 - $len ) % 8 );
472     + my $one_net = 1 << ( 3 - ( int $len / 8 ) ) * 8;
473     + my @networks;
474     + while ( $number_of_nets-- )
475     + {
476     + my $network = IPaddrToQuad($networkBits);
477     +
478     + # we want to strip off the trailing ``.0'' for /24 or larger networks
479     + if ( $len <= 24 )
480     + {
481     + $network =~ s/\.0$//;
482     + }
483     +
484     + # we want to continue to strip off trailing ``.0'', one more for
485     + # /9 to /16, two more for /1 to /8
486     + $network =~ s/\.0$// if ( $len <= 16 );
487     + $network =~ s/\.0$// if ( $len <= 8 );
488     +
489     + # push the resulting network into an array that we'll return;
490     + push @networks, $network;
491     +
492     + # increment the network by ``one'', relative to the size of networks
493     + # we're dealing with
494     + $networkBits += $one_net;
495     + }
496     + return (@networks);
497     +}
498     +
499     +=pod
500     +
501     +=head2 computeLocalNetworkShortSpec($ipaddr, $netmask)
502     +
503     +Given an IP address and netmask, the computeLocalNetworkShortSpec
504     +function computes a valid xxx.xxx.xxx.xxx/yyy specifier where yyy
505     +is the number of bits specifying the network.
506     +
507     +i.e. for an IP address of 192.168.8.4 and netmask of 255.255.255.0,
508     +this function will return "192.168.8.0/24".
509     +
510     +This string is suitable for use in configuration files (such as
511     +/etc/proftpd.conf) when the more precise notation
512     +
513     + xxx.xxx.xxx.xxx/yyy.yyy.yyy.yyy
514     +
515     +is not supported.
516     +
517     +=cut
518     +
519     +sub computeLocalNetworkShortSpec ($$)
520     +{
521     + my ( $ipaddr, $netmask ) = @_;
522     + my ( $net, $mask ) = ipv4_network( $ipaddr, $netmask );
523     + return "$net/$mask";
524     +}
525     +
526     +=pod
527     +
528     +=head2 computeLocalNetworkSpec($ipaddr, $netmask)
529     +
530     +Given an IP address and netmask, the computeLocalNetworkSpec function
531     +computes a valid xxx.xxx.xxx.xxx/yyy.yyy.yyy.yyy specifier.
532     +
533     +=cut
534     +
535     +sub computeLocalNetworkSpec ($$)
536     +{
537     + my ( $ipaddr, $netmask ) = @_;
538     + my ( $net, $mask ) = ipv4_network( $ipaddr, $netmask );
539     + $mask = ipv4_cidr2msk($mask);
540     + return "$net/$mask";
541     +}
542     +
543     +=pod
544     +
545     +=head2 computeNetmaskFromBits ($bits)
546     +
547     +Given a number of bits of network address, calculate the appropriate
548     +netmask.
549     +
550     +=cut
551     +
552     +sub computeNetmaskFromBits ($)
553     +{
554     + my ($ones) = @_;
555     +
556     + return ipv4_cidr2msk($ones);
557     +}
558     +
559     +=pod
560     +
561     +=head2 computeLocalNetworkReversed($ipaddr, $netmask)
562     +
563     +Given an IP address and netmask, the computeLocalNetworkReversed
564     +function computes the appropriate DNS domain field.
565     +
566     +NOTE: The return value is aligned to the next available byte boundary, i.e.
567     +
568     + 192.168.8.4/255.255.255.0 returns "8.168.192.in-addr.arpa."
569     + 192.168.8.4/255.255.252.0 returns "168.192.in-addr.arpa."
570     + 192.168.8.4/255.255.0.0 returns "168.192.in-addr.arpa."
571     + 192.168.8.4/255.252.0.0 returns "192.in-addr.arpa."
572     + 192.168.8.4/255.0.0.0 returns "192.in-addr.arpa."
573     +
574     +This string is suitable for use in BIND configuration files.
575     +
576     +=cut
577     +
578     +sub computeLocalNetworkReversed ($$)
579     +{
580     + my ( $ipaddr, $netmask ) = @_;
581     +
582     + my @addressBytes = split ( /\./, $ipaddr );
583     + my @maskBytes = split ( /\./, $netmask );
584     +
585     + my @result;
586     +
587     + push ( @result, "in-addr.arpa." );
588     +
589     + foreach (@maskBytes)
590     + {
591     + last unless ( $_ eq "255" );
592     +
593     + unshift ( @result, shift (@addressBytes) );
594     + }
595     +
596     + return join ( '.', @result );
597     +}
598     +
599     +=pod
600     +
601     +=head2 computeHostRange($ipaddr, $netmask)
602     +
603     +Given a network specification (IP address and netmask), compute
604     +the total number of hosts in that network, as well as the first
605     +and last IP addresses in the range.
606     +
607     +=cut
608     +
609     +sub computeHostRange ($$)
610     +{
611     + my ( $ipaddr, $netmask ) = @_;
612     +
613     + my $ipaddrBits = IPquadToAddr($ipaddr);
614     + my $netmaskBits = IPquadToAddr($netmask);
615     + my $hostmaskBits = ( ( ~$netmaskBits ) & 0xffffffff );
616     +
617     + my $firstAddrBits = $ipaddrBits & $netmaskBits;
618     + my $lastAddrBits = $ipaddrBits | $hostmaskBits;
619     +
620     + my $totalHosts = 1;
621     +
622     + for ( ; $hostmaskBits ; $hostmaskBits /= 2 )
623     + {
624     + if ( ( $hostmaskBits & 0x1 ) == 0x1 )
625     + {
626     + $totalHosts *= 2;
627     + }
628     + }
629     +
630     + return ( $totalHosts, IPaddrToQuad($firstAddrBits),
631     + IPaddrToQuad($lastAddrBits) );
632     +}
633     +
634     +=pod
635     +
636     +=head2 ldapBase($domain)
637     +
638     +Given a domain name such as foo.bar.com, generate the
639     +LDAP base name "dc=foo,dc=bar,dc=com".
640     +
641     +=cut
642     +
643     +sub ldapBase ($)
644     +{
645     + my ($domainName) = @_;
646     + $domainName =~ s/\./,dc=/g;
647     + return "dc=" . $domainName;
648     +}
649     +
650     +=pod
651     +
652     +=head2 backgroundCommand($delaySec, @command)
653     +
654     +Run command in background after a specified delay.
655     +
656     +=cut
657     +
658     +sub backgroundCommand ($@)
659     +{
660     + my ( $delaySec, @command ) = @_;
661     +
662     + # now would be a good time to flush output buffers, so the partial
663     + # buffers don't get copied
664     +
665     + $| = 1;
666     + print "";
667     +
668     + # create child process
669     + my $pid = fork;
670     +
671     + # if fork failed, bail out
672     + die "Cannot fork: $!" unless defined($pid);
673     +
674     + # If fork succeeded, make parent process return immediately.
675     + # We are not waiting on the child, so it will become a zombie
676     + # process when it completes. However, this subroutine is only
677     + # intended for use by the e-smith signal-event program, which
678     + # doesn't run very long. Once the parent terminates, the zombie
679     + # will become owned by "init" and will be reaped automatically.
680     +
681     + return if ($pid);
682     +
683     + # detach ourselves from the terminal
684     + setsid || die "Cannot start a new session: $!";
685     +
686     + # change working directory
687     + chdir "/";
688     +
689     + # clear file creation mask
690     + umask 0;
691     +
692     + # close STDIN, STDOUT, and STDERR
693     + close STDIN;
694     + close STDOUT;
695     + close STDERR;
696     +
697     + # reopen stderr, stdout, stdin
698     + open( STDIN, '/dev/null' );
699     +
700     + my $loggerPid = open( STDOUT, "|-" );
701     + die "Can't fork: $!\n" unless defined $loggerPid;
702     +
703     + unless ($loggerPid)
704     + {
705     + exec qw(/usr/bin/logger -p local1.info -t e-smith-bg);
706     + }
707     +
708     + open( STDERR, '>&STDOUT' );
709     +
710     + # make child wait for specified delay.
711     + sleep $delaySec;
712     +
713     + # execute command
714     + exec { $command[0] } @command or warn "Can't @command : $!\n";
715     +}
716     +
717     +=pod
718     +
719     +=head1 PASSWORD UTILITIES
720     +
721     +Low-level password-changing utilities. These utilities each
722     +change passwords for a single underlying password database,
723     +for example /etc/passwd, /etc/samba/smbpasswd, etc.
724     +
725     +=head2 validatePassword($password, $strength)
726     +
727     +Validate Unix password.
728     +
729     +=cut
730     +
731     +sub validatePassword($$)
732     +{
733     + my ( $password, $strength ) = @_;
734     + use Crypt::Cracklib;
735     +
736     + $strength ||= 'normal';
737     +
738     + my $reason = 'ok';
739     + $reason = 'it is too short' unless (length($password) > 6);
740     + return $reason if ($reason ne 'ok' || $strength eq 'none');
741     +
742     + $reason = 'it does not contain numbers' if (not $password =~ /\d/);
743     + $reason = 'it does not contain uppercase characters' if (not $password =~ /[A-Z]/);
744     + $reason = 'it does not contain lowercase characters' if (not $password =~ /[a-z]/);
745     + $reason = 'it does not contain special characters' if (not $password =~ /\W|_/);
746     + return $reason if ($reason ne 'ok' && $strength eq 'strong');
747     +
748     + if ( -f '/usr/lib64/cracklib_dict.pwd' ) {
749     + $reason = fascist_check($password, '/usr/lib64/cracklib_dict');
750     + } else {
751     + $reason = fascist_check($password, '/usr/lib/cracklib_dict');
752     + }
753     + $reason ||= 'the password check failed';
754     +
755     + return 'ok' if (lc($reason) eq 'ok');
756     + return $reason;
757     +}
758     +
759     +=pod
760     +
761     +=head2 setUnixPassword($username, $password)
762     +
763     +Set Unix password
764     +
765     +=cut
766     +
767     +sub setUnixPassword($$)
768     +{
769     + my ( $username, $password ) = @_;
770     + setUnixPasswordRequirePrevious( $username, undef, $password );
771     +}
772     +
773     +=pod
774     +
775     +=head2 authenticateUnixPassword ($username, $password)
776     +
777     +Check if the given username/password pair is correct.
778     +Return 1 if they are correct, return 0 otherwise.
779     +
780     +=cut
781     +
782     +sub authenticateUnixPassword ($$)
783     +{
784     + my ( $username, $password ) = @_;
785     +
786     + my $pam_auth_func = sub {
787     + return ( PAM_SUCCESS(), $password, PAM_SUCCESS() );
788     + };
789     + my $pamh = new Authen::PAM( 'passwd', $username, $pam_auth_func );
790     +
791     + unless ( ref($pamh) )
792     + {
793     + warn "WARN: Couldn't open Authen::PAM handle for user $username";
794     + return 0;
795     + }
796     + my $res = $pamh->pam_authenticate();
797     + return ( $res == PAM_SUCCESS() ) || 0;
798     +}
799     +
800     +=pod
801     +
802     +=head2 setUnixPasswordRequirePrevious($username, $oldpassword, $newpassword)
803     +
804     +Set Unix password but require previous password for authentication.
805     +
806     +=cut
807     +
808     +# setUnixPasswordRequirePrevious is left as an exercise for the reader :-)
809     +sub setUnixPasswordRequirePrevious ($$$)
810     +{
811     + my ( $username, $oldpassword, $newpassword ) = @_;
812     + use Authen::PAM;
813     + my $state;
814     +
815     + my $my_conv_func = sub {
816     + my @res;
817     + while (@_)
818     + {
819     + my $code = shift;
820     + my $msg = shift;
821     + my $ans = "";
822     +
823     + $ans = $username if ( $code == PAM_PROMPT_ECHO_ON() );
824     + if ( $code == PAM_PROMPT_ECHO_OFF() )
825     + {
826     + if ( $< == 0 || $state >= 1 )
827     + {
828     + # are we asked for a new password
829     + $ans = $newpassword;
830     + }
831     + else
832     + {
833     + # asked for old password before we can set a new one.
834     + $ans = $oldpassword;
835     + }
836     + $state++;
837     + }
838     +
839     + #print("code is $code, ans is $ans, msg is $msg, state is $state\n");
840     + push @res, ( PAM_SUCCESS(), $ans );
841     + }
842     + push @res, PAM_SUCCESS();
843     + return @res;
844     + };
845     +
846     + my $pamh = new Authen::PAM( "passwd", $username, $my_conv_func );
847     + unless ( ref($pamh) )
848     + {
849     + warn "Autopasswd: error code $pamh during PAM init!";
850     + warn "Failed to set Unix password for account $username.\n";
851     + return 0;
852     + }
853     +
854     + # Require the old password to be correct before proceeding to set a new
855     + # one.
856     + # This does that, except if you're already root, such as from the
857     + # bootstrap-console
858     + $state = 0;
859     + unless ( $< == 0 or $pamh->pam_authenticate == 0 )
860     + {
861     + warn
862     +"PAM authentication failed for user \"$username\", old password invalid!\n";
863     + return 0;
864     + }
865     +
866     + $state = 0;
867     + my $res = $pamh->pam_chauthtok;
868     + unless ( $res == PAM_SUCCESS() )
869     + {
870     + my $err = $pamh->pam_strerror($res);
871     + warn "Failed to set Unix password for account $username: $err\n";
872     + return 0;
873     + }
874     + return 1; # success
875     +}
876     +
877     +=pod
878     +
879     +=head2 setSambaPassword($username, $password)
880     +
881     +Set Samba password
882     +
883     +=cut
884     +
885     +sub setSambaPassword ($$)
886     +{
887     + my ( $username, $password ) = @_;
888     +
889     + #----------------------------------------
890     + # then set the password
891     + #----------------------------------------
892     +
893     + my $smbPasswdProg = '/usr/bin/smbpasswd';
894     +
895     + # see perldoc perlipc (search for 'Safe Pipe Opens')
896     + my $pid = open( DISCARD, "|-" );
897     +
898     + if ($pid) # parent
899     + {
900     + print DISCARD "$password\n$password\n";
901     + close(DISCARD) || die "Child exited early.";
902     + }
903     + else # child
904     + {
905     + my $retval = system("$smbPasswdProg -a -s $username >/dev/null");
906     + ( $retval / 256 )
907     + && die "Failed to set Samba password for account $username.\n";
908     + exit 0;
909     + }
910     + # Now we enable the account
911     + return system("$smbPasswdProg -e $username >/dev/null") ? 0 : 1;
912     +}
913     +
914     +=pod
915     +
916     +=head2 cancelSambaPassword($username)
917     +
918     +Cancel Samba password
919     +
920     +=cut
921     +
922     +sub cancelSambaPassword ($)
923     +{
924     + my ($username) = @_;
925     +
926     + #----------------------------------------
927     + # Gordon Rowell <gordonr@e-smith.com> June 7, 2000
928     + # We really should maintain old users, which would mean we can just use
929     + # smbpasswd -d, but the current policy is to remove them. If we are
930     + # doing that (see below), there is no need to disable them first.
931     + #----------------------------------------
932     + # my $discard = `/usr/bin/smbpasswd -d -s $username`;
933     + # if ($? != 0)
934     + # {
935     + # die "Failed to disable Samba account $username.\n";
936     + # }
937     +
938     + #----------------------------------------
939     + # Delete the smbpasswd entry. If we don't, re-adding the same
940     + # username will result in a mismatch of UIDs between /etc/passwd
941     + # and /etc/smbpasswd
942     + #----------------------------------------
943     + # Michael Brader <mbrader@stoic.com.au> June 2, 2000
944     + # We have a locking problem here.
945     + # If two copies of this are run at once you could see your entry reappear
946     + # Proposed solution (file locking):
947     +
948     + # If we do a 'use Fcntl, we'll probably get the locking constants
949     + # defined, but for now:
950     +
951     + # NB. hard to test
952     +
953     + my $LOCK_EX = 2;
954     + my $LOCK_UN = 8;
955     +
956     + my $smbPasswdFile = '/etc/samba/smbpasswd';
957     +
958     + open( RDWR, "+<$smbPasswdFile" ) || # +< == fopen(path, "r+",...
959     + die "Cannot open file $smbPasswdFile: $!\n";
960     +
961     + my $nolock = 1;
962     + my $attempts;
963     + for ( $attempts = 1 ; ( $attempts <= 5 && $nolock ) ; $attempts++ )
964     + {
965     + if ( flock( RDWR, $LOCK_EX ) )
966     + {
967     + $nolock = 0;
968     + }
969     + else
970     + {
971     + sleep $attempts;
972     + }
973     + }
974     +
975     + $nolock && die "Could not get exclusive lock on $smbPasswdFile\n";
976     +
977     + my $outputString = '';
978     + while (<RDWR>)
979     + {
980     + (/^$username:/) || ( $outputString .= $_ );
981     + }
982     +
983     + # clear file and go to beginning
984     + truncate( RDWR, 0 ) || die "truncate failed"; # not 'strict' safe why???
985     + seek( RDWR, 0, 0 ) || die "seek failed";
986     + print RDWR $outputString;
987     + flock( RDWR, $LOCK_UN )
988     + || warn "Couldn't remove exclusive lock on $smbPasswdFile\n";
989     + close RDWR || die "close failed";
990     +
991     + chmod 0600, $smbPasswdFile;
992     +
993     + return 1; # success
994     +}
995     +
996     +=pod
997     +
998     +=head2 LdapPassword()
999     +
1000     +Returns the LDAP password from the file C</etc/openldap/ldap.pw>.
1001     +If the file does not exist, a suitable password is created, stored
1002     +in the file, then returned to the caller.
1003     +
1004     +Returns undef if the password could not be generated/retrieved.
1005     +
1006     +=cut
1007     +
1008     +sub genLdapPassword ()
1009     +{
1010     +
1011     + # Otherwise generate a suitable new password, store it in the
1012     + # correct file, and return it to the caller.
1013     +
1014     + use MIME::Base64 qw(encode_base64);
1015     +
1016     + unless ( open( RANDOM, "/dev/urandom" ) )
1017     + {
1018     + warn "Could not open /dev/urandom: $!";
1019     + return undef;
1020     + }
1021     +
1022     + my $buf = "not set";
1023     +
1024     + # 57 bytes is a full line of Base64 coding, and contains
1025     + # 456 bits of randomness - given a perfectly random /dev/urandom
1026     + if ( read( RANDOM, $buf, 57 ) != 57 )
1027     + {
1028     + warn("Short read from /dev/urandom: $!");
1029     + return undef;
1030     + }
1031     + close RANDOM;
1032     +
1033     + my $umask = umask 0077;
1034     + my $password = encode_base64($buf, "");
1035     +
1036     + unless ( open( WR, ">/etc/openldap/ldap.pw" ) )
1037     + {
1038     + warn "Could not write LDAP password file.\n";
1039     + return undef;
1040     + }
1041     +
1042     + print WR "$password\n";
1043     + close WR;
1044     + umask $umask;
1045     +
1046     + chmod 0600, "/etc/openldap/ldap.pw";
1047     +
1048     + return $password;
1049     +}
1050     +
1051     +sub LdapPassword ()
1052     +{
1053     +
1054     + # Read the password from the file /etc/openldap/ldap.pw if it
1055     + # exists.
1056     + if ( -f "/etc/openldap/ldap.pw" )
1057     + {
1058     + open( LDAPPW, "</etc/openldap/ldap.pw" )
1059     + || die "Could not open LDAP password file.\n";
1060     + my $password = <LDAPPW>;
1061     + chomp $password;
1062     + close LDAPPW;
1063     + return $password;
1064     + }
1065     + else
1066     + {
1067     + return genLdapPassword();
1068     + }
1069     +}
1070     +
1071     +=pod
1072     +
1073     +=head2 set_secret()
1074     +
1075     +Shortcut method to create and set a password property on a record without having to extract the record first.
1076     +
1077     +The password creation is based on an UID of 64 bits (Data::UUID). If the optional type option is passed,
1078     +it will be used to create the record if it does not already exist. Otherwise, a default 'service' type
1079     +will be used to create the record.
1080     +
1081     +The $DB is expected to be an already open esmith::DB object, so that an open DB in the caller can be re-used.
1082     +Therefore in a migrate fragment you could just use $DB.
1083     +
1084     + esmith::util::set_secret($DB, '$key','$property'[,type=>'$type']);
1085     +
1086     +For example in /etc/e-smith/db/configuration/migrate/90roundcube
1087     + {
1088     + esmith::util::set_secret($DB, 'foo','DbPassword',type=>'service');
1089     + }
1090     +
1091     +The password will be generated to the property 'DbPassword' in the 'foo' key.
1092     +
1093     +If you want to change the database then you must open another esmith::DB objet
1094     + {
1095     + my $database = esmith::ConfigDB->open('accounts') or
1096     + die esmith::DB->error;
1097     + esmith::util::set_secret($database, 'foo','DbPassword',type=>'user');
1098     + }
1099     +
1100     +=cut
1101     +
1102     +sub set_secret
1103     +
1104     +{
1105     + my ($db, $key, $prop, %options) = @_;
1106     + %options = (type => 'service', %options);
1107     +
1108     + my $record = $db->get($key) ||
1109     + $db->new_record($key, \%options) or
1110     + die "Error creating new record";
1111     +
1112     + return if $db->get_prop($key,$prop);
1113     +
1114     + $record->merge_props(%options, $prop =>
1115     + Data::UUID->new->create_b64());
1116     +}
1117     +
1118     +
1119     +
1120     +=pod
1121     +
1122     +=head1 HIGH LEVEL PASSWORD UTILITIES
1123     +
1124     +High-level password-changing utilities. These utilities
1125     +each change passwords for a single e-smith entity (system,
1126     +user or ibay). Each one works by calling the appropriate
1127     +low-level password changing utilities.
1128     +
1129     +=head2 setUnixSystemPassword($password)
1130     +
1131     +Set the e-smith system password
1132     +
1133     +=cut
1134     +
1135     +sub setUnixSystemPassword ($)
1136     +{
1137     + my ($password) = @_;
1138     +
1139     + setUnixPassword( "root", $password );
1140     + setUnixPassword( "admin", $password );
1141     +}
1142     +
1143     +=pod
1144     +
1145     +=head2 setServerSystemPassword($password)
1146     +
1147     +Set the samba administrator password.
1148     +
1149     +=cut
1150     +
1151     +sub setServerSystemPassword ($)
1152     +{
1153     + my ($password) = @_;
1154     +
1155     + setSambaPassword( "admin", $password );
1156     +}
1157     +
1158     +=pod
1159     +
1160     +=head2 setUserPassword($username, $password)
1161     +
1162     +Set e-smith user password
1163     +
1164     +=cut
1165     +
1166     +sub setUserPassword ($$)
1167     +{
1168     + my ( $username, $password ) = @_;
1169     +
1170     + setUnixPassword( $username, $password );
1171     + setSambaPassword( $username, $password );
1172     +}
1173     +
1174     +=pod
1175     +
1176     +=head2 setUserPasswordRequirePrevious($username, $oldpassword, $newpassword)
1177     +
1178     +Set e-smith user password - require previous password
1179     +
1180     +=cut
1181     +
1182     +sub setUserPasswordRequirePrevious ($$$)
1183     +{
1184     + my ( $username, $oldpassword, $newpassword ) = @_;
1185     +
1186     + # We need to suid to the user, instead of root, so that PAM will
1187     + # prompt us for the old password.
1188     + my @pwent = getpwnam($username);
1189     + return 0 unless ( $pwent[2] > 0 ); # uid must be non-zero
1190     + my $uid = $<;
1191     + $< = $pwent[2];
1192     +
1193     + # Return if this function call fails, we didn't change passwords
1194     + # successfully.
1195     + my $ret =
1196     + setUnixPasswordRequirePrevious( $username, $oldpassword, $newpassword );
1197     + $< = $uid;
1198     + return 0 unless $ret;
1199     +
1200     + # if we get this far, the old password must have been valid
1201     + setSambaPassword( $username, $newpassword );
1202     +}
1203     +
1204     +=pod
1205     +
1206     +=head2 cancelUserPassword
1207     +
1208     +Cancel user password. This is called when a user is deleted from the
1209     +system. We assume that the Unix "useradd/userdel" programs are
1210     +called separately. Since "userdel" automatically removes the
1211     +/etc/passwd entry, we only need to worry about the /etc/samba/smbpasswd
1212     +entry.
1213     +
1214     +=cut
1215     +
1216     +sub cancelUserPassword ($)
1217     +{
1218     + my ($username) = @_;
1219     +
1220     + cancelSambaPassword($username);
1221     +}
1222     +
1223     +=pod
1224     +
1225     +=head2 setIbayPassword($ibayname, $password)
1226     +
1227     +Set ibay password
1228     +
1229     +=cut
1230     +
1231     +sub setIbayPassword ($$)
1232     +{
1233     + my ( $ibayname, $password ) = @_;
1234     +
1235     + setUnixPassword( $ibayname, $password );
1236     +}
1237     +
1238     +=pod
1239     +
1240     +=head1 SERVICE MANAGEMENT UTILITIES
1241     +
1242     +=head2 serviceControl()
1243     +
1244     +Manage services - stop/start/restart/reload/graceful
1245     +
1246     +Returns 1 for success, 0 if something went wrong, fatal exception on bad
1247     +arguments.
1248     +
1249     + serviceControl(
1250     + NAME=>serviceName,
1251     + ACTION=>start|stop|restart|reload|graceful
1252     + [ BACKGROUND=>true|false (default is false) ]
1253     + );
1254     +
1255     +EXAMPLE:
1256     +
1257     + serviceControl( NAME=>'httpd-e-smith', ACTION=>'reload' );
1258     +
1259     +NOTES:
1260     +
1261     +The BACKGROUND parameter is optional and can be set to true if
1262     +start/stop/restart/etc. is to be done in the background (with
1263     +backgroundCommand()) rather than synchronously.
1264     +
1265     +CONVENTIONS:
1266     +
1267     +This command is the supported method for action scripts, blade handlers, etc.,
1268     +to start/stop/restart their services. Currently this is done via the rc7
1269     +symlinks, but this may change one day. Using this function gives us one
1270     +location to change this behaviour if desired, instead of hunting all over
1271     +every scrap of code. Please use it.
1272     +
1273     +=cut
1274     +
1275     +sub serviceControl
1276     +{
1277     + my %params = @_;
1278     +
1279     + my $serviceName = $params{NAME};
1280     + unless ( defined $serviceName )
1281     + {
1282     + die "serviceControl: NAME must be specified";
1283     + }
1284     +
1285     + my $serviceAction = $params{ACTION};
1286     + unless (defined $serviceAction)
1287     + {
1288     + die "serviceControl: ACTION must be specified";
1289     + }
1290     +
1291     + if ( $serviceAction =~ /^(start|stop|restart|reload|graceful|adjust|svdisable|reload-or-restart|try-restart|try-reload-or-restart|enable -now|sigterm|sighup|sigusr1|sigusr2)$/ )
1292     + {
1293     + my ($startScript) = glob("/etc/rc.d/rc7.d/S*$serviceName") ||'' ;
1294     + my ($systemdScript) = "/usr/lib/systemd/system/$serviceName.service" ||'';
1295     +
1296     + unless ( -e $startScript or -e $systemdScript)
1297     + {
1298     + warn "serviceControl: startScript not found "
1299     + . "for service $serviceName\n";
1300     + return 0;
1301     + }
1302     +
1303     + if (-e $systemdScript and ! -e $startScript){
1304     + # systemd is not aware of adjust, sigusr1, sigusr2, sigterm, sighup
1305     + $serviceAction = ( $serviceAction =~/^(adjust|graceful|sighup|sigusr1|sigusr2)$/ ) ? "reload" : $serviceAction;
1306     + $serviceAction = ( $serviceAction eq "sigterm" ) ? "restart" : $serviceAction;
1307     + if ($serviceAction =~/^(start|stop|restart|reload|reload-or-restart|try-restart|try-reload-or-restart|enable -now)$/) {
1308     + system('/usr/bin/systemctl',"$serviceAction","$serviceName.service") == '0'
1309     + || warn "serviceControl: Couldn't " .
1310     + "system( /usr/bin/systemctl $serviceAction $serviceName.service): $!\n";
1311     + }
1312     + else {
1313     + die "serviceControl: systemd doesn't know : systemctl $serviceAction $serviceName.service";
1314     + }
1315     + }
1316     +
1317     + elsif (-e $startScript) {
1318     + my $background = $params{'BACKGROUND'} || 'false';
1319     +
1320     + die "serviceControl: Unknown serviceAction $serviceAction" if ($serviceAction =~/^(reload-or-restart|try-restart|try-reload-or-restart|enable -now|sigterm|sighup|sigusr1|sigusr2)$/);
1321     + if ( $background eq 'true' )
1322     + {
1323     + backgroundCommand( 0, $startScript, $serviceAction );
1324     + }
1325     + elsif ( $background eq 'false' )
1326     + {
1327     + unless ( system( $startScript, $serviceAction ) == 0 )
1328     + {
1329     + warn "serviceControl: "
1330     + . "Couldn't system($startScript, $serviceAction): $!\n";
1331     + return 0;
1332     + }
1333     + }
1334     + else
1335     + {
1336     + die "serviceControl: Unsupported BACKGROUND=>$background";
1337     + }
1338     + }
1339     + }
1340     + else
1341     + {
1342     + die "serviceControl: Unknown serviceAction $serviceAction";
1343     + }
1344     + return 1;
1345     +}
1346     +
1347     +=head2 getLicenses()
1348     +
1349     +Return all available licenses
1350     +
1351     +In scalar context, returns one string combining all licenses
1352     +In array context, returns an array of individual licenses
1353     +
1354     +Optionally takes a language tag to be used for retrieving the licenses,
1355     +defaulting to the locale of the server.
1356     +
1357     +=for testing
1358     +$ENV{ESMITH_LICENSE_DIR} = "10e-smith-lib/licenses";
1359     +ok(-d $ENV{ESMITH_LICENSE_DIR}, "License dir for testing exists");
1360     +like($l = esmith::util::getLicenses("fr_CA"), qr/Je suis/, "Found french license");
1361     +like($l = esmith::util::getLicenses("en_US"), qr/I am/, "Found english license");
1362     +
1363     +=cut
1364     +
1365     +sub getLicenses
1366     +{
1367     + my ($locale) = @_;
1368     +
1369     + if ($locale)
1370     + {
1371     + $locale =~ s/-(\S\S)/_\U$1/;
1372     + }
1373     + else
1374     + {
1375     + my $db = esmith::ConfigDB->open();
1376     +
1377     + my ( $lang, @rest ) = $db->getLocale();
1378     +
1379     + $lang = $lang || "en_US";
1380     +
1381     + $locale = $lang;
1382     + }
1383     +
1384     + my $base_dir = $ENV{ESMITH_LICENSE_DIR} || "/etc/e-smith/licenses";
1385     +
1386     + $locale = "en_US" unless ( -d "${base_dir}/${locale}" );
1387     +
1388     + my $dir = "${base_dir}/${locale}";
1389     +
1390     + my @licenses;
1391     +
1392     + opendir( DIR, $dir ) || die "Couldn't open licenses directory\n";
1393     +
1394     + foreach my $license ( readdir(DIR) )
1395     + {
1396     + my $file = "${dir}/${license}";
1397     +
1398     + next unless ( -f $file );
1399     +
1400     + open( LICENSE, $file ) || die "Couldn't open license $file\n";
1401     +
1402     + push @licenses, <LICENSE>;
1403     +
1404     + close LICENSE;
1405     + }
1406     +
1407     + return wantarray ? @licenses : "@licenses";
1408     +}
1409     +
1410     +=head2 getLicenseFile()
1411     +
1412     +Return the license filename.
1413     +
1414     +Optionally takes a language tag to be used for retrieving the license,
1415     +defaulting to the locale of the server.
1416     +
1417     +If more than one license file than return the first alphabetically.
1418     +
1419     +=cut
1420     +
1421     +sub getLicenseFile
1422     +{
1423     + my ($locale) = @_;
1424     +
1425     + if ($locale)
1426     + {
1427     + $locale =~ s/-(\S\S)/_\U$1/s;
1428     + }
1429     + else
1430     + {
1431     + my $db = esmith::ConfigDB->open();
1432     +
1433     + my ( $lang, @rest ) = $db->getLocale();
1434     +
1435     + $lang = $lang || 'en_US';
1436     +
1437     + $locale = $lang;
1438     + }
1439     +
1440     + my $base_dir = $ENV{ESMITH_LICENSE_DIR} || '/etc/e-smith/licenses';
1441     +
1442     + $locale = 'en_US' unless ( -d "${base_dir}/${locale}" );
1443     +
1444     + my $dir = "${base_dir}/${locale}";
1445     +
1446     + opendir( DIR, $dir ) || die "Couldn't open licenses directory\n";
1447     +
1448     + my @licenses;
1449     + foreach my $license ( readdir DIR )
1450     + {
1451     + untaint ($license);
1452     + my $file = "${dir}/${license}";
1453     + next unless ( -f $file );
1454     + push @licenses, $file;
1455     + }
1456     +
1457     + @licenses = sort @licenses;
1458     +
1459     + return shift @licenses;
1460     +}
1461     +
1462     +
1463     +=item B<initialize_default_databases>
1464     +
1465     +Initialize all databases located at /etc/e-smith/db.
1466     +
1467     +=cut
1468     +
1469     +sub initialize_default_databases
1470     +{
1471     +
1472     + # Optionally take an argument to the db root, for testing purposes.
1473     + my %defaults = (
1474     + dbroot => '/etc/e-smith/db',
1475     + dbhome => '/home/e-smith/db',
1476     + old_dbhome => '/home/e-smith',
1477     + );
1478     + my %args = ( %defaults, @_ );
1479     + my $dbroot = $args{dbroot};
1480     + my $dbhome = $args{dbhome};
1481     + my $old_dbhome = $args{old_dbhome};
1482     +
1483     + local *DH;
1484     + opendir DH, $dbroot
1485     + or die "Could not open $dbroot: $!";
1486     +
1487     + my @dirs = readdir(DH);
1488     +
1489     + # Move all databases to new home first them migrate data
1490     + # Untaint db names while we are at it.
1491     + foreach my $file ( map { /(.+)/ ; $1 } grep !/^\./, @dirs )
1492     + {
1493     + if (-f "${old_dbhome}/$file")
1494     + {
1495     + if (-l "${old_dbhome}/$file")
1496     + {
1497     + warn "symlink called ${old_dbhome}/$file exists\n";
1498     + next;
1499     + }
1500     +
1501     + if (-s "${dbhome}/$file")
1502     + {
1503     + warn "${old_dbhome}/$file and ${dbhome}/$file exist\n";
1504     + rename "${dbhome}/$file", "${dbhome}/$file." . time;
1505     + }
1506     +
1507     + warn "Rename ${old_dbhome}/$file => ${dbhome}/$file\n";
1508     + rename "${old_dbhome}/$file", "${dbhome}/$file";
1509     + }
1510     + }
1511     +
1512     + foreach my $file ( grep !/^\./, @dirs )
1513     + {
1514     + # Untaint the result of readdir. As we're expecting filenames like
1515     + # 'configuration' and 'ipphones', lets restrict input to those.
1516     + if ($file =~ /(^[A-Za-z0-9_\.-]+$)/)
1517     + {
1518     + $file = $1;
1519     + }
1520     + else
1521     + {
1522     + warn "Not processing unexpected file $file\n";
1523     + next;
1524     + }
1525     +
1526     + eval
1527     + {
1528     + my $h = esmith::ConfigDB->open($file);
1529     + if ($h)
1530     + {
1531     + warn "Migrating existing database $file\n";
1532     +
1533     + # Convert old data to new format, and add any new defaults. Note
1534     + # that migrate returns FALSE on fatal errors. Report those to
1535     + # syslog. The error should still be in $@.
1536     + unless ( $h->migrate() )
1537     + {
1538     + warn "Migration of db $file failed: " . esmith::DB->error;
1539     + }
1540     + }
1541     + else
1542     + {
1543     + warn "Creating database $file and setting defaults\n";
1544     +
1545     + # create() and load defaults
1546     + unless ( $h = esmith::ConfigDB->create($file) )
1547     + {
1548     + warn "Could not create $file db: " . esmith::DB->error;
1549     + }
1550     + }
1551     +
1552     + $h->close;
1553     +
1554     + esmith::util::chownFile( "root", "admin", "$dbhome/$file" );
1555     + };
1556     + if ($@)
1557     + {
1558     + warn "Fatal error while processing db $file: $@\n";
1559     + }
1560     + }
1561     + return 1;
1562     +}
1563     +
1564     +
1565     +=head1 AUTHOR
1566     +
1567     +Mitel Networks Corp.
1568     +
1569     +For more information, see http://www.e-smith.org/
1570     +
1571     +=cut
1572     +
1573     +1;

admin@koozali.org
ViewVC Help
Powered by ViewVC 1.2.1 RSS 2.0 feed