initial commit of file from CVS for e-smith-lib on Wed 12 Jul 08:58:46 BST 2023

This commit is contained in:
Brian Read 2023-07-12 08:58:46 +01:00
parent 6d7e97ea37
commit a527984040
98 changed files with 14369 additions and 2 deletions

4
.gitignore vendored Normal file
View File

@ -0,0 +1,4 @@
*.rpm
*.log
*spec-20*
*.tar.xz

21
Makefile Normal file
View File

@ -0,0 +1,21 @@
# Makefile for source rpm: e-smith-lib
# $Id: Makefile,v 1.1 2016/02/05 22:44:50 stephdl Exp $
NAME := e-smith-lib
SPECFILE = $(firstword $(wildcard *.spec))
define find-makefile-common
for d in common ../common ../../common ; do if [ -f $$d/Makefile.common ] ; then if [ -f $$d/CVS/Root -a -w $$/Makefile.common ] ; then cd $$d ; cvs -Q update ; fi ; echo "$$d/Makefile.common" ; break ; fi ; done
endef
MAKEFILE_COMMON := $(shell $(find-makefile-common))
ifeq ($(MAKEFILE_COMMON),)
# attept a checkout
define checkout-makefile-common
test -f CVS/Root && { cvs -Q -d $$(cat CVS/Root) checkout common && echo "common/Makefile.common" ; } || { echo "ERROR: I can't figure out how to checkout the 'common' module." ; exit -1 ; } >&2
endef
MAKEFILE_COMMON := $(shell $(checkout-makefile-common))
endif
include $(MAKEFILE_COMMON)

View File

@ -1,3 +1,17 @@
# e-smith-lib
# <img src="https://www.koozali.org/images/koozali/Logo/Png/Koozali_logo_2016.png" width="25%" vertical="auto" style="vertical-align:bottom"> e-smith-lib
SMEServer Koozali developed git repo for e-smith-lib smeserver
## Wiki
<br />https://wiki.koozali.org/
## Bugzilla
Show list of outstanding bugs: [here](https://bugs.koozali.org/buglist.cgi?component=e-smith-lib&product=SME%20Server%2010.X&query_format=advanced&limit=0&bug_status=UNCONFIRMED&bug_status=NEW&bug_status=ASSIGNED&bug_status=REOPENED&bug_status=CONFIRMED)
## Description
<br />*This description has been generated by an LLM AI system and cannot be relied on to be fully correct.*
*Once it has been checked, then this comment will be deleted*
<br />
E-smith-lib is an open source software that enables users to quickly and easily create, edit, and share digital content. The platform offers a variety of tools and features that make it easy for users to create and edit a variety of digital documents, such as text documents, audio files, video files, and photographs. It also allows users to collaborate with other users, share digital content, and manage digital workflow. E-smith-lib also features a powerful search engine that can help users locate digital content quickly. Additionally, it offers a variety of templates for quickly creating digital documents, and provides support for multiple languages and different operating systems. The software is easy to use and offers a convenient way for users to manage their digital content.

131
additional/Artistic Normal file
View File

@ -0,0 +1,131 @@
The "Artistic License"
Preamble
The intent of this document is to state the conditions under which a
Package may be copied, such that the Copyright Holder maintains some
semblance of artistic control over the development of the package,
while giving the users of the package the right to use and distribute
the Package in a more-or-less customary fashion, plus the right to make
reasonable modifications.
Definitions:
"Package" refers to the collection of files distributed by the
Copyright Holder, and derivatives of that collection of files
created through textual modification.
"Standard Version" refers to such a Package if it has not been
modified, or has been modified in accordance with the wishes
of the Copyright Holder as specified below.
"Copyright Holder" is whoever is named in the copyright or
copyrights for the package.
"You" is you, if you're thinking about copying or distributing
this Package.
"Reasonable copying fee" is whatever you can justify on the
basis of media cost, duplication charges, time of people involved,
and so on. (You will not be required to justify it to the
Copyright Holder, but only to the computing community at large
as a market that must bear the fee.)
"Freely Available" means that no fee is charged for the item
itself, though there may be fees involved in handling the item.
It also means that recipients of the item may redistribute it
under the same conditions they received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications
derived from the Public Domain or from the Copyright Holder. A Package
modified in such a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided
that you insert a prominent notice in each changed file stating how and
when you changed that file, and provided that you do at least ONE of the
following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or
an equivalent medium, or placing the modifications on a major archive
site such as uunet.uu.net, or by allowing the Copyright Holder to include
your modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict
with standard executables, which must also be provided, and provide
a separate manual page for each non-standard executable that clearly
documents how it differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or
executable form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where
to get the Standard Version.
b) accompany the distribution with the machine-readable source of
the Package with your modifications.
c) give non-standard executables non-standard names, and clearly
document the differences in manual pages (or equivalent), together
with instructions on where to get the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this
Package. You may not charge a fee for this Package itself. However,
you may distribute this Package in aggregate with other (possibly
commercial) programs as part of a larger (possibly commercial) software
distribution provided that you do not advertise this Package as a
product of your own. You may embed this Package's interpreter within
an executable of yours (by linking); this shall be construed as a mere
form of aggregation, provided that the complete Standard Version of the
interpreter is so embedded.
6. The scripts and library files supplied as input to or produced as
output from the programs of this Package do not automatically fall
under the copyright of this Package, but belong to whoever generated
them, and may be sold commercially, and may be aggregated with this
Package. If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End

340
additional/Copying Normal file
View File

@ -0,0 +1,340 @@
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
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
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19yy name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.

33
additional/LICENSE Normal file
View File

@ -0,0 +1,33 @@
# 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.
Perl Kit, Version 5.0
Copyright 1989-2001, Larry Wall
All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the terms of either:
a) the GNU General Public License as published by the Free
Software Foundation; either version 1, or (at your option) any
later version, or
b) the "Artistic License" which comes with this Kit.
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 either
the GNU General Public License or the Artistic License for more details.
You should have received a copy of the Artistic License with this
Kit, in the file named "Artistic". If not, I'll be glad to provide one.
You should also have received a copy of the GNU General Public License
along with this program in the file named "Copying". If not, write to the
Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
02111-1307, USA or visit their web page on the internet at
http://www.gnu.org/copyleft/gpl.html.

790
additional/e-smith-lib.spec Normal file
View File

@ -0,0 +1,790 @@
# $Id: e-smith-lib.spec,v 1.24 2010/10/11 22:27:51 slords Exp $
Summary: e-smith server and gateway - library module
%define name e-smith-lib
Name: %{name}
%define version 2.4.0
%define release 1
Version: %{version}
Release: %{release}%{?dist}
License: Artistic
Group: Networking/Daemons
Source: %{name}-%{version}.tar.xz
BuildRoot: /var/tmp/%{name}-%{version}-%{release}-buildroot
BuildArchitectures: noarch
BuildRequires: e-smith-devtools >= 1.6.3-01
Obsoletes: %{name}-Tai64n
Obsoletes: whiptail
Requires: dialog
Requires: perl, perl(Text::Template)
Requires: perl(Time::HiRes), perl(MIME::Base64)
Requires: perl(Authen::PAM), perl(I18N::AcceptLanguage)
Requires: perl(I18N::LangTags) >= 0.27
Requires: perl(Net::IPv4Addr) >= 0.10
%description
e-smith server and gateway software - library module.
%changelog
* Fri Jan 25 2013 Shad L. Lords <slords@mail.com> 2.4.0-1.sme
- Bump version in prep for SME9
* Mon Oct 11 2010 Shad L. Lords <slords@mail.com> 2.2.0-7.sme
- Serialize configure_peers to prevent errors [SME: 5831]
* Fri Feb 5 2010 Stephen Noble <support@dungog.net> 2.2.0-6.sme
- adds the hwaddr parameter to probeAdapters() [SME: 4528]
* Thu Feb 4 2010 Shad L. Lords <slords@mail.com> 2.2.0-5.sme
- Update path for 64-bit compatibility [SME: 5756]
* Tue Dec 22 2009 Filippo Carletti <filippo.carletti@gmail.com> 2.2.0-4.sme
- Really apply previous patch in the spec file. [SME: 5659]
* Wed Dec 9 2009 Charlie Brady <charlieb@budge.apana.org.au> 2.2.0-3.sme
- Add patch (Federico Simoncelli) to prevent re-use of uids. [SME: 5659]
* Mon Oct 13 2008 Shad L. Lords <slords@mail.com> 2.2.0-2.sme
- Add patch to support multiple samba roles [SME: 4172]
* Tue Oct 7 2008 Shad L. Lords <slords@mail.com> 2.2.0-1.sme
- Roll new stream to separate sme7/sme8 trees [SME: 4633]
* Wed Aug 20 2008 Shad L. Lords <slords@mail.com> 1.19.0-1
- Roll new dev stream.
* Sat Aug 9 2008 Shad L. Lords <slords@mail.com> 1.18.0-28
- Read /dev/urandmon instead of /dev/random [SME: 4492]
* Sat Aug 9 2008 Shad L. Lords <slords@mail.com> 1.18.0-27
- Make dialog not use STDERR for return values [SME: 3663]
- Remove requires for whiptail. No longer needed [SME: 4491]
* Thu Jul 31 2008 Shad L. Lords <slords@mail.com> 1.18.0-26
- Make binmode properties of db class [SME: 4317]
- Add new navigation db & utf8 classes [SME: 4317]
* Wed Apr 2 2008 Shad L. Lords <slords@mail.com> 1.18.0-25
- Add .utf8 to locale unless server-console [SME: 4162]
- Add new languages to langtag2locale [SME: 4163]
* Sun Mar 30 2008 Shad L. Lords <slords@mail.com> 1.18.0-24
- Gracefully handle encoding errors in navigation dbs [SME: 4147]
* Wed Mar 26 2008 Shad L. Lords <slords@mail.com> 1.18.0-23
- Make PAM conv routine not look for english strings [SME: 4117]
* Tue Mar 25 2008 Shad L. Lords <slords@mail.com> 1.18.0-22
- Fix wide output to syslog and allow navigations db to be utf8 [SME: 4101]
* Mon Mar 10 2008 Shad L. Lords <slords@mail.com> 1.18.0-21
- Output navigation in UTF-8 [SME: 3858]
* Sun Jan 20 2008 Gavin Weight <gweight@gmail.com> 1.18.0-20
- Call smbpasswd -e - to reset user correctly. [SME: 3755]
* Tue Jan 08 2008 Stephen Noble <support@dungog.net> 1.18.0-19
- modify validate password strong match for console [SME: 2173]
* Thu Nov 01 2007 Gavin Weight <gweight@gmail.com> 1.18.0-18
- Fix I18N.pm file descriptor leak. [SME: 3509]
* Wed Oct 31 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-17
- Remove undocumented and unused template metadata handling from
generic_template_expand action (Take II). [SME: 2798]
* Fri Jun 1 2007 Shad L. Lords <slords@mail.com> 1.18.0-16
- pam_unix requires passwords >= 6 [SME: 3039]
* Mon May 21 2007 Shad L. Lords <slords@mail.com> 1.18.0-15
- Fix ip addr shift to work on 64-bit
* Sun Apr 29 2007 Shad L. Lords <slords@mail.com>
- Clean up spec so package can be built by koji/plague
* Thu Apr 05 2007 Shad L. Lords <slords@mail.com> 1.18.0-14
- Reverse changes for 1.18.0-12 as it is being used. [SME: 2838]
* Wed Apr 04 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-13
- Allow gauge console widget to be used without following message_page.
[SME: 2832].
* Mon Mar 26 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-12
- Remove undocumented and unused template metadata handling from
generic_template_expand action. [SME: 2798]
* Mon Mar 26 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-11
- Split logfile rotation code out of generic_template_expand.
Code moved to a new action in e-smith-base. [SME: 2795]
* Mon Mar 19 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-10
Don't try to read template.metadata from subdirectories (affects
initialize_database_defaults). [SME: 2690]
* Fri Mar 16 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-9
- Allow template.metadata to be provided via a directory of
small files. [SME: 2690]
- Add support for a DELETE boolean template.metadata item. [SME: 2691]
* Wed Feb 28 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-8
- Add gauge widget to esmith::console. [SME: 2579]
* Sun Feb 25 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-7
- Default infobox height to 8 rows, and allow override via params.
[SME: 2560]
* Fri Feb 23 2007 Shad L. Lords <slords@mail.com> 1.18.0-6
- Really fix clear parameter for inputbox dialog screen [SME: 2533]
* Fri Feb 23 2007 Shad L. Lords <slords@mail.com> 1.18.0-5
- Fix clear parameter for dialog screens [SME: 2533]
* Thu Feb 22 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-4
- switch esmith::console::password_page() to use dialog rather than
whiptail. [SME: 2534]
* Thu Feb 22 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-3
- Add infobox widget. [SME: 2533]
* Sun Jan 28 2007 Shad L. Lords <slords@mail.com> 1.18.0-2
- Fix backtitle spacing for new dialog menus [SME: 2328]
* Fri Jan 26 2007 Shad L. Lords <slords@mail.com> 1.18.0-1
- Roll stable stream. [SME: 2328]
* Tue Dec 15 2006 Federico Simoncelli <federico.simoncelli@gmail.com> 1.17.0-8
- Added the validatePassword function to esmith::util. [SME: 2100]
* Thu Dec 07 2006 Shad L. Lords <slords@mail.com>
- Update to new release naming. No functional changes.
- Make Packager generic
* Fri Nov 24 2006 Gordon Rowell <gordonr@gormand.com.au> 1.17.0-06
- Allow optional path to peeers directory in
esmith::tcpsvd::configure_peers() [SME: 2086]
* Tue Nov 14 2006 Charlie Brady <charlie_brady@mitel.com> 1.17.0-05
- Allow defaulno option to esmith::console::yesno.
- Fix I/O redirection in esmith::console::new.
* Tue Nov 07 2006 Charlie Brady <charlie_brady@mitel.com> 1.17.0-04
- Allow display of "0" in iesmith::cgi::genSmallCell. [SME: 2038]
* Mon Oct 23 2006 Charlie Brady <charlie_brady@mitel.com> 1.17.0-03
- Make dialog the default console app, with whiptail used only when
required.
* Wed Oct 11 2006 Charlie Brady <charlie_brady@mitel.com> 1.17.0-02
- Allow 'dialog' to be called from esmith::console. [SME: 1958]
* Wed Oct 11 2006 Charlie Brady <charlie_brady@mitel.com> 1.17.0-01
- Roll development branch.
* Mon Sep 25 2006 Charlie Brady <charlie_brady@mitel.com> 1.16.0-06
- Fix problem with greedy RE in template.metadata parsing. [SME: 1906]
* Fri Sep 08 2006 Charlie Brady <charlie_brady@mitel.com> 1.16.0-05
- Fix taint problem in template.metadata handling. [SME: 1906]
* Thu Apr 13 2006 Charlie Brady <charlie_brady@mitel.com> 1.16.0-04
- Use "kudzu --probe --class network" for NIC detection. [SME: 727]
* Fri Apr 7 2006 Gordon Rowell <gordonr@gormand.com.au> 1.16.0-03
- Don't call smbpasswd -e - setting the password is sufficient [SME: 1193]
* Tue Mar 28 2006 Gordon Rowell <gordonr@gormand.com.au> 1.16.0-02
- Log previous contents of db entry in DELETE log [SME: 1066]
* Tue Mar 14 2006 Charlie Brady <charlie_brady@mitel.com> 1.16.0-01
- Roll to stable stream version number. [SME: 1016]
* Fri Mar 10 2006 Charlie Brady <charlie_brady@mitel.com> 1.15.4-02
- Suppress warning from genSmallCell if text is undefined. [SME: 986]
* Fri Feb 17 2006 Gordon Rowell <gordonr@gormand.com.au> 1.15.4-01
- Roll patches up to 1.15.3-42
- Trim changelog prior to 1.15.0-01 [SME: 828]
* Thu Feb 16 2006 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-42
- Adjust console title bar to 'SME Server' [SME: 726]
* Tue Feb 14 2006 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-41
- Reworded text for template-begin and change URL to /development/
rather than /custom/ [SME: 773]
* Mon Feb 13 2006 Charlie Brady <charlie_brady@mitel.com> 1.15.3-40
- Update URL in default template-begin fragment. [SME: 773]
* Sat Feb 11 2006 Charlie Brady <charlieb@e-smith.com> 1.15.3-39
- Remove obsolete e-smith-lib-Tai64n package. [SME: 689]
* Sat Feb 11 2006 Charlie Brady <charlieb@e-smith.com> 1.15.3-38
- [Null changelog for missing version - we accidentally skipped
this version.]
* Sat Feb 11 2006 Charlie Brady <charlieb@e-smith.com> 1.15.3-37
- Fix get_all_by_prop in scalar context. [SME: 669,721]
* Mon Feb 6 2006 Shad L. Lords <slords@mail.com> 1.15.3-37
- Add ability to pass many props to get_all_by_prop [SME: 669]
* Mon Jan 23 2006 Charlie Brady <charlieb@e-smith.com> 1.15.3-36
- Fix warning during pseudonym deletion. [SME: 491]
* Fri Jan 20 2006 Charlie Brady <charlieb@e-smith.com> 1.15.3-35
- Fix up use of Sys::Syslog::syslog. [SME: 526]
* Thu Jan 19 2006 Charlie Brady <charlieb@e-smith.com> 1.15.3-34
- Remove running of kudzu during NIC probing. TODO: Find a solution
to system reconfiguration when new hardware is added. [SME: 192]
* Tue Jan 10 2006 Charlie Brady <charlieb@e-smith.com> 1.15.3-33
- Fold a.b.c.d/255.255.255.255 to a.b.c.d in local_access_spec() to
work around bugs in applications which don't accept such specs.
[SME: 430]
* Mon Jan 9 2006 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-32
- Check whether an accounts db record exists before trying to create
the dot and underscore pseudonyms (new_record will fail silently)
and check that the records are pseudonyms before deleting them [SME: 24]
* Mon Jan 9 2006 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-31
- And update POD for last change [SME: 24]
* Mon Jan 9 2006 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-30
- Allow dot and underscore in account names [SME: 24]
* Tue Dec 27 2005 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-29
- Remove newlines from cluck() string and just note that the old
path was used [SME: 365]
* Sat Dec 25 2005 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-28
- If db exists in both the old and new locations in
initialize_default_databases, rename the one in the new
location to db.time(), avoiding the conflict and saving the
evidence in case it is needed later [SME: 229]
* Mon Dec 05 2005 Mark Knox <mark_knox@mitel.com>
- [1.15.3-27]
- Moved queueing logic to separate daemon, replaced with FIFO IPC [BZ252
* Thu Dec 01 2005 Mark Knox <mark_knox@mitel.com>
- [1.15.3-26]
- Added event queueing (open source portion) for clustered systems [BZ250]
* Wed Nov 30 2005 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-25
- Bump release number only
* Thu Nov 24 2005 Gordon Rowell <gordonr@e-smith.com>
- [1.15.3-24]
- Add missing 'use Locale::gettext' to esmith::console.pm [MN00108804]
* Sun Nov 20 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-23]
- Clarify logic for stopped services in adjust-services. [SF: 1357629]
* Sun Nov 20 2005 Gordon Rowell <gordonr@e-smith.com>
- [1.15.3-22]
- Correct adjust-services logic for stopped services [SF: 1357629]
* Wed Nov 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-21]
- Allow services2adjust directories to contain files rather than just dangling
symlinks. Files can contain more than one actions to perform. [SF: 1270644]
* Wed Nov 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-20]
- Also don't start services if we just want to "once" them. [SF: 1357629]
* Wed Nov 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-19]
- Fix restart of enabled supervised services which we are attempting to stop.
[SF: 1357629]
* Tue Nov 15 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-18]
- Set default for $type in esmith::cgi::genSmallCell, to prevent some log
noise. [SF: 1357830]
* Tue Nov 15 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-17]
- Pass $EVENT to template expansions in generic_template_expand.
[SF: MN00106104]
* Tue Nov 15 2005 Gordon Rowell <gordonr@e-smith.com>
- [1.15.3-16]
- Redirect esmith::config calls on old db paths to the new
location [SF: 1335865]
* Thu Oct 27 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-15]
- Fix a few minor spec file portability issues. [SF: 1339729]
* Wed Oct 26 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-14]
- Add it and de to the langtag2locale fixups. [SF: 1338236]
* Tue Oct 11 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-13]
- Build driver list from .ko files as well as .o files. Untaint driver
names while building list. [SF: 1323270]
* Mon Sep 26 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-12]
- Fix "defaults" handling so that values which evaluate to false are
not overridden by default. [SF: 1303885]
* Fri Sep 23 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-11]
- Untaint db names before attempting to move them. [MN00098405]
* Thu Sep 22 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-10]
- Provide networks method in esmith::NetworksDB. [SF: 1296099]
- Support a "localhost" configuration in esmith::tcpsvd:configure_peers
[SF: 1294719]
* Tue Sep 20 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-09]
- Remove deprecated functions from esmith::utils. [SF: 1295851]
- Include only "network" records in local_access_spec. [SF: 1296099]
* Mon Sep 12 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-08]
- Remove warning about explicit path in esmith::db::_db_path.
[SF: 1286294]
* Fri Sep 9 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-07]
- Tolerate, but warn about, symlinks in /home/e-smith. [SF: 1216546]
* Fri Sep 9 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-06]
- Reduce the noise from _file_path() in esmith::DB::db. [SF: 1286294]
* Wed Sep 7 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-05]
- Fix operation of expandTemplate when taint check is enabled.
[SF: 1284301]
* Wed Aug 17 2005 Mark Knox <markk@e-smith.com>
- [1.15.3-04]
- Added open_local and open_ro_local methods for clustering [markk MN00094831]
* Tue Aug 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-03]
- Fix POD error in util.pm.
* Wed Jul 27 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-02]
- Move databases default location from /home/e-smith to /home/e-smith/db.
During esmith::utils::initialize_default_databases, move from old to new
location before doing db migrate actions. [SF: 1216546]
* Wed Jul 27 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-01]
- Roll a new development stream - 1.15.3
* Wed Jul 27 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.2-04]
- Remove broken MergeDB stuff. [SF: 1246315]
* Wed Jul 27 2005 Mark Knox <markk@e-smith.com>
- [1.15.2-03]
- Fixed misleading comment in util.pm
- Added 'use' statements in Record classes for SOAP compatibility
- Fixed undefined max_len warning
- Added explicit writeconf calls in db::Record.pm, needed for setting props
via SOAP
* Tue Jul 19 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.2-02]
- Allow db open API to use default path if a simple filename
is provided as arg. This is preparation for move of dbs to
/home/e-smith/db. Patch by Shad Lords.
* Mon Jul 18 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.2-01]
- Roll new development stream - 1.15.2
* Fri Jul 15 2005 Mark Knox <markk@e-smith.com>
- [1.15.1-44]
- Tweak to allow calling _writeconf from SOAP [markk MN00090738]
* Tue Jun 21 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-43]
- Ensure that esmith::util::LdapPassword returns bare string without
newline terminator.
* Sun Jun 12 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-42]
- Remove .rpmsave and .rpmnew symlinks (as well as files). [SF: 1217969]
- Handle missing description in pcitables entries.
* Sun Jun 12 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-41]
- Provide feedback (via log messages) from services2adjust. [SF: 1218920]
* Mon May 30 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-40]
- Add preinstall scripting to create required accounts/groups if they
don't already exist. [SF: 1210723]
* Thu May 5 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-39]
- Show Text::Template error text rather than inappropriate $! if template
expansion fails.
- Change error to warning if a config item is set with an empty "type"
property.
* Thu May 5 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-38]
- Fix esmith::DB::get_prop_and_delete fail if prop is "false" [From Gordon].
* Tue May 3 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-37]
- Update directory list so that ethernet drivers from kernel-unsupported are
added to "choose by driver" list.
* Sat Mar 19 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-36]
- Rework esmith::tcpsvd::configure_peers so that it doesn't chdir.
- Fix generic_template_expand so that templates.metadata doesn't
need to set OUTPUT_FILENAME is TEMPLATE_PATH is changed. This
matches what expand-template already does.
* Fri Mar 18 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-35]
- Change numerous calls to "croak" in esmith::template
to "carp ...; return", so that problem with any single
template expansion doesn't terminate calling program.
[MN00075009]
* Wed Mar 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-34]
- Add missing "use esmith::util" in esmith::tcpsvd.
* Wed Mar 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-33]
- Add esmith::tcpsvd library for managing tcpsvd "peers"
directories.
* Mon Mar 14 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-32]
- Make template expansion message more succinct.
* Thu Mar 10 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-31]
- Remove pseudonyms of pseudonyms when removing user
accounts. Adapted from patch submitted by Shad. [MN00039941]
* Wed Feb 23 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-30]
- Fix incompatibility with CentOS's CGI.pm.
* Tue Feb 22 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-29]
- Fix bug in output to empty file when FILTER is used
during template expansion. [charlieb MN00050075]
* Tue Feb 22 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-28]
- Refresh contents of /etc/sysconfig/hwconf before listing
network adaptors [MN00069993]
- Fix typo in documentation of esmith::DB::db - reported from Tanna -
http://www.livejournal.com/users/gcrumb/61169.html (thanks Dan!)
* Wed Feb 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-27]
- Fix typo. [MN00066059]
* Wed Feb 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-26]
- Use /sbin/e-smith/whiptail if it is available. [MN00066059]
* Mon Feb 7 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-25]
- Update perms and ownership when expanding templates, regardless of
whether file content has changed or not. [MN00068043]
* Wed Feb 2 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-24]
- Fix the insertion of implicit actions into sorted action list in
event.pm. Problem was perl syntax ambiguity. [MN00066406]
* Fri Jan 28 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-23]
- Really move /home/e-smith/* to e-smith-base. [MN00066635]
* Fri Jan 28 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-22]
- Move /home/e-smith/* to e-smith-base. [MN00066635]
- Move generic-template expand to S05 position in sort, and
adjust-service to S90. Fix run-time error. [MN00066406]
- Don't attempt to execute non-executable action scripts.
* Thu Jan 27 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-21]
- Implicitly include template expand and services adjust actions
in each event if the respective metadata directory exists.
[MN00066406]
* Tue Jan 25 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-20]
- Add "adjust" to list of verbs which serviceControl groks,
to allow for "masq adjust". [MN00065576]
* Tue Jan 25 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-19]
- Add adjust-services generic action script [MN00065576]
* Tue Jan 18 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-18]
- Fix typo. [MN00064412]
- Improve die() message in esmith::config::STORE. [MN00064394]
* Mon Jan 17 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-17]
- Fix broken logging (and reduce logging) in initialize_default_databases.
[MN00064412]
- Fix inappropriate use of global $_ in initialize_default_databases.
[MN00064415]
* Thu Dec 23 2004 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-16]
- Read templated file metadata (if any) from file tree under
/etc/e-smith/templates.metadata. Update expand-template to
use current API. [MN00061830]
* Tue Dec 14 2004 Mark Knox <markk@e-smith.com>
- [1.15.1-15]
- Change copyright date to 2004 [markk MN00060958]
* Fri Nov 5 2004 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-14]
- Fix Authen::PAM dependency header [charlieb MN00040240]
- Use kudzu's generated /etc/sysconfig/hwconf file for NIC detection
[charlieb MN00056220]
* Thu Oct 14 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-13]
- Updated esmith::ethernet's search code to remove File::Find, as it doesn't
get along with taint checking. [msoulier MN00052510]
* Wed Oct 13 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-12]
- Updated esmith::ethernet's search code such that is it more adaptable, and
recurses the directories given. [msoulier MN00052510]
* Wed Oct 13 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-11]
- Updated esmith::ethernet's search paths for network drivers.
[msoulier MN00052510]
* Mon Oct 4 2004 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-10]
- Remove dependency on perl(Filter::Handle) [charlieb MN00050075]
* Fri Sep 24 2004 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-09]
- Updated requires with new perl dependencies. [msoulier MN00040240]
- Remove "AutoReqProv: no" so that "Provides" headers are auto-generated.
[charlieb MN00040240]
- Remove anachronistic "require v5.6.0" directives. [charlieb MN00050370]
- Avoid use of Filter::Handle in esmith::template. [charlieb MN00050075]
* Fri Aug 27 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-08]
- Added esmith::util::network::isValidEmail function. [msoulier MN00023814]
* Thu Aug 26 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-07]
- Added svdisable to permissible actions in serviceControl.
[msoulier MN00043056]
* Tue Aug 10 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-06]
- Fixed new methods. Bad else case. [msoulier MN00044891]
* Fri Aug 6 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-05]
- Added a keys() method. [msoulier MN00041968]
* Fri Aug 6 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-04]
- Added set_prop and set_value methods in esmith::DB. [msoulier MN00044891]
* Tue Jul 20 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-03]
- Undeprecated esmith::util::serviceControl. [msoulier MN00043056]
* Fri Jun 25 2004 Tony Clayton <apc@e-smith.com>
- [1.15.1-02]
- Merge language_tag2locale() function from perl-I18N-LangTags [tonyc
MN00040170]
* Fri May 28 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-01]
- Rolling to collect patches.
* Fri May 28 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-23]
- Reordered the create code slightly to catch more errors.
[msoulier MN00035059]
* Fri May 28 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-22]
- Added yet more error handling and reporting. [msoulier MN00035059]
* Fri May 28 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-21]
- Fixed one $Error reference that I missed in the last rev.
[msoulier MN00035059]
* Fri May 28 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-20]
- Moved error handling from esmith::DB::db to esmith::DB, since it should not
be database implementation specific. [msoulier MN00035059]
* Fri May 28 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-19]
- Propagated migration failures up to calling code for reporting to syslog.
- Propagated creation failures up to calling code.
- Moved lexicon $Error in esmith::DB::db to a class property so it can be used
by subclasses. [msoulier MN00035059]
* Thu May 27 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-18]
- Changed print statements to calls to the logger. [msoulier MN00035059]
* Thu May 27 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-17]
- Added print statements to initialize-default-databases for post-install
debugging. [msoulier MN00035059]
* Fri May 7 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-16]
- Fixed migrate to report the caught error message. [msoulier MN00032503]
* Thu May 6 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-15]
- Added isValidHostname function to esmith::util::network.
[msoulier MN00024212]
* Fri Feb 13 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-14]
- Greatly simplified the _mysystem function by ripping out open3.
[msoulier dpar-20385]
* Fri Feb 13 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-13]
- Backed-out change in esmith::util, as it's non-trivial there with the exec.
Completed update of esmith::event, and separated the esmith::Logger class.
[msoulier dpar-20385]
* Fri Feb 13 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-12]
- Removed use of the logger entirely, replacing it with an abstracted
interface to the Sys::Syslog module. [msoulier dpar-20385]
* Thu Jan 8 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-11]
- Fixed esmith::util::network::isValidIP() so valid IP substrings no longer
return true values. [msoulier 9308]
* Thu Jan 8 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-10]
- Added a check in STORE in esmith::config for invalid attempts to set a value
without a type. Also escalated previous warnings for undef key and value to
fatal exceptions. [msoulier 7386]
* Thu Jan 8 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-09]
- Now trimming whitespace around keys and values during esmith::config STORE
events, to prevent invalid keys and values from being saved. [msoulier 7021]
* Mon Jan 5 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-08]
- Fixed POD around merge_props. [msoulier 9482]
* Fri Nov 7 2003 Tony Clayton <apc@e-smith.com>
- [1.15.0-07]
- And again [tonyc 10569]
* Fri Nov 7 2003 Tony Clayton <apc@e-smith.com>
- [1.15.0-06]
- Change Merge API a bit, fix pod [tonyc 10569]
* Fri Nov 7 2003 Tony Clayton <apc@e-smith.com>
- [1.15.0-05]
- Add esmith::DB::Merge library [tonyc 10569]
* Fri Oct 10 2003 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-04]
- Fixed AccountsDB.pm to handle group names with hyphens and periods, to match
the error message in the groups panel, and the rest of the group/user
behaviour. [msoulier 10236]
* Sun Sep 21 2003 Charlie Brady <charlieb@e-smith.com>
- [1.15.0-03]
- Skip any directries when iterating over action scripts in esmith::event.
Add logfile timestamp symlinking to generic_template_expand action.
Use templates2expand and logfiles2timestamp subdirectories of the event
directory. Fix shebang line. [charlieb 10035]
* Thu Sep 18 2003 Charlie Brady <charlieb@e-smith.com>
- [1.15.0-02]
- Add generic_template_expand action. [charlieb 10035]
* Thu Sep 18 2003 Charlie Brady <charlieb@e-smith.com>
- [1.15.0-01]
- Changing version to development stream number - 1.15.0
%prep
%setup
%pre
#--------------------------------------------------
# add admin, public and www user accounts
#--------------------------------------------------
/usr/sbin/groupadd \
-g 500 shared 2>/dev/null || :
/usr/sbin/useradd \
-u 102 -c 'e-smith web server' -d /home/e-smith \
-G shared -M -s /bin/false www 2>/dev/null || :
/usr/sbin/useradd \
-u 101 -c 'e-smith administrator' -d /home/e-smith \
-G shared,root,www -M -s /sbin/e-smith/console admin 2>/dev/null || :
/usr/sbin/useradd \
-u 103 -c 'e-smith guest' -d /home/e-smith \
-G shared -M -s /bin/false public 2>/dev/null || :
/usr/sbin/useradd \
-u 1002 -c 'sme log user' -d /var/log/smelog \
-M -s /bin/false smelog 2>/dev/null || :
exit 0
%post
%build
for event in post-install post-upgrade bootstrap-console-save console-save
do
mkdir -p root/etc/e-smith/events/$event
done
perl createlinks
%install
rm -rf $RPM_BUILD_ROOT
(cd root ; find . -depth -print | cpio -dump $RPM_BUILD_ROOT)
rm -f %{name}-%{version}-%{release}-filelist
/sbin/e-smith/genfilelist $RPM_BUILD_ROOT \
>%{name}-%{version}-%{release}-filelist
echo "%doc Copying" >> %{name}-%{version}-%{release}-filelist
echo "%doc Artistic" >> %{name}-%{version}-%{release}-filelist
echo "%doc LICENSE" >> %{name}-%{version}-%{release}-filelist
%clean
rm -rf $RPM_BUILD_ROOT
%files -f %{name}-%{version}-%{release}-filelist
%defattr(-,root,root)

1
contriborbase Normal file
View File

@ -0,0 +1 @@
sme10

38
createlinks Normal file
View File

@ -0,0 +1,38 @@
#!/usr/bin/perl -w
#----------------------------------------------------------------------
# Copyright (c) 2001 Mitel Networks Corporation
#
# Technical support for this program is available from Mitel Networks
# Corporation. Please visit our web site www.e-smith.com for details.
#----------------------------------------------------------------------
sub panel_link
{
my ($function, $panel) = @_;
unlink "root/etc/e-smith/web/panels/$panel/cgi-bin/$function";
symlink("../../../functions/$function",
"root/etc/e-smith/web/panels/$panel/cgi-bin/$function")
or die "Can't symlink to root/etc/e-smith/web/panels/$panel".
"/cgi-bin/$function: $!";
}
sub event_link
{
my ($action, $event, $level) = @_;
unlink "root/etc/e-smith/events/${event}/S${level}${action}";
symlink("../actions/${action}",
"root/etc/e-smith/events/${event}/S${level}${action}")
or die "Can't symlink to " .
"root/etc/e-smith/events/${event}/S${level}${action}: $!";
}
#--------------------------------------------------
# actions for events
#--------------------------------------------------
foreach my $event (qw(post-install post-upgrade bootstrap-console-save console-save))
{
event_link("initialize-default-databases", $event, "00");
}

902
e-smith-lib.spec Normal file
View File

@ -0,0 +1,902 @@
# $Id: e-smith-lib.spec,v 1.20 2023/07/11 02:49:10 trevorb Exp $
%define copykooz 2013-2021
Summary: e-smith server and gateway - library module
%define name e-smith-lib
Name: %{name}
%define version 2.6.0
%define release 17
Version: %{version}
Release: %{release}%{?dist}
License: Artistic
Group: Networking/Daemons
Source: %{name}-%{version}.tar.xz
BuildRoot: /var/tmp/%{name}-%{version}-%{release}-buildroot
BuildArchitectures: noarch
BuildRequires: e-smith-devtools >= 1.6.3-01
Obsoletes: %{name}-Tai64n
Obsoletes: whiptail
Requires(pre): e-smith
Requires: dialog
Requires: perl, perl(Text::Template)
Requires: perl(Time::HiRes), perl(MIME::Base64)
Requires: perl(Authen::PAM), perl(I18N::AcceptLanguage)
Requires: perl(I18N::LangTags) >= 0.27
Requires: perl(Net::IPv4Addr) >= 0.10
Requires: perl(Taint::Util)
Requires: pciutils
%description
e-smith server and gateway software - library module.
%changelog
* Wed Jul 12 2023 cvs2git.sh aka Brian Read <brianr@koozali.org> 2.6.0-17.sme
- Roll up patches and move to git repo [SME: 12338]
- Remove create e-smith-lib-update event [SME: 12338]
* Wed Jul 12 2023 BogusDateBot
- Eliminated rpmbuild "bogus date" warnings due to inconsistent weekday,
by assuming the date is correct and changing the weekday.
* Wed Nov 23 2022 Jean-Philippe Pialasse <tests@pialasse.com> 2.6.0-16.sme
- allow call to systemctl aliases in etc [SME: 12194]
fix network=>networking service is not restarted.
* Thu Oct 28 2021 Jean-Philippe Pialasse <tests@pialasse.com> 2.6.0-15.sme
- add support for service with instances [SME: 11723]
* Mon Apr 19 2021 Jean-Philippe Pialasse <tests@pialasse.com> 2.6.0-14.sme
- update copyright dates, and make it easier to change from spec file [SME: 11570]
* Sat Jan 02 2021 Jean-Philipe Pialasse <tests@pialasse.com> 2.6.0-13.sme
- partial revert of signals [SME: 11177]
signal s not passed to runit services (dnscache*, qmail, qpsmtpd...)
services handled by systemd crash if they do not have Restart=always defined
* Fri Jan 01 2021 Jean-Philipe Pialasse <tests@pialasse.com> 2.6.0-12.sme
- add support for signals SIG* with systemd [SME: 11177]
fix typo for reload-or-try-restart
unsupervised services: really stop when disabled and start stopped enabled ones
* Thu Nov 26 2020 Jean-Philipe Pialasse <tests@pialasse.com> 2.6.0-11.sme
- remove error when sending sighup event [SME: 11177]
* Tue Nov 17 2020 Jean-Philipe Pialasse <tests@pialasse.com> 2.6.0-10.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
- create e-smith-lib-event [SME: 11141]
* Thu Dec 12 2019 Jean-Philipe Pialasse <tests@pialasse.com> 2.6.0-9.sme
- add support for systemctl reload-or-restart, try-restart, enable -now [SME: 10848]
* Wed Oct 25 2017 Daniel Berteaud <daniel@firewall-services.com> 2.6.0-8.sme
- Revert prev change regarding tap_soft, as it's not needed [SME: 10445]
* Mon Oct 23 2017 Daniel Berteaud <daniel@firewall-services.com> 2.6.0-7.sme
- Skip tap_soft interfaces (eg SoftEther, code from Hsing-Foo Wang)
[SME: 10445]
* Wed Apr 12 2017 Jean-Philipe Pialasse <tests@pialasse.com> 2.6.0-6.sme
- remove reference to smtpd in configuration.conf [SME: 9478]
* Thu Aug 04 2016 Jean-Philipe Pialasse <tests@pialasse.com> 2.6.0-5.sme
- fix console startup display [SME: 9352]
* Sat Jul 23 2016 Jean-Philipe Pialasse <tests@pialasse.com> 2.6.0-4.sme
- fix service name syslog to rsyslog [SME: 9691]
* Mon Jul 18 2016 Jean-Philipe Pialasse <tests@pialasse.com> 2.6.0-3.sme
- fix mysqld to mariadb [SME: 9438]
- Eliminated rpmbuild "bogus date" warnings due to inconsistent weekday,
by assuming the date is correct and changing the weekday.
Sat Dec 25 2005 --> Sat Dec 24 2005 or Sun Dec 25 2005 or Sat Dec 31 2005 or ....
Tue Dec 15 2006 --> Tue Dec 12 2006 or Fri Dec 15 2006 or Tue Dec 19 2006 or ....
* Thu Jul 14 2016 stephane de Labrusse <stephdl@de-labrusse.fr> 2.6.0-2.sme
- fix esmith::util::serviceControl to manage systemd service [SME: 9660]
- Added e-smith-lib-2.6.0.bz9660.serviceControlSystemd.patch
* Fri Feb 05 2016 stephane de Labrusse <stephdl@de-labrusse.fr> 2.6.0-1.sme
- Initial release to sme10
* Tue Jan 12 2016 Daniel Berteaud <daniel@firewall-services.com> 2.4.0-16.sme
- Adjust regex so adjust-service accepts sigusr1 and sigusr2 from files
[SME: 9184]
* Thu Jun 18 2015 stephane de Labrusse <stephdl@de-labrusse.fr> 2.4.0-15.sme
- Added a password creation (set_secret) [SME: 8943]
- code from Charlie Brady <charlieb-contribs-bugzilla@budge.apana.org.au>
* Sat Apr 5 2014 Ian Wells <esmith@wellsi.com> 2.4.0-14.sme
- Untaint the license filename [SME: 8305]
- Non-functional perl::Critic changes.
* Sun Mar 16 2014 Ian Wells <esmith@wellsi.com> 2.4.0-13.sme
- Add textbox() to console.pm, getLicenseFile to util.pm [SME: 8264]
* Sun Feb 2 2014 Ian Wells <esmith@wellsi.com> 2.4.0-12.sme
- Update frame header and footer [SME: 8183]
* Sat Nov 30 2013 Daniel Berteaud <daniel@firewall-services.com> 2.4.0-11.sme
- Remove the "swap interface" feature [SME: 7993]
* Sat Nov 30 2013 Daniel Berteaud <daniel@firewall-services.com> 2.4.0-10.sme
- Return nic names in probeAdapters so we can drop HWAddress [SME: 7991]
* Sat May 25 2013 Ian Wells <esmith@wellsi.com> 2.4.0-9.sme
- Correctly display accented letters in the console [SME: 7591]
by Filippo Carletti
* Sun May 05 2013 Ian Wells <esmith@wellsi.com> 2.4.0-8.sme
- Add e-smith as a Requires(pre) and remove adding users in %pre
- Fix uid and gid to be the same in create-system-user [SME: 7547]
* Sat Mar 9 2013 Shad L. Lords <slords@mail.com> 2.4.0-7.sme
- Ensure group www exists before user [SME: 7319]
* Wed Mar 6 2013 Shad L. Lords <slords@mail.com> 2.4.0-6.sme
- Fix pre script to make www and apache the same [SME: 7319]
* Tue Mar 5 2013 Daniel Berteaud <daniel@firewall-services.com> 2.4.0-5.sme
- Untaint variable in probeAdapters() [SME: 7416]
* Thu Feb 28 2013 Ian Wells <esmith@wellsi.com> 2.4.0-4.sme
- Improve error checking in isValidIP [SME: 7410]
* Sun Feb 24 2013 Daniel Berteaud <daniel@firewall-services.com> 2.4.0-3.sme
- Fix MAC detection for bond slaves [SME: 3596]
* Thu Jan 31 2013 Daniel Berteaud <daniel@firewall-services.com> 2.4.0-2.sme
- Stop using kudzu for NIC detection [SME: 3596]
* Fri Jan 25 2013 Shad L. Lords <slords@mail.com> 2.4.0-1.sme
- Bump version in prep for SME9
- Perl module rpms moved to /usr/share/perl5/vendor_perl [SME: 7223]
* Mon Oct 11 2010 Shad L. Lords <slords@mail.com> 2.2.0-7.sme
- Serialize configure_peers to prevent errors [SME: 5831]
* Fri Feb 5 2010 Stephen Noble <support@dungog.net> 2.2.0-6.sme
- adds the hwaddr parameter to probeAdapters() [SME: 4528]
* Thu Feb 4 2010 Shad L. Lords <slords@mail.com> 2.2.0-5.sme
- Update path for 64-bit compatibility [SME: 5756]
* Tue Dec 22 2009 Filippo Carletti <filippo.carletti@gmail.com> 2.2.0-4.sme
- Really apply previous patch in the spec file. [SME: 5659]
* Wed Dec 9 2009 Charlie Brady <charlieb@budge.apana.org.au> 2.2.0-3.sme
- Add patch (Federico Simoncelli) to prevent re-use of uids. [SME: 5659]
* Mon Oct 13 2008 Shad L. Lords <slords@mail.com> 2.2.0-2.sme
- Add patch to support multiple samba roles [SME: 4172]
* Tue Oct 7 2008 Shad L. Lords <slords@mail.com> 2.2.0-1.sme
- Roll new stream to separate sme7/sme8 trees [SME: 4633]
* Wed Aug 20 2008 Shad L. Lords <slords@mail.com> 1.19.0-1
- Roll new dev stream.
* Sat Aug 9 2008 Shad L. Lords <slords@mail.com> 1.18.0-28
- Read /dev/urandmon instead of /dev/random [SME: 4492]
* Sat Aug 9 2008 Shad L. Lords <slords@mail.com> 1.18.0-27
- Make dialog not use STDERR for return values [SME: 3663]
- Remove requires for whiptail. No longer needed [SME: 4491]
* Thu Jul 31 2008 Shad L. Lords <slords@mail.com> 1.18.0-26
- Make binmode properties of db class [SME: 4317]
- Add new navigation db & utf8 classes [SME: 4317]
* Wed Apr 2 2008 Shad L. Lords <slords@mail.com> 1.18.0-25
- Add .utf8 to locale unless server-console [SME: 4162]
- Add new languages to langtag2locale [SME: 4163]
* Sun Mar 30 2008 Shad L. Lords <slords@mail.com> 1.18.0-24
- Gracefully handle encoding errors in navigation dbs [SME: 4147]
* Wed Mar 26 2008 Shad L. Lords <slords@mail.com> 1.18.0-23
- Make PAM conv routine not look for english strings [SME: 4117]
* Tue Mar 25 2008 Shad L. Lords <slords@mail.com> 1.18.0-22
- Fix wide output to syslog and allow navigations db to be utf8 [SME: 4101]
* Mon Mar 10 2008 Shad L. Lords <slords@mail.com> 1.18.0-21
- Output navigation in UTF-8 [SME: 3858]
* Sun Jan 20 2008 Gavin Weight <gweight@gmail.com> 1.18.0-20
- Call smbpasswd -e - to reset user correctly. [SME: 3755]
* Tue Jan 08 2008 Stephen Noble <support@dungog.net> 1.18.0-19
- modify validate password strong match for console [SME: 2173]
* Thu Nov 01 2007 Gavin Weight <gweight@gmail.com> 1.18.0-18
- Fix I18N.pm file descriptor leak. [SME: 3509]
* Wed Oct 31 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-17
- Remove undocumented and unused template metadata handling from
generic_template_expand action (Take II). [SME: 2798]
* Fri Jun 1 2007 Shad L. Lords <slords@mail.com> 1.18.0-16
- pam_unix requires passwords >= 6 [SME: 3039]
* Mon May 21 2007 Shad L. Lords <slords@mail.com> 1.18.0-15
- Fix ip addr shift to work on 64-bit
* Sun Apr 29 2007 Shad L. Lords <slords@mail.com>
- Clean up spec so package can be built by koji/plague
* Thu Apr 05 2007 Shad L. Lords <slords@mail.com> 1.18.0-14
- Reverse changes for 1.18.0-12 as it is being used. [SME: 2838]
* Wed Apr 04 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-13
- Allow gauge console widget to be used without following message_page.
[SME: 2832].
* Mon Mar 26 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-12
- Remove undocumented and unused template metadata handling from
generic_template_expand action. [SME: 2798]
* Mon Mar 26 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-11
- Split logfile rotation code out of generic_template_expand.
Code moved to a new action in e-smith-base. [SME: 2795]
* Mon Mar 19 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-10
Don't try to read template.metadata from subdirectories (affects
initialize_database_defaults). [SME: 2690]
* Fri Mar 16 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-9
- Allow template.metadata to be provided via a directory of
small files. [SME: 2690]
- Add support for a DELETE boolean template.metadata item. [SME: 2691]
* Wed Feb 28 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-8
- Add gauge widget to esmith::console. [SME: 2579]
* Sun Feb 25 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-7
- Default infobox height to 8 rows, and allow override via params.
[SME: 2560]
* Fri Feb 23 2007 Shad L. Lords <slords@mail.com> 1.18.0-6
- Really fix clear parameter for inputbox dialog screen [SME: 2533]
* Fri Feb 23 2007 Shad L. Lords <slords@mail.com> 1.18.0-5
- Fix clear parameter for dialog screens [SME: 2533]
* Thu Feb 22 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-4
- switch esmith::console::password_page() to use dialog rather than
whiptail. [SME: 2534]
* Thu Feb 22 2007 Charlie Brady <charlie_brady@mitel.com> 1.18.0-3
- Add infobox widget. [SME: 2533]
* Sun Jan 28 2007 Shad L. Lords <slords@mail.com> 1.18.0-2
- Fix backtitle spacing for new dialog menus [SME: 2328]
* Fri Jan 26 2007 Shad L. Lords <slords@mail.com> 1.18.0-1
- Roll stable stream. [SME: 2328]
* Fri Dec 15 2006 Federico Simoncelli <federico.simoncelli@gmail.com> 1.17.0-8
Tue Dec 15 2006 --> Tue Dec 12 2006 or Fri Dec 15 2006 or Tue Dec 19 2006 or ....
- Added the validatePassword function to esmith::util. [SME: 2100]
* Thu Dec 07 2006 Shad L. Lords <slords@mail.com>
- Update to new release naming. No functional changes.
- Make Packager generic
* Fri Nov 24 2006 Gordon Rowell <gordonr@gormand.com.au> 1.17.0-06
- Allow optional path to peeers directory in
esmith::tcpsvd::configure_peers() [SME: 2086]
* Tue Nov 14 2006 Charlie Brady <charlie_brady@mitel.com> 1.17.0-05
- Allow defaulno option to esmith::console::yesno.
- Fix I/O redirection in esmith::console::new.
* Tue Nov 07 2006 Charlie Brady <charlie_brady@mitel.com> 1.17.0-04
- Allow display of "0" in iesmith::cgi::genSmallCell. [SME: 2038]
* Mon Oct 23 2006 Charlie Brady <charlie_brady@mitel.com> 1.17.0-03
- Make dialog the default console app, with whiptail used only when
required.
* Wed Oct 11 2006 Charlie Brady <charlie_brady@mitel.com> 1.17.0-02
- Allow 'dialog' to be called from esmith::console. [SME: 1958]
* Wed Oct 11 2006 Charlie Brady <charlie_brady@mitel.com> 1.17.0-01
- Roll development branch.
* Mon Sep 25 2006 Charlie Brady <charlie_brady@mitel.com> 1.16.0-06
- Fix problem with greedy RE in template.metadata parsing. [SME: 1906]
* Fri Sep 08 2006 Charlie Brady <charlie_brady@mitel.com> 1.16.0-05
- Fix taint problem in template.metadata handling. [SME: 1906]
* Thu Apr 13 2006 Charlie Brady <charlie_brady@mitel.com> 1.16.0-04
- Use "kudzu --probe --class network" for NIC detection. [SME: 727]
* Fri Apr 7 2006 Gordon Rowell <gordonr@gormand.com.au> 1.16.0-03
- Don't call smbpasswd -e - setting the password is sufficient [SME: 1193]
* Tue Mar 28 2006 Gordon Rowell <gordonr@gormand.com.au> 1.16.0-02
- Log previous contents of db entry in DELETE log [SME: 1066]
* Tue Mar 14 2006 Charlie Brady <charlie_brady@mitel.com> 1.16.0-01
- Roll to stable stream version number. [SME: 1016]
* Fri Mar 10 2006 Charlie Brady <charlie_brady@mitel.com> 1.15.4-02
- Suppress warning from genSmallCell if text is undefined. [SME: 986]
* Fri Feb 17 2006 Gordon Rowell <gordonr@gormand.com.au> 1.15.4-01
- Roll patches up to 1.15.3-42
- Trim changelog prior to 1.15.0-01 [SME: 828]
* Thu Feb 16 2006 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-42
- Adjust console title bar to 'SME Server' [SME: 726]
* Tue Feb 14 2006 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-41
- Reworded text for template-begin and change URL to /development/
rather than /custom/ [SME: 773]
* Mon Feb 13 2006 Charlie Brady <charlie_brady@mitel.com> 1.15.3-40
- Update URL in default template-begin fragment. [SME: 773]
* Sat Feb 11 2006 Charlie Brady <charlieb@e-smith.com> 1.15.3-39
- Remove obsolete e-smith-lib-Tai64n package. [SME: 689]
* Sat Feb 11 2006 Charlie Brady <charlieb@e-smith.com> 1.15.3-38
- [Null changelog for missing version - we accidentally skipped
this version.]
* Sat Feb 11 2006 Charlie Brady <charlieb@e-smith.com> 1.15.3-37
- Fix get_all_by_prop in scalar context. [SME: 669,721]
* Mon Feb 6 2006 Shad L. Lords <slords@mail.com> 1.15.3-37
- Add ability to pass many props to get_all_by_prop [SME: 669]
* Mon Jan 23 2006 Charlie Brady <charlieb@e-smith.com> 1.15.3-36
- Fix warning during pseudonym deletion. [SME: 491]
* Fri Jan 20 2006 Charlie Brady <charlieb@e-smith.com> 1.15.3-35
- Fix up use of Sys::Syslog::syslog. [SME: 526]
* Thu Jan 19 2006 Charlie Brady <charlieb@e-smith.com> 1.15.3-34
- Remove running of kudzu during NIC probing. TODO: Find a solution
to system reconfiguration when new hardware is added. [SME: 192]
* Tue Jan 10 2006 Charlie Brady <charlieb@e-smith.com> 1.15.3-33
- Fold a.b.c.d/255.255.255.255 to a.b.c.d in local_access_spec() to
work around bugs in applications which don't accept such specs.
[SME: 430]
* Mon Jan 9 2006 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-32
- Check whether an accounts db record exists before trying to create
the dot and underscore pseudonyms (new_record will fail silently)
and check that the records are pseudonyms before deleting them [SME: 24]
* Mon Jan 9 2006 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-31
- And update POD for last change [SME: 24]
* Mon Jan 9 2006 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-30
- Allow dot and underscore in account names [SME: 24]
* Tue Dec 27 2005 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-29
- Remove newlines from cluck() string and just note that the old
path was used [SME: 365]
* Sun Dec 25 2005 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-28
Sat Dec 25 2005 --> Sat Dec 24 2005 or Sun Dec 25 2005 or Sat Dec 31 2005 or ....
- If db exists in both the old and new locations in
initialize_default_databases, rename the one in the new
location to db.time(), avoiding the conflict and saving the
evidence in case it is needed later [SME: 229]
* Mon Dec 05 2005 Mark Knox <mark_knox@mitel.com>
- [1.15.3-27]
- Moved queueing logic to separate daemon, replaced with FIFO IPC [BZ252
* Thu Dec 01 2005 Mark Knox <mark_knox@mitel.com>
- [1.15.3-26]
- Added event queueing (open source portion) for clustered systems [BZ250]
* Wed Nov 30 2005 Gordon Rowell <gordonr@gormand.com.au> 1.15.3-25
- Bump release number only
* Thu Nov 24 2005 Gordon Rowell <gordonr@e-smith.com>
- [1.15.3-24]
- Add missing 'use Locale::gettext' to esmith::console.pm [MN00108804]
* Sun Nov 20 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-23]
- Clarify logic for stopped services in adjust-services. [SF: 1357629]
* Sun Nov 20 2005 Gordon Rowell <gordonr@e-smith.com>
- [1.15.3-22]
- Correct adjust-services logic for stopped services [SF: 1357629]
* Wed Nov 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-21]
- Allow services2adjust directories to contain files rather than just dangling
symlinks. Files can contain more than one actions to perform. [SF: 1270644]
* Wed Nov 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-20]
- Also don't start services if we just want to "once" them. [SF: 1357629]
* Wed Nov 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-19]
- Fix restart of enabled supervised services which we are attempting to stop.
[SF: 1357629]
* Tue Nov 15 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-18]
- Set default for $type in esmith::cgi::genSmallCell, to prevent some log
noise. [SF: 1357830]
* Tue Nov 15 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-17]
- Pass $EVENT to template expansions in generic_template_expand.
[SF: MN00106104]
* Tue Nov 15 2005 Gordon Rowell <gordonr@e-smith.com>
- [1.15.3-16]
- Redirect esmith::config calls on old db paths to the new
location [SF: 1335865]
* Thu Oct 27 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-15]
- Fix a few minor spec file portability issues. [SF: 1339729]
* Wed Oct 26 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-14]
- Add it and de to the langtag2locale fixups. [SF: 1338236]
* Tue Oct 11 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-13]
- Build driver list from .ko files as well as .o files. Untaint driver
names while building list. [SF: 1323270]
* Mon Sep 26 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-12]
- Fix "defaults" handling so that values which evaluate to false are
not overridden by default. [SF: 1303885]
* Fri Sep 23 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-11]
- Untaint db names before attempting to move them. [MN00098405]
* Thu Sep 22 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-10]
- Provide networks method in esmith::NetworksDB. [SF: 1296099]
- Support a "localhost" configuration in esmith::tcpsvd:configure_peers
[SF: 1294719]
* Tue Sep 20 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-09]
- Remove deprecated functions from esmith::utils. [SF: 1295851]
- Include only "network" records in local_access_spec. [SF: 1296099]
* Mon Sep 12 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-08]
- Remove warning about explicit path in esmith::db::_db_path.
[SF: 1286294]
* Fri Sep 9 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-07]
- Tolerate, but warn about, symlinks in /home/e-smith. [SF: 1216546]
* Fri Sep 9 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-06]
- Reduce the noise from _file_path() in esmith::DB::db. [SF: 1286294]
* Wed Sep 7 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-05]
- Fix operation of expandTemplate when taint check is enabled.
[SF: 1284301]
* Wed Aug 17 2005 Mark Knox <markk@e-smith.com>
- [1.15.3-04]
- Added open_local and open_ro_local methods for clustering [markk MN00094831]
* Tue Aug 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-03]
- Fix POD error in util.pm.
* Wed Jul 27 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-02]
- Move databases default location from /home/e-smith to /home/e-smith/db.
During esmith::utils::initialize_default_databases, move from old to new
location before doing db migrate actions. [SF: 1216546]
* Wed Jul 27 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.3-01]
- Roll a new development stream - 1.15.3
* Wed Jul 27 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.2-04]
- Remove broken MergeDB stuff. [SF: 1246315]
* Wed Jul 27 2005 Mark Knox <markk@e-smith.com>
- [1.15.2-03]
- Fixed misleading comment in util.pm
- Added 'use' statements in Record classes for SOAP compatibility
- Fixed undefined max_len warning
- Added explicit writeconf calls in db::Record.pm, needed for setting props
via SOAP
* Tue Jul 19 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.2-02]
- Allow db open API to use default path if a simple filename
is provided as arg. This is preparation for move of dbs to
/home/e-smith/db. Patch by Shad Lords.
* Mon Jul 18 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.2-01]
- Roll new development stream - 1.15.2
* Fri Jul 15 2005 Mark Knox <markk@e-smith.com>
- [1.15.1-44]
- Tweak to allow calling _writeconf from SOAP [markk MN00090738]
* Tue Jun 21 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-43]
- Ensure that esmith::util::LdapPassword returns bare string without
newline terminator.
* Sun Jun 12 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-42]
- Remove .rpmsave and .rpmnew symlinks (as well as files). [SF: 1217969]
- Handle missing description in pcitables entries.
* Sun Jun 12 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-41]
- Provide feedback (via log messages) from services2adjust. [SF: 1218920]
* Mon May 30 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-40]
- Add preinstall scripting to create required accounts/groups if they
don't already exist. [SF: 1210723]
* Thu May 5 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-39]
- Show Text::Template error text rather than inappropriate $! if template
expansion fails.
- Change error to warning if a config item is set with an empty "type"
property.
* Thu May 5 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-38]
- Fix esmith::DB::get_prop_and_delete fail if prop is "false" [From Gordon].
* Tue May 3 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-37]
- Update directory list so that ethernet drivers from kernel-unsupported are
added to "choose by driver" list.
* Sat Mar 19 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-36]
- Rework esmith::tcpsvd::configure_peers so that it doesn't chdir.
- Fix generic_template_expand so that templates.metadata doesn't
need to set OUTPUT_FILENAME is TEMPLATE_PATH is changed. This
matches what expand-template already does.
* Fri Mar 18 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-35]
- Change numerous calls to "croak" in esmith::template
to "carp ...; return", so that problem with any single
template expansion doesn't terminate calling program.
[MN00075009]
* Wed Mar 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-34]
- Add missing "use esmith::util" in esmith::tcpsvd.
* Wed Mar 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-33]
- Add esmith::tcpsvd library for managing tcpsvd "peers"
directories.
* Mon Mar 14 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-32]
- Make template expansion message more succinct.
* Thu Mar 10 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-31]
- Remove pseudonyms of pseudonyms when removing user
accounts. Adapted from patch submitted by Shad. [MN00039941]
* Wed Feb 23 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-30]
- Fix incompatibility with CentOS's CGI.pm.
* Tue Feb 22 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-29]
- Fix bug in output to empty file when FILTER is used
during template expansion. [charlieb MN00050075]
* Tue Feb 22 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-28]
- Refresh contents of /etc/sysconfig/hwconf before listing
network adaptors [MN00069993]
- Fix typo in documentation of esmith::DB::db - reported from Tanna -
http://www.livejournal.com/users/gcrumb/61169.html (thanks Dan!)
* Wed Feb 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-27]
- Fix typo. [MN00066059]
* Wed Feb 16 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-26]
- Use /sbin/e-smith/whiptail if it is available. [MN00066059]
* Mon Feb 7 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-25]
- Update perms and ownership when expanding templates, regardless of
whether file content has changed or not. [MN00068043]
* Wed Feb 2 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-24]
- Fix the insertion of implicit actions into sorted action list in
event.pm. Problem was perl syntax ambiguity. [MN00066406]
* Fri Jan 28 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-23]
- Really move /home/e-smith/* to e-smith-base. [MN00066635]
* Fri Jan 28 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-22]
- Move /home/e-smith/* to e-smith-base. [MN00066635]
- Move generic-template expand to S05 position in sort, and
adjust-service to S90. Fix run-time error. [MN00066406]
- Don't attempt to execute non-executable action scripts.
* Thu Jan 27 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-21]
- Implicitly include template expand and services adjust actions
in each event if the respective metadata directory exists.
[MN00066406]
* Tue Jan 25 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-20]
- Add "adjust" to list of verbs which serviceControl groks,
to allow for "masq adjust". [MN00065576]
* Tue Jan 25 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-19]
- Add adjust-services generic action script [MN00065576]
* Tue Jan 18 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-18]
- Fix typo. [MN00064412]
- Improve die() message in esmith::config::STORE. [MN00064394]
* Mon Jan 17 2005 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-17]
- Fix broken logging (and reduce logging) in initialize_default_databases.
[MN00064412]
- Fix inappropriate use of global $_ in initialize_default_databases.
[MN00064415]
* Thu Dec 23 2004 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-16]
- Read templated file metadata (if any) from file tree under
/etc/e-smith/templates.metadata. Update expand-template to
use current API. [MN00061830]
* Tue Dec 14 2004 Mark Knox <markk@e-smith.com>
- [1.15.1-15]
- Change copyright date to 2004 [markk MN00060958]
* Fri Nov 5 2004 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-14]
- Fix Authen::PAM dependency header [charlieb MN00040240]
- Use kudzu's generated /etc/sysconfig/hwconf file for NIC detection
[charlieb MN00056220]
* Thu Oct 14 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-13]
- Updated esmith::ethernet's search code to remove File::Find, as it doesn't
get along with taint checking. [msoulier MN00052510]
* Wed Oct 13 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-12]
- Updated esmith::ethernet's search code such that is it more adaptable, and
recurses the directories given. [msoulier MN00052510]
* Wed Oct 13 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-11]
- Updated esmith::ethernet's search paths for network drivers.
[msoulier MN00052510]
* Mon Oct 4 2004 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-10]
- Remove dependency on perl(Filter::Handle) [charlieb MN00050075]
* Fri Sep 24 2004 Charlie Brady <charlieb@e-smith.com>
- [1.15.1-09]
- Updated requires with new perl dependencies. [msoulier MN00040240]
- Remove "AutoReqProv: no" so that "Provides" headers are auto-generated.
[charlieb MN00040240]
- Remove anachronistic "require v5.6.0" directives. [charlieb MN00050370]
- Avoid use of Filter::Handle in esmith::template. [charlieb MN00050075]
* Fri Aug 27 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-08]
- Added esmith::util::network::isValidEmail function. [msoulier MN00023814]
* Thu Aug 26 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-07]
- Added svdisable to permissible actions in serviceControl.
[msoulier MN00043056]
* Tue Aug 10 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-06]
- Fixed new methods. Bad else case. [msoulier MN00044891]
* Fri Aug 6 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-05]
- Added a keys() method. [msoulier MN00041968]
* Fri Aug 6 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-04]
- Added set_prop and set_value methods in esmith::DB. [msoulier MN00044891]
* Tue Jul 20 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-03]
- Undeprecated esmith::util::serviceControl. [msoulier MN00043056]
* Fri Jun 25 2004 Tony Clayton <apc@e-smith.com>
- [1.15.1-02]
- Merge language_tag2locale() function from perl-I18N-LangTags [tonyc
MN00040170]
* Fri May 28 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.1-01]
- Rolling to collect patches.
* Fri May 28 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-23]
- Reordered the create code slightly to catch more errors.
[msoulier MN00035059]
* Fri May 28 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-22]
- Added yet more error handling and reporting. [msoulier MN00035059]
* Fri May 28 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-21]
- Fixed one $Error reference that I missed in the last rev.
[msoulier MN00035059]
* Fri May 28 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-20]
- Moved error handling from esmith::DB::db to esmith::DB, since it should not
be database implementation specific. [msoulier MN00035059]
* Fri May 28 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-19]
- Propagated migration failures up to calling code for reporting to syslog.
- Propagated creation failures up to calling code.
- Moved lexicon $Error in esmith::DB::db to a class property so it can be used
by subclasses. [msoulier MN00035059]
* Thu May 27 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-18]
- Changed print statements to calls to the logger. [msoulier MN00035059]
* Thu May 27 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-17]
- Added print statements to initialize-default-databases for post-install
debugging. [msoulier MN00035059]
* Fri May 7 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-16]
- Fixed migrate to report the caught error message. [msoulier MN00032503]
* Thu May 6 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-15]
- Added isValidHostname function to esmith::util::network.
[msoulier MN00024212]
* Fri Feb 13 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-14]
- Greatly simplified the _mysystem function by ripping out open3.
[msoulier dpar-20385]
* Fri Feb 13 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-13]
- Backed-out change in esmith::util, as it's non-trivial there with the exec.
Completed update of esmith::event, and separated the esmith::Logger class.
[msoulier dpar-20385]
* Fri Feb 13 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-12]
- Removed use of the logger entirely, replacing it with an abstracted
interface to the Sys::Syslog module. [msoulier dpar-20385]
* Thu Jan 8 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-11]
- Fixed esmith::util::network::isValidIP() so valid IP substrings no longer
return true values. [msoulier 9308]
* Thu Jan 8 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-10]
- Added a check in STORE in esmith::config for invalid attempts to set a value
without a type. Also escalated previous warnings for undef key and value to
fatal exceptions. [msoulier 7386]
* Thu Jan 8 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-09]
- Now trimming whitespace around keys and values during esmith::config STORE
events, to prevent invalid keys and values from being saved. [msoulier 7021]
* Mon Jan 5 2004 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-08]
- Fixed POD around merge_props. [msoulier 9482]
* Fri Nov 7 2003 Tony Clayton <apc@e-smith.com>
- [1.15.0-07]
- And again [tonyc 10569]
* Fri Nov 7 2003 Tony Clayton <apc@e-smith.com>
- [1.15.0-06]
- Change Merge API a bit, fix pod [tonyc 10569]
* Fri Nov 7 2003 Tony Clayton <apc@e-smith.com>
- [1.15.0-05]
- Add esmith::DB::Merge library [tonyc 10569]
* Fri Oct 10 2003 Michael Soulier <msoulier@e-smith.com>
- [1.15.0-04]
- Fixed AccountsDB.pm to handle group names with hyphens and periods, to match
the error message in the groups panel, and the rest of the group/user
behaviour. [msoulier 10236]
* Sun Sep 21 2003 Charlie Brady <charlieb@e-smith.com>
- [1.15.0-03]
- Skip any directries when iterating over action scripts in esmith::event.
Add logfile timestamp symlinking to generic_template_expand action.
Use templates2expand and logfiles2timestamp subdirectories of the event
directory. Fix shebang line. [charlieb 10035]
* Thu Sep 18 2003 Charlie Brady <charlieb@e-smith.com>
- [1.15.0-02]
- Add generic_template_expand action. [charlieb 10035]
* Thu Sep 18 2003 Charlie Brady <charlieb@e-smith.com>
- [1.15.0-01]
- Changing version to development stream number - 1.15.0
%prep
%setup
%pre
%post
%build
for event in post-install post-upgrade bootstrap-console-save console-save
do
mkdir -p root/etc/e-smith/events/$event
done
perl createlinks
find root/ -type f | xargs grep -l ____COPYYEARS____ | xargs sed -i -e 's/____COPYYEARS____/%{copykooz}/g'
%install
rm -rf $RPM_BUILD_ROOT
(cd root ; find . -depth -print | cpio -dump $RPM_BUILD_ROOT)
rm -f %{name}-%{version}-%{release}-filelist
/sbin/e-smith/genfilelist $RPM_BUILD_ROOT \
>%{name}-%{version}-%{release}-filelist
echo "%doc Copying" >> %{name}-%{version}-%{release}-filelist
echo "%doc Artistic" >> %{name}-%{version}-%{release}-filelist
echo "%doc LICENSE" >> %{name}-%{version}-%{release}-filelist
%clean
rm -rf $RPM_BUILD_ROOT
%files -f %{name}-%{version}-%{release}-filelist
%defattr(-,root,root)

View File

@ -0,0 +1,3 @@
{
$DB = esmith::ConfigDB->open(${DB_FILENAME});
}

View File

@ -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';
# bring the service up if it is enabled (and we're not stopping it or running it once, or using signal able to start it)
unshift(@actions,'start') if ($enabled && !grep { /^(down|stop|d|once|o|start|restart|reload-or-restart)$/ } @actions) ;
# stop the service if it is disabled
@actions = ('stop') unless $enabled;
foreach (@actions)
{
warn "adjusting non-supervised $service ($_)\n";
esmith::util::serviceControl(
NAME => $service,
ACTION => $_,
);
}
}
}

View File

@ -0,0 +1,61 @@
#! /usr/bin/perl -w
#----------------------------------------------------------------------
# copyright (C) 2003-2007 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
#
#----------------------------------------------------------------------
use strict;
use File::Find;
use File::Copy;
use esmith::templates;
sub expand;
my $event = shift or die "Event name is required\n";
my $filename;
my %args;
my ($param, $value);
my $templates_dir = "/etc/e-smith/events/$event/templates2expand";
exit 0 unless -d $templates_dir;
chdir $templates_dir or die "Could not chdir to $templates_dir: $!\n";;
# Walk the tree and expand all templates referenced thereunder.
find({
no_chdir => 1,
follow => 0,
wanted => \&expand,
},
'.'
);
exit 0;
sub expand
{
return unless -f $_;
# For each file found, read the file to find
# processTemplate args, then expand the template
s/^\.//;
$filename = $_;
warn "expanding $filename\n";
esmith::templates::processTemplate({
MORE_DATA => { EVENT => $event },
TEMPLATE_PATH => $filename,
OUTPUT_FILENAME => $filename,
});
}

View File

@ -0,0 +1,35 @@
#!/usr/bin/perl -w
#----------------------------------------------------------------------
# copyright (C) 1999-2003 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
#
# Technical support for this program is available from Mitel Networks
# Please visit our web site www.mitel.com/sme/ for details.
#----------------------------------------------------------------------
package esmith;
use strict;
use esmith::util;
if (esmith::util::initialize_default_databases())
{
exit 0;
}
else
{
exit 1;
}

View File

View File

@ -0,0 +1,10 @@
#------------------------------------------------------------
# !!DO NOT MODIFY THIS FILE!!
#
# Manual changes will be lost when this file is regenerated.
#
# Please read the developer's guide, which is available
# at http://www.contribs.org/development/
#
# Copyright (C) 1999-2006 Mitel Networks Corporation
#------------------------------------------------------------

View File

@ -0,0 +1,13 @@
{
$OUT = <<HERE;
<!--
HERE
$OUT .=
Text::Template::_load_text("/etc/e-smith/templates-default/template-begin");
$OUT .= <<HERE;
-->
HERE
}

View File

@ -0,0 +1,8 @@
{
$OUT = <<HERE;
#%PAM-1.0
HERE
$OUT .=
Text::Template::_load_text("/etc/e-smith/templates-default/template-begin");
}

View File

@ -0,0 +1,8 @@
{
$OUT = <<HERE;
#!/usr/bin/perl -w
HERE
$OUT .=
Text::Template::_load_text("/etc/e-smith/templates-default/template-begin");
}

View File

@ -0,0 +1,14 @@
{
$OUT = <<HERE;
<?php
/*
HERE
$OUT .=
Text::Template::_load_text("/etc/e-smith/templates-default/template-begin");
$OUT .= <<HERE;
*/
HERE
}

View File

@ -0,0 +1,8 @@
{
$OUT = <<HERE;
#!/bin/sh
HERE
$OUT .=
Text::Template::_load_text("/etc/e-smith/templates-default/template-begin");
}

View File

@ -0,0 +1 @@
?>

View File

@ -0,0 +1,81 @@
# DO NOT MODIFY THIS FILE.
# This file is automatically maintained by the Mitel Networks SME Server
# configuration software. Manually editing this file may put your
# system in an unknown state.
#
# updated: Thu Mar 28 15:29:31 2002
Bart.Simpson=pseudonym|Account|bart
Bart_Simpson=pseudonym|Account|bart
Global=system
Primary=system
adm=system|Gid|4|Uid|3
admin=system|Gid|101|Uid|101
alias=system|Gid|400|Uid|400
apache=existing|Gid|48|Uid|48
bart=user|FirstName|Bart|LastName|Simpson
bin=system|Gid|1|Uid|1
cdrom=system
cgi-bin=url
console=system
daemon=system|Gid|2|Uid|2
dip=system|Gid|40
disk=system|Gid|6
dns=existing|Gid|53|Uid|53
e-smith-manager=url
e-smith-password=url
everyone=pseudonym|Account|shared|Visible|internal
floppy=system|Gid|19
ftp=system|Gid|50|Uid|14
games=system|Gid|20|Uid|12
global=system
gopher=system|Gid|30|Uid|13
halt=system
homes=system
kmem=system|Gid|9
ldap=existing|Gid|55|Uid|55
lp=system|Gid|7|Uid|4
mail=system|Gid|12|Uid|8
mailer-daemon=pseudonym|Account|admin
man=system|Gid|15
mem=system|Gid|8
mysql=existing|Gid|27|Uid|27
named=existing|Gid|25|Uid|25
netlogon=netlogon|Comment|placeholder for netlogon share
news=system|Gid|13|Uid|9
nofiles=system|Gid|400
operator=system|Gid|0|Uid|11
postgres=system
postmaster=pseudonym|Account|admin
primary=system
printers=system
public=system|Gid|103|Uid|102
qmail=system|Gid|401
qmaild=system|Gid|400|Uid|401
qmaill=system|Gid|400|Uid|402
qmailp=system|Gid|400|Uid|403
qmailq=system|Gid|401|Uid|404
qmailr=system|Gid|401|Uid|405
qmails=system|Gid|401|Uid|406
qmailscan=existing|Gid|407|Uid|407
root=system|Gid|0|Uid|0
schwern=user|Uid|500|Gid|501|FirstName|Michael|LastName|Schwern
server-manager=url
server-manual=url
shared=system|Gid|500|Visible|internal
shutdown=system
simpsons=group|Description|bar|Gid|5005|Members|bart,lisa,homer,maggie|Uid|5005
slocate=system
somegroup=group|Gid|42|Members|admin
squid=system|Gid|23|Uid|23
sync=system
sys=system|Gid|3
trend=existing|Gid|408|Uid|408
tty=system|Gid|5
user-password=url
users=system|Gid|100
utmp=system|Gid|22
uucp=system|Gid|14|Uid|10
webmail=url
wheel=system|Gid|10
www=system|Gid|102|Uid|100
wwwpublic=system

View File

@ -0,0 +1,95 @@
#!/usr/bin/perl -w
# Overall tests for esmith::config
use strict;
use File::Copy;
use Test::More 'no_plan';
use_ok('esmith::config');
my %Expect = ( foo => 'bar',
'this key' => 'has whitespace',
'that key ' => 'has trailing whitespace',
' another key' => 'has leading whitespace',
'this value' => ' has leading whitespace',
'that value' => 'has trailing whitespace ',
'tricky value' => 'with=equals.',
);
# so we don't bork the original.
my $Scratch = '10e-smith-lib/mydummy.conf';
copy('10e-smith-lib/dummy.conf', $Scratch);
END { unlink $Scratch }
my %config;
tie %config, 'esmith::config', $Scratch;
ok( tied %config, 'tie worked' );
is_deeply( \%config, \%Expect, 'read in the config properly' );
# Test the tied interface.
is_deeply( [sort keys %config], [sort keys %Expect], 'keys' );
is_deeply( [sort values %config], [sort values %Expect], 'values' );
is_deeply( [@config{'foo', 'this key'}], [@Expect{'foo', 'this key'}],
'hash slice');
$config{foo} = 'baz';
is( $config{foo}, 'baz', 'STORE' );
my %config_copy;
tie %config_copy, 'esmith::config', $Scratch;
is( $config_copy{foo}, 'baz', ' STORE saved' );
SKIP: {
skip "Locking is broken in perl 5.6.0", 2 if $] eq 5.006;
tied(%config_copy)->_lock_write;
my $start_time = time;
{
local $ENV{PERL5LIB} = join ':', @INC;
system(qq{$^X -Mesmith::config -e 'alarm 4; tie %config, "esmith::config", q{$Scratch}'});
}
cmp_ok( time - 2, '<=', $start_time, 'write locks dont prevent read' );
tied(%config_copy)->_lock_write;
$start_time = time;
{
local $ENV{PERL5LIB} = join ':', @INC;
system(qq{$^X -Mesmith::config -e 'alarm 4; tie %config, "esmith::config", q{$Scratch}; \$config{foo} = 42'});
}
cmp_ok( time - 1, '>=', $start_time, 'write locks prevent writes' );
};
my $new_conf = 'I_dont_exist';
unlink $new_conf;
ok( !-e $new_conf, 'config file doesnt exist' );
END { unlink $new_conf }
tie %config, 'esmith::config', $new_conf;
is( keys %config, 0, 'new() from nonexistent config' );
$config{wibble} = 'wobble';
tie %config_copy, 'esmith::config', $new_conf;
is( $config_copy{wibble}, 'wobble', ' new config file written' );
SKIP: {
skip "Locking is broken in perl 5.6.0", 1 if $] eq 5.006;
# There was a bug where if you set something to its existing value
# it wouldn't unlock properly.
my $Alarm;
eval {
local $SIG{ALRM} = sub { $Alarm = 1; die "ALARM!\n"; };
alarm 1;
$config_copy{wibble} = $config_copy{wibble};
$config{wibble} = 42;
alarm 0;
};
ok( !$Alarm, 'Unlocking works for setting the same value' );
};

View File

@ -0,0 +1,13 @@
#!/usr/bin/perl -Tw
use strict;
use esmith::config;
use Test::More tests => 2;
my %config;
tie %config, 'esmith::config', '10e-smith-lib/dummy.conf';
my $value = $config{foo};
# Config values *should* be tained, but code depends on them not being.
is( $value, 'bar', 'tied to the dummy database' );
ok( eval { () = join('', $value), kill 0; 1; }, 'config values not tainted' );

View File

@ -0,0 +1,103 @@
# DO NOT MODIFY THIS FILE.
# This file is automatically maintained by the Mitel Networks SME Server
# configuration software. Manually editing this file may put your
# system in an unknown state.
#
# updated: Fri Feb 28 16:41:34 2003
AccessType=dedicated
ActiveAccounts=0
AdminEmail=
ConsoleMode=login
ContactEmail=
ContactName=
ContactOrg=
DialupConnOffice=long
DialupConnOutside=long
DialupConnWeekend=long
DialupFreqOffice=every15min
DialupFreqOutside=everyhour
DialupFreqWeekend=everyhour
DialupModemDevice=/dev/ttyS1
DialupPhoneNumber=
DialupUserAccount=useraccount
DialupUserPassword=userpassword
DomainName=e-smith.com
DynDnsAccount=dnsaccount
DynDnsPassword=dnspassword
DynDnsService=off
EmailUnknownUser=return
EthernetDriver1=pcnet32
EthernetDriver2=unknown
ExternalDHCP=off
ExternalNetmask=255.255.255.0
GatewayIP=192.168.16.1
LocalIP=192.168.16.228
LocalNetmask=255.255.255.0
MinUid=5000
PasswordSet=yes
PreviousConfiguration=/home/e-smith/db/configuration.previous
SMTPSmartHost=
SambaDomainMaster=no
SambaServerName=pretz
SambaWorkgroup=mitel-networks
ServiceAccountId=
ServiceDomainName=
ServiceTargetIP=
SquidParent=
SquidParentPort=
StatusReports=off
SystemMode=serveronly
SystemName=pretz
TimeZone=US/Eastern
UnsavedChanges=yes
atalk=service|InitscriptOrder|91|status|enabled
auth=service|access|public|status|enabled
bazbar=service|status|enabled
blades=service|Host|service.e-smith.com|status|enabled
bootstrap-console=service|InitscriptOrder|35|Run|no|status|enabled
branding=service|modified|000000000000|status|enabled
crond=service|InitscriptOrder|40|status|enabled
ctrlaltdel=service|status|enabled
dhcpd=service|InitscriptOrder|65|end|192.168.16.250|start|192.168.16.65|status|disabled
diald=service|InitscriptOrder|57|status|disabled
fetchmail=service|FreqOffice|every5min|FreqOutside|every30min|FreqWeekend|never|Method|standard|SecondaryMailAccount|popaccount|SecondaryMailPassword|poppassword|SecondaryMailServer|mail.myisp.xxx|status|disabled
flexbackup=backupservice|erase_rewind_only|true
ftp=service|access|private|accessLimits|off|status|enabled
hdparm=service|InitscriptOrder|40|status|disabled
horde=service|status|disabled
httpd-admin=service|InitscriptOrder|86|status|enabled
httpd-e-smith=service|InitscriptOrder|85|access|private|status|enabled
imap=service|access|private|status|enabled
imp=service|status|disabled
ippp=service|InitscriptOrder|55|status|enabled
ipsec=service|InitscriptOrder|90|PubKey|0sAQOoIKaOMuDqSdCZJXgv9QI86DAuAwbbvn8uoKn2lRQ9ZVPTn9Ow5znhuw/GopsYD2eujhtvkQo7fszAhWbEpn+lW2LzLCbZYaDov7j8Q9CpeJSVgeuzaBcw3OenSL3ltTwWWtG0pvyaYsfepNqVYvo64YVmrxo0O7dCECySMVBZkQ==|status|disabled
isdn=service|Protocol|2|UseSyncPPP|yes|status|disabled
keytable=service|InitscriptOrder|25|status|enabled
ldap=service|InitscriptOrder|80|access|private|defaultCity|Ottawa|defaultCompany|XYZ Corporation|defaultDepartment|Main|defaultPhoneNumber|555-5555|defaultStreet|123 Main Street|status|enabled
lilo=service|AddressMode|linear
local=service|InitscriptOrder|99|status|enabled
lpd=service|InitscriptOrder|60|status|enabled
mariadb=service|InitscriptOrder|90|status|enabled
masq=service|InitscriptOrder|06|Logging|none|Stealth|no|status|disabled
modSSL=service|status|enabled
mysql.init=service|InitscriptOrder|99|status|enabled
named=service|chroot|yes|status|enabled|Forwarder1|1.2.3.4
network=service|InitscriptOrder|10|status|enabled
ntpd=service|InitscriptOrder|55|status|disabled
php=service|status|enabled
popd=service|access|private|status|enabled
pppoe=service|DemandIdleTime|no|InitscriptOrder|57|SynchronousPPP|no|status|disabled
pptpd=service|sessions|10|status|disabled
qmail=service|InitscriptOrder|80|status|enabled
random=service|InitscriptOrder|20|status|enabled
rsyslog=service|InitscriptOrder|05|status|enabled
scanner=service|ScannerFns|iscan|UpdateTime|1:14|scanMail|yes|status|enabled
smb=service|InitscriptOrder|91|RoamingProfiles|no|status|enabled
smtpd=service|access|public|status|enabled
smtpfwdd=service|InitscriptOrder|81|status|enabled
squid=service|InitscriptOrder|90|status|enabled
sshd=service|InitscriptOrder|85|PasswordAuthentication|yes|PermitRootLogin|yes|access|private|status|enabled
sync=service|Host|service.e-smith.com|LastId|0|SuccessId|0|SyncFrequency|1|SyncMinute|57|status|disabled
telnet=service|access|private|status|disabled
wibble=42
xinetd=service|InitscriptOrder|50|status|enabled

View File

@ -0,0 +1,215 @@
#!/usr/bin/perl -w
# Overall test for esmith::db
use File::Copy;
use esmith::TestUtils;
use Test::More 'no_plan';
use_ok('esmith::db');
my %Expect = (
Foo => ['Bar', {}],
Night => ['Day', {}],
Squid => ['cephalopod', {
arms => 10,
species => 'Loligo',
}
],
# Ensure that empty values are read in properly.
Octopus => ['cephalopod', {
arms => 8,
species => '',
}
],
# Ensure that escaped pipes are read in properly.
Pipe => ['art', { pipe => 'this is not a \| got that?'}],
# Ensure that escaped newlines are handled properly.
Haiku => ['poem', { words =>
"Damian Conway\n".
"God damn! Damian Conway\n".
"Damian Conway"
}
]
);
my $Scratch_Conf = '10e-smith-lib/db_scratch.conf';
copy '10e-smith-lib/db_dummy.conf', $Scratch_Conf;
END { unlink $Scratch_Conf }
my %config;
tie %config, 'esmith::config', $Scratch_Conf;
ok( tied %config, 'tied to the dummy config file' );
isnt( keys %config, 0, ' and theres something in there' );
is( db_get_type(\%config, 'Foo'), 'Bar', 'simple db_get_type' );
my @keys = db_get(\%config);
is_deeply( [sort @keys], [sort keys %Expect],
'db_get() all keys' );
foreach my $key (@keys) {
my($type, %properties) = db_get(\%config, $key);
my($exp_type, $exp_properties) = @{$Expect{$key}};
is( $type, $exp_type, "db_get - type - $key" );
is( db_get_type(\%config, $key), $exp_type, "db_get_type" );
is_deeply( \%properties, $exp_properties, "db_get - prop" );
is_deeply( {db_get_prop(\%config, $key)}, $exp_properties,
"db_get_prop - all properties");
while( my($prop, $val) = each %properties ) {
is( db_get_prop(\%config, $key, $prop), $val,
"db_get_prop - single prop - $prop");
}
}
is( db_get_type(\%config, 'I_dont_exist'), undef,
'db_get_type on non-existent key' );
is( db_get_prop(\%config, 'I_dont_exist'), undef,
' db_get_prop' );
is( db_get_prop(\%config, 'Squid', 'feet'), undef,
'db_get_prop on non-existent prop' );
is( db_delete_prop(\%config, 'I_dont_exist', 'feet'), undef,
'db_delete_prop on non-existent key' );
is( db_get(\%config, 'Squid'), 'cephalopod|arms|10|species|Loligo',
'db_get a raw value');
{
package TieOut;
sub TIEHANDLE {
bless( \(my $scalar), $_[0]);
}
sub PRINT {
my $self = shift;
$$self .= join('', @_);
}
sub read {
my $self = shift;
return substr($$self, 0, length($$self), '');
}
}
my $out = tie *STDOUT, 'TieOut';
db_show(\%config);
is( $out->read, <<SHOW, 'db_show() all' );
Foo=Bar
Haiku=poem
words=Damian Conway\nGod damn! Damian Conway\nDamian Conway
Night=Day
Octopus=cephalopod
arms=8
species=
Pipe=art
pipe=this is not a \\| got that?
Squid=cephalopod
arms=10
species=Loligo
SHOW
db_show(\%config, 'Squid');
is( $out->read, <<SHOW, 'db_show() one key' );
Squid=cephalopod
arms=10
species=Loligo
SHOW
db_print(\%config);
is( $out->read, <<PRINT, 'db_print all' );
Foo=Bar
Haiku=poem|words|Damian Conway\nGod damn! Damian Conway\nDamian Conway
Night=Day
Octopus=cephalopod|arms|8|species|
Pipe=art|pipe|this is not a \\| got that?
Squid=cephalopod|arms|10|species|Loligo
PRINT
db_print(\%config, 'Squid');
is( $out->read, <<PRINT, 'db_print one key' );
Squid=cephalopod|arms|10|species|Loligo
PRINT
db_print_type(\%config);
is( $out->read, <<PRINT_TYPE, 'db_print_type all keys' );
Foo=Bar
Haiku=poem
Night=Day
Octopus=cephalopod
Pipe=art
Squid=cephalopod
PRINT_TYPE
db_print_type(\%config, 'Squid');
is( $out->read, <<PRINT_TYPE, 'db_print_type one key' );
Squid=cephalopod
PRINT_TYPE
db_print_prop(\%config, 'Squid');
is( $out->read, <<PRINT_PROP, 'db_print_prop all props' );
arms=10
species=Loligo
PRINT_PROP
db_print_prop(\%config, 'Squid', 'arms');
is( $out->read, <<PRINT_PROP, 'db_print_prop one prop' );
arms=10
PRINT_PROP
undef $out;
untie *STDOUT;
db_set(\%config, 'Wibble', 'dribble|hip|hop');
my($type, %props) = db_get(\%config, 'Wibble');
is( $type, 'dribble', 'db_set with raw value' );
is_deeply( \%props, { hip => 'hop' }, ' again' );
db_set(\%config, 'Wibble', 'word', { thingy => 'yep' });
($type, %props) = db_get(\%config, 'Wibble');
is( $type, 'word', 'db_set');
is_deeply( \%props, { thingy => 'yep' } );
db_set_type(\%config, 'Wibble', 'yibble');
is( db_get_type(\%config, 'Wibble'), 'yibble', 'db_set_type' );
db_set_prop(\%config, 'Wibble', har => 'far');
is( db_get_prop(\%config, 'Wibble', 'har'), 'far', 'db_set_prop' );
### Test read-only open()
my $scratch = scratch_copy('10e-smith-lib/configuration.conf');
ok( chmod 0444, $scratch );
my $ro_db = esmith::DB::db->open_ro($scratch);
eval { $ro_db->new_record('wibble', { type => 'something' }) };
like( $@, qr/read-only/ );
my $sshd = $ro_db->get('sshd');
eval { $sshd->set_prop('foo', 'bar') };
like( $@, qr/read-only/ );
is( $sshd->prop('foo'), undef );
eval { $sshd->delete_prop('status') };
like( $@, qr/read-only/ );
isnt( $sshd->prop('status'), undef );
eval { $sshd->merge_props(foo => 'bar') };
like( $@, qr/read-only/ );
is( $sshd->prop('foo'), undef );
eval { $sshd->reset_props(foo => 'bar') };
like( $@, qr/read-only/ );
is( $sshd->prop('foo'), undef );
eval { $sshd->delete };
like( $@, qr/read-only/ );
ok( $ro_db->get('sshd') );

View File

@ -0,0 +1,4 @@
{
$DB = esmith::ConfigDB->open("${DB_FILENAME}");
}

View File

@ -0,0 +1,3 @@
{
$DB->new_record("quux", {type=>'service', status=>'enabled'});
}

View File

@ -0,0 +1,7 @@
# Dummy configuration file for testing esmith::db
Foo=Bar
Night=Day
Squid=cephalopod|arms|10|species|Loligo
Pipe=art|pipe|this is not a \| got that?
Haiku=poem|words|Damian Conway\nGod damn! Damian Conway\nDamian Conway
Octopus=cephalopod|arms|8|species|

View File

@ -0,0 +1,141 @@
#!/usr/bin/perl -w
# vim: ft=perl:
use strict;
use esmith::util;
use esmith::ConfigDB;
use Test::More 'no_plan';
use File::Copy qw(copy);
use POSIX qw(tmpnam);
# What we want to do is run initialize-default-databases on a scratch
# db and check the results.
my $dbhome = '/tmp/dbhome';
my $dbroot = '/etc/e-smith/db';
system('rm', '-rf', $dbhome);
system('mkdir', '-p', $dbhome) == 0
or die "Can't create $dbhome: $!\n";
ok( esmith::util::initialize_default_databases(dbhome => $dbhome),
"initialize_default_databases created successfully" );
# Confirm the default settings.
walk_dbtree($dbroot, 'defaults');
# Test that forced options were forced.
walk_dbtree($dbroot, 'force');
# We should now have default configuration files. We can go through each
# setting specified by the defaults and confirm that it is correct.
# To test migration, we should take a typical 5.6 set of databases and migrate
# those. The existing .conf databases in the 10e-smith-lib directory are
# styled after 5.6, and suitable for this.
foreach my $dummyconf (qw(accounts.conf domains.conf networks.conf
configuration.conf hosts.conf))
{
# Copy them over the ones in our test directory, and then migrate them.
my $dest;
($dest = $dummyconf) =~ s/\.conf$//;
$dest = "$dbhome/$dest";
copy($dummyconf, $dest) or die "Can't copy $dummyconf to $dest: $!\n";
}
# Migrate the directory.
ok( esmith::util::initialize_default_databases(dbhome => $dbhome),
"initialize_default_databases migrated successfully" );
#run_migrate_tests($dbhome, $dbroot);
system('rm', '-rf', $dbhome);
exit 0;
sub walk_dbtree
{
my $dbroot = shift;
my $mode = shift;
die unless $mode =~ /^(defaults|force)$/;
opendir(DBROOT, $dbroot) or die "Can't open $dbroot: $!\n";
my @dbfiles = grep { -d "$dbroot/$_" }
grep { !/^\./ } readdir DBROOT;
closedir(DBROOT);
foreach my $dbfile (@dbfiles)
{
# Handle the defaults in this case.
my $defaultdir = "$dbroot/$dbfile/defaults";
next if not -e $defaultdir;
opendir(DEFAULTDIR, $defaultdir) or die "Can't open $defaultdir: $!\n";
my @keys = grep { -d "$defaultdir/$_" }
grep { !/^\./ } readdir DEFAULTDIR;
closedir(DEFAULTDIR);
# There should now be a db file output at the dbhome.
ok( -e "$dbhome/$dbfile", "$dbfile db exists" );
my $db = esmith::ConfigDB->open_ro("$dbhome/$dbfile");
ok( defined $db, "$dbhome/$dbfile loads properly" );
# Loop on all the keys.
foreach my $keydir (@keys)
{
my $key_fullpath = "$defaultdir/$keydir";
opendir(KEYDIR, $key_fullpath)
or die "Can't open $key_fullpath: $!\n";
my @propfiles = grep { -f "$key_fullpath/$_" }
grep { !/^\./ } readdir KEYDIR;
closedir(KEYDIR);
foreach my $propfile (@propfiles)
{
my $propfile_fullpath = "$key_fullpath/$propfile";
# Open each and check what the default should be.
open(PROPFILE, "<$propfile_fullpath")
or die "Can't open $propfile_fullpath: $!\n";
chomp( my $propval = <PROPFILE> );
close(PROPFILE);
if ($keydir eq 'ActiveAccounts')
{
print "get_prop on $keydir, $propfile returns ";
print $db->get_prop($keydir, $propfile) . "\n";
print "propval is $propval\n";
}
ok( $db->get_prop($keydir, $propfile) eq $propval,
"property $propfile of record $keydir has correct $mode value of $propval" );
}
}
}
}
# FIXME: This works, but the numbers of the tests are thrown off. We probably
# want to eval the test block of code instead.
sub run_migrate_tests
{
my $dbhome = shift;
my $dbroot = shift;
opendir(DBROOT, $dbroot) or die "Can't open $dbroot: $!\n";
my @dbfiles = grep { -d "$dbroot/$_" }
grep { !/^\./ } readdir DBROOT;
closedir(DBROOT);
foreach my $dbfile (@dbfiles)
{
# Handle the defaults in this case.
my $migratedir = "$dbroot/$dbfile/migrate";
next if not -e $migratedir;
opendir(MIGRATEDIR, $migratedir) or die "Can't open $migratedir: $!\n";
my @migrate_fragments = grep { !/^\./ } readdir MIGRATEDIR;
closedir(MIGRATEDIR);
foreach my $migrate_fragment (sort @migrate_fragments)
{
my $tempname = tmpnam() or die "Can't obtain tempfile: $!\n";
my $pod2test = '/usr/bin/pod2test';
system($pod2test, "$migratedir/$migrate_fragment", $tempname);
if (! -e $tempname)
{
warn "The fragment $migrate_fragment apparently has no embedded tests\n";
next;
}
system('/usr/bin/perl', $tempname);
}
}
}

View File

@ -0,0 +1,3 @@
test=domain|foo|bar
foo=domain|baz|quux
wombat=notadomain

View File

@ -0,0 +1,11 @@
foo=bar
this key=has whitespace
that key =has trailing whitespace
another key=has leading whitespace
this value= has leading whitespace
that value=has trailing whitespace
# this is a comment. ignore it.
# this is a comment = too
tricky value=with=equals.

View File

@ -0,0 +1,13 @@
# DO NOT MODIFY THIS FILE.
# This file is automatically maintained by the Mitel Networks SME Server
# configuration software. Manually editing this file may put your
# system in an unknown state.
#
# updated: Fri Mar 11 18:21:42 2002
ftp.mydomain.xxx=host|ExternalIP||HostType|Self|InternalIP||MACAddress||Visibility|Local
mail.mydomain.xxx=host|ExternalIP||HostType|Self|InternalIP||MACAddress||Visibility|Local
myserver.mydomain.xxx=host|ExternalIP||HostType|Local|InternalIP||MACAddress||Visibility|Local
otherhost.mydomain.xxx=host|ExternalIP||HostType|Local|InternalIP|192.168.1.3|MACAddress||Visibility|Local
www.mydomain.xxx=host|ExternalIP||HostType|Self|InternalIP||MACAddress||Visibility|Local
www.otherdomain.xxx=host|ExternalIP||HostType|Self|InternalIP||MACAddress||Visibility|Local
foo.otherdomain.xxx=host|ExternalIP||HostType|Self|InternalIP||MACAddress||Visibility|Local

View File

@ -0,0 +1 @@
I am an English license.

View File

@ -0,0 +1 @@
Je suis une license francais. Or something like that.

View File

@ -0,0 +1 @@
10.0.0.0=network|Mask|255.255.255.0|Router|default

View File

@ -0,0 +1 @@
sysconfig=configuration|KeyboardType|pc|Keytable|us|Language|en_US|ReleaseVersion|6.0alpha2

View File

@ -0,0 +1 @@
sysconfig=configuration|KeyboardType|pc|Keytable|us|Language|fr_CA|ReleaseVersion|6.0alpha2

View File

@ -0,0 +1,111 @@
#!/usr/bin/perl -w
use esmith::TestUtils qw(scratch_copy);
use File::Path;
use Test::More 'no_plan';
use_ok('esmith::templates', qw(:DEFAULT removeBlankLines));
use esmith::config;
my %config;
tie %config, 'esmith::config', '10e-smith-lib/scratch.conf';
$ENV{ESMITH_CONFIG_DB} = '10e-smith-lib/scratch.conf';
END { unlink '10e-smith-lib/scratch.conf' }
my $Scratch_Temp_Dir = 'template_scratch_dir';
my $Scratch_Temp = "$Scratch_Temp_Dir/dummy";
mkpath "$Scratch_Temp_Dir/10e-smith-lib";
END { rmtree $Scratch_Temp_Dir }
# processTemplate() is going to be Loud and Helpful about skipping
# things like CVS directories.
$SIG{__WARN__} = sub { return if $_[0] =~ /^Skipping directory/ };
$config{Koala_Say} = "This is not the bear you're looking for.";
processTemplate({ CONFREF => \%config,
OUTPUT_PREFIX => $Scratch_Temp_Dir,
OUTPUT_FILENAME => 'dummy',
TEMPLATE_PATH => 'templates',
TEMPLATE_EXPAND_QUEUE => [
'10e-smith-lib'
],
FILTER => \&removeBlankLines,
UID => $<,
GID => (split / /, $()[0]
});
ok( -f $Scratch_Temp, 'file generated' );
ok( -s $Scratch_Temp, ' its not empty' );
open(SCRATCH, $Scratch_Temp) || die $!;
my $out;
{ local $/; $out = <SCRATCH>; }
close SCRATCH;
my $koala_output = <<'THIS';
# This is the beginning of the beginning
# confref ok
----------------------------------------
< This is not the bear you're looking for. >
----------------------------------------
\
\ .
___ //
{~._.~}//
( Y )K/
()~*~()
(_)-(_)
Luke
Skywalker
koala
# This is the end, My only friend, the end of our elaborate templates, the end
THIS
is( $out, $koala_output, 'file generated properly' );
$out = processTemplate({
CONFREF => \%config,
TEMPLATE_PATH => 'templates',
TEMPLATE_EXPAND_QUEUE => [
'10e-smith-lib'
],
FILTER => sub { $_[0] =~ /^\s*$/ ? '' : $_[0] },
UID => $<,
GID => (split / /, $()[0],
OUTPUT_TYPE => 'string'
});
is( $out, $koala_output, 'string generated properly' );
my $h_scratch = scratch_copy('10e-smith-lib/hosts.conf');
my $a_scratch = scratch_copy('10e-smith-lib/accounts.conf');
use esmith::AccountsDB;
use esmith::HostsDB;
my $acct = esmith::AccountsDB->open($a_scratch);
my $host = esmith::HostsDB->open($h_scratch);
$out = processTemplate({
MORE_DATA => { Author => 'Douglas Adams' },
TEMPLATE_PATH => 'templates_DB',
TEMPLATE_EXPAND_QUEUE => [
'10e-smith-lib'
],
OUTPUT_TYPE => 'string'
});
is( $out, <<'THIS', 'DB & MORE_DATA' );
Chapter 1
The story so far:
In the beginning the Universe was created. This has made a lot
of people very angry and been widely regarded as a bad move.
-- Douglas Adams
$DB ok
default vars ok
confref not defined
The end of labor is to gain leisure.
THIS

View File

@ -0,0 +1,20 @@
{
my $ksez = $Koala_Say;
my $line = '-' x length $ksez;
$OUT = <<KOALA_SEZ;
$line
< $ksez >
$line
KOALA_SEZ
}
\
\ .
___ //
\{~._.~\}//
( Y )K/
()~*~()
(_)-(_)
Luke
Skywalker
koala

View File

@ -0,0 +1,3 @@
# This is the beginning of the beginning
# { keys %$confref == 1 && exists $confref->{Koala_Say}
? "confref ok" : "confref not ok" }

View File

@ -0,0 +1 @@
# This is the end, My only friend, the end of our elaborate templates, the end

View File

@ -0,0 +1,20 @@
{
my $ksez = $Koala_Say;
my $line = '-' x length $ksez;
$OUT = <<KOALA_SEZ;
$line
< $ksez >
$line
KOALA_SEZ
}
\
\ .
___ //
\{~._.~\}//
( Y )K/
()~*~()
(_)-(_)
Luke
Skywalker
koala

View File

@ -0,0 +1 @@
# This is the end, My only friend, the end of our elaborate templates, the end

View File

@ -0,0 +1,9 @@
{ '$DB ok' if defined $DB && $DB->isa('esmith::ConfigDB') }
{ my $ok = 1;
foreach my $rec ($DB->get_all) {
my $key = $rec->key;
my $type = $rec->props <= 1 ? "SCALAR" : "HASH";
$ok = 0 unless *{$key}{$type};
}
'default vars ok' if $ok;
}

View File

@ -0,0 +1,7 @@
{ if( *{confref}{SCALAR} ) {
"confref not defined";
} else {
"confref defined"
}
}

View File

@ -0,0 +1,10 @@
Chapter 1
The story so far:
In the beginning the Universe was created. This has made a lot
of people very angry and been widely regarded as a bad move.
-- { # Testing MORE_DATA
$Author
}

View File

@ -0,0 +1,2 @@
The end of labor is to gain leisure.

View File

@ -0,0 +1,112 @@
# This file stores uid/gid information from the CreatingSystemUsers topic of
# the Engineering Wiki. It is read by the uidgid.t test script. Please keep it
# up to date.
[passwd]
0 root 0
1 bin 1
2 daemon 2
3 adm 4
4 lp 7
8 mail 12
9 news 13
10 uucp 14
11 operator 0
12 games 100
13 gopher 30
14 ftp 50
23 squid 23
27 mysql 27
32 rpc 32
37 rpm 37
38 ntp 38
48 apache 48
53 dns 53
55 ldap 55
69 vcsa 69
74 sshd 74
77 pcap 77
99 nobody 99
100 www 101
101 admin 101
102 public 103
400 alias 400
401 qmaild 400
402 qmaill 400
403 qmailp 400
404 qmailq 401
405 qmailr 401
406 qmails 401
407 qmailscan 407
408 jabber 408
410 dnscache 410
411 dnslog 411
420 nutups 420
421 trend 421
422 fax 422
451 stunnel 451
452 memtestlog 452
1001 imaplog 1001
1002 smelog 1002
1003 cvmlog 1003
1004 mn_dvr 1004
1005 spamd 1005
2999 smelastsys 2999
[group]
0 root
1 bin
2 daemon
3 sys
4 adm
5 tty
6 disk
7 lp
8 mem
9 kmem
10 wheel
12 mail
13 news
14 uucp
15 man
19 floppy
20 games
21 slocate
22 utmp
23 squid
27 mysql
30 gopher
32 rpc
37 rpm
38 ntp
40 dip
48 apache
50 ftp
53 dns
54 lock
55 ldap
69 vcsa
74 sshd
77 pcap
99 nobody
100 users
101 admin
102 www
103 public
400 nofiles
401 qmail
407 qmailscan
408 jabber
410 dnscache
411 dnslog
420 nutups
421 trend
422 fax
451 stunnel
452 memtestlog
500 shared
1001 imaplog
1002 smelog
1003 cvmlog
1004 mn_dvr
1005 spamd
2999 smelastsys

View File

@ -0,0 +1,78 @@
#!/usr/bin/perl -w
# vim: ft=perl:
use strict;
use Test::More 'no_plan';
use Unix::PasswdFile;
use Unix::GroupFile;
use constant TRUE => 1;
use constant FALSE => 0;
my $conffile = 'uidgid.conf';
exit 1 if not -e $conffile;
my %passwdlist = ();
my %grouplist = ();
my $passwd = FALSE;
my $group = FALSE;
open(CONF, "<$conffile") or die "Can't open $conffile: $!\n";
while(<CONF>)
{
next if /^(#|\s)/;
if (/\[passwd]/)
{
$passwd = TRUE;
next;
}
elsif (/\[group]/)
{
$group = TRUE;
$passwd = FALSE;
next;
}
next if not $passwd and not $group;
if ($passwd)
{
my ($uid, $name, $gid) = split;
$passwdlist{$name}{uid} = $uid;
$passwdlist{$name}{gid} = $gid;
}
elsif ($group)
{
my ($gid, $name) = split;
$grouplist{$name} = $gid;
}
}
close(CONF);
# We can now confirm the uid and gid of every user, and the gid of every
# group, on the system.
# I don't know of a good way to query every user on the system, so for now
# lets just read them from the passwd file.
my $pw = Unix::PasswdFile->new('/etc/passwd', mode => 'r')
or die "Can't open /etc/passwd: $!\n";
foreach my $user ($pw->users)
{
my ($name,$passwd,$uid,$gid,undef) = getpwnam($user);
ok( exists $passwdlist{$name}, "user $name is on our list" );
ok( $uid == $passwdlist{$name}{uid}, "user $name has uid of $uid" );
ok( $gid == $passwdlist{$name}{gid}, "user $name has gid of $gid" );
}
my $gr = Unix::GroupFile->new('/etc/group', mode => 'r')
or die "Can't open /etc/group: $!\n";
foreach my $group ($gr->groups)
{
my ($name,$passwd,$gid,$members) = getgrnam($group);
ok( exists $grouplist{$name}, "group $name is on our list" );
ok( $gid == $grouplist{$name}, "group $group has gid of $gid" );
}
exit 0;

10
root/sbin/e-smith/config Executable file
View File

@ -0,0 +1,10 @@
#!/usr/bin/perl -w
#----------------------------------------------------------------------
# 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.
#----------------------------------------------------------------------
exec "/sbin/e-smith/db", "configuration", @ARGV;
die "Could not exec /sbin/e-smith/db";

View File

@ -0,0 +1,84 @@
#! /usr/bin/perl -w
#----------------------------------------------------------------------
# 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.
#----------------------------------------------------------------------
use strict;
sub usage
{
my $msg = shift;
warn("$msg\n") if $msg;
die("Usage: $0: user userid descr home_dir shell\n");
}
my $user = shift || usage("Must give username param");
my $uid = shift || usage("Must give userid param");
my $user_desc = shift || usage("Must give user desc param");
my $home = shift || usage("Must give home param");
my $shell = shift || usage("Must give shell param");
use User::pwent;
use User::grent;
if (my $pw = getpwnam($user))
{
my $euid = $pw->uid;
exit 0 if $euid == $uid; # Do not create user if it already exists with correct uid
warn ("Users $user exists but has uid of $euid - should be $uid\n");
exit 0;
}
if (my $pw = getpwuid($uid))
{
my $name = $pw->name;
warn "User id of $uid is already taken by user $name\n";
warn "Falling back to a system chosen uid\n";
# We can now go ahead and create the user and group leaving the system to choose uid/gid
die ("Failed to create user $user\n") if
system("/usr/sbin/useradd",
"-r",
"-d", $home,
"-M",
"-s", $shell,
"-c", $user_desc,
$user);
exit (0);
}
if (my $pw = getgrgid($uid))
{
my $name = $pw->name;
warn "Group id of $uid is already taken by user $name\n";
# We can now go ahead and create the user but the gid will be chosen by the system
die ("Failed to create user $user\n") if
system("/usr/sbin/useradd",
"-u", $uid,
"-d", $home,
"-M",
"-s", $shell,
"-c", $user_desc,
$user);
}
else
{
# We can now go ahead and create the user and group
die ("Failed to create group $uid\n") if
system("/usr/sbin/groupadd",
"-g", $uid,
$user);
die ("Failed to create user $user\n") if
system("/usr/sbin/useradd",
"-u", $uid,
"-g", $uid,
"-d", $home,
"-M",
"-s", $shell,
"-c", $user_desc,
$user);
}
exit 0;

344
root/sbin/e-smith/db Normal file
View File

@ -0,0 +1,344 @@
#!/usr/bin/perl -w
#----------------------------------------------------------------------
# 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;
use strict;
use esmith::config;
use esmith::db;
#--------------------------------------------------------------------------
# Set up the command list and usage strings
my %commands = (
'keys'
=> {
'function' => \&DB_keys,
'usage' => "$0 dbfile keys",
},
'print'
=> {
'function' => \&DB_print,
'usage' => "$0 dbfile print [key]",
},
'show'
=> {
'function' => \&DB_show,
'usage' => "$0 dbfile show [key]",
},
'get'
=> {
'function' => \&DB_get,
'usage' => "$0 dbfile get key",
},
'set'
=> {
'function' => \&DB_set,
'usage' => "$0 dbfile set key type "
. "[prop1 val1] [prop2 val2] ...",
},
'setdefault'
=> {
'function' => \&DB_set_default,
'usage' => "$0 dbfile setdefault key type "
. "[prop1 val1] [prop2 val2] ...",
},
'delete'
=> {
'function' => \&DB_delete,
'usage' => "$0 dbfile delete key",
},
'printtype'
=> {
'function' => \&DB_printtype,
'usage' => "$0 dbfile printtype [key]",
},
'gettype'
=> {
'function' => \&DB_gettype,
'usage' => "$0 dbfile gettype key",
},
'settype'
=> {
'function' => \&DB_settype,
'usage' => "$0 dbfile settype key type",
},
'printprop'
=> {
'function' => \&DB_printprop,
'usage' => "$0 dbfile printprop key [prop1] "
. "[prop2] [prop3] ...",
},
'getprop'
=> {
'function' => \&DB_getprop,
'usage' => "$0 dbfile getprop key prop",
},
'setprop'
=> {
'function' => \&DB_setprop,
'usage' => "$0 dbfile setprop key "
. "prop1 val1 [prop2 val2] "
. "[prop3 val3] ...",
},
'delprop'
=> {
'function' => \&DB_delprop,
'usage' => "$0 dbfile delprop key prop1 "
. "[prop2] [prop3] ...",
},
);
#--------------------------------------------------------------------------
# Set up general usage message.
my $usage = "usage:
$commands{'keys'}{'usage'}
$commands{'print'}{'usage'}
$commands{'show'}{'usage'}
$commands{'get'}{'usage'}
$commands{'set'}{'usage'}
$commands{'setdefault'}{'usage'}
$commands{'delete'}{'usage'}
$commands{'printtype'}{'usage'}
$commands{'gettype'}{'usage'}
$commands{'settype'}{'usage'}
$commands{'printprop'}{'usage'}
$commands{'getprop'}{'usage'}
$commands{'setprop'}{'usage'}
$commands{'delprop'}{'usage'}
";
#--------------------------------------------------------------------------
# Prepend $ENV{'DBPATH'} to dbfile if defined otherwise let the library
# deal with it.
my $dbfile = shift;
die $usage unless $dbfile;
my $dbpath = $ENV{'DBPATH'};
$dbfile = "$dbpath/$dbfile" if defined $dbpath;
#--------------------------------------------------------------------------
# Tie the databasefile to a hash
my $db = esmith::db->open($dbfile);
#--------------------------------------------------------------------------
# Run the appropriate command
my $command = shift;
die $usage unless $command;
die $usage unless exists $commands{$command};
$commands{$command}{'function'}->(@ARGV);
exit 0;
#--------------------------------------------------------------------------
sub DB_print
{
my $key = shift;
if (defined $key)
{
$db->print($key) ? exit 0 : exit 1;
}
else
{
$db->print() ? exit 0 : exit 1;
}
}
sub DB_keys
{
my @keys = $db->get();
exit 1 unless (scalar @keys);
print join("\n", @keys), "\n";
}
sub DB_show
{
my $key = shift;
if (defined $key)
{
$db->show($key) ? exit 0 : exit 1;
}
else
{
$db->show() ? exit 0 : exit 1;
}
}
sub DB_get
{
my $key = shift;
die "$commands{'get'}{'usage'}\n" unless $key;
my $value = $db->get($key);
exit 1 unless defined $value;
print "$value\n" if defined $value;
}
sub DB_set
{
my $key = shift;
die "$commands{'set'}{'usage'}\n" unless $key;
die "$commands{'set'}{'usage'}\n" unless scalar @_;
my $type = shift;
die "$commands{'set'}{'usage'}\n" unless defined $type;
die "$commands{'set'}{'usage'}\n" if scalar @_ % 2;
$db->set($key, $type) or exit 1;
&DB_setprop($key, @_) if scalar @_;
}
sub DB_set_default
{
my $key = shift;
die "$commands{'setdefault'}{'usage'}\n" unless $key;
die "$commands{'setdefault'}{'usage'}\n" unless scalar @_;
my $type = shift;
die "$commands{'setdefault'}{'usage'}\n" unless $type;
die "$commands{'setdefault'}{'usage'}\n" if scalar @_ % 2;
# Only set values if the key does not exist
exit 0 if defined $db->get($key);
&DB_set($key, $type, @_);
}
sub DB_delete
{
my $key = shift;
die "$commands{'delete'}{'usage'}\n" unless $key;
$db->delete($key) ? exit 0 : exit 1;
}
sub DB_printtype
{
my $key = shift;
if (defined $key)
{
$db->print_type($key) ? exit 0 : exit 1;
}
else
{
$db->print_type() ? exit 0 : exit 1;
}
}
sub DB_gettype
{
my $key = shift;
die "$commands{'get'}{'usage'}\n" unless $key;
my $value = $db->get_type($key);
exit 1 unless defined $value;
print "$value\n" if defined $value;
}
sub DB_settype
{
my $key = shift;
die "$commands{'settype'}{'usage'}\n" unless $key;
my $type = shift;
die "$commands{'settype'}{'usage'}\n" unless $type;
$db->set_type($key, $type) ? exit 0 : exit 1;
}
sub DB_printprop
{
my $key = shift;
die "$commands{'printprop'}{'usage'}\n" unless $key;
my @props = @_;
if (scalar @props)
{
foreach (@props)
{
$db->print_prop($key, $_)
if defined $db->get_prop($key, $_);
}
}
else
{
$db->print_prop($key) ? exit 0 : exit 1;
}
}
sub DB_getprop
{
my $key = shift;
die "$commands{'getprop'}{'usage'}\n" unless $key;
my $prop = shift;
die "$commands{'getprop'}{'usage'}\n" unless scalar $prop;
my $val = $db->get_prop($key, $prop);
if (defined $val)
{
print "$val\n";
}
else
{
exit 1;
}
}
sub DB_setprop
{
my $key = shift;
die "$commands{'setprop'}{'usage'}\n" unless $key;
die "$commands{'setprop'}{'usage'}\n" unless scalar @_;
die "$commands{'setprop'}{'usage'}\n" if scalar @_ % 2;
my %properties = @_;
foreach (sort keys %properties)
{
$db->set_prop($key, $_, $properties{$_});
}
}
sub DB_delprop
{
my $key = shift;
die "$commands{'delprop'}{'usage'}\n" unless $key;
die "$commands{'delprop'}{'usage'}\n" unless scalar @_;
foreach (@_)
{
$db->delete_prop($key, $_);
}
}

View File

@ -0,0 +1,46 @@
#!/usr/bin/perl -w
#----------------------------------------------------------------------
# Copyright 1999-2004 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;
use strict;
use Errno;
use Getopt::Long;
use esmith::templates;
my %options = ();
GetOptions(\%options, 'output_filename=s', 'expand_queue=s');
$options{'template_path'} = $ARGV[0] || die "Usage: $0 /path/to/file/to/expand\n";
$options{'output_filename'} = $options{'template_path'}
unless ( exists $options{'output_filename'} );
my %args = (
TEMPLATE_PATH => $options{'template_path'},
OUTPUT_FILENAME => $options{'output_filename'},
);
$args{TEMPLATE_EXPAND_QUEUE} = [$options{'expand_queue'}]
if exists $options{expand_queue};
if ( -f $options{'output_filename'} )
{
# If the target file exists, preserve its ownership and mode
use File::stat;
my $f = stat($options{'output_filename'} );
$args{UID} = $f->uid;
$args{GID} = $f->gid;
$args{PERMS} = $f->mode;
}
esmith::templates::processTemplate(\%args);

View File

@ -0,0 +1,24 @@
#!/usr/bin/perl -w
#----------------------------------------------------------------------
# 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.
#----------------------------------------------------------------------
use strict;
use Getopt::Long;
use esmith::event;
my $usage = "usage:
$0 eventname [arg1 [arg2...]]
";
my ($event, @args) = @ARGV;
die $usage unless $event;
my $exitcode = event_signal($event, @args);
# reverse exitcode for command-line usage
exit ($exitcode ? 0 : 1);

View File

@ -0,0 +1,540 @@
#----------------------------------------------------------------------
# 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::AccountsDB;
use strict;
use warnings;
use esmith::db;
use vars qw( $AUTOLOAD @ISA );
use esmith::DB::db;
@ISA = qw(esmith::DB::db);
=head1 NAME
esmith::AccountsDB - interface to esmith configuration database
=head1 SYNOPSIS
use esmith::AccountsDB;
my $a = esmith::AccountsDB->open;
my @users = $a->users();
my @groups = $a->groups();
my @ibays = $a->ibays();
my @printers = $a->printers();
my @pseudonyms = $a->pseudonyms();
$a->is_user_in_group($user, $group);
my @groups = $a->user_group_list($user);
$a->add_user_to_groups($user, @groups);
$a->remove_user_from_groups($user, @groups);
$a->create_user_auto_pseudonyms($user);
$a->remove_user_auto_pseudonyms($user);
$a->remove_all_user_pseudonyms($user);
my $dp = $a->dot_pseudonym($user);
my $up = $a->underbar_pseudonym($user);
my $uid = $a->get_next_uid();
=head1 DESCRIPTION
This module provides an abstracted interface to the esmith accounts
database.
=cut
our $VERSION = sprintf '%d.%03d', q$Revision: 1.18 $ =~ /: (\d+).(\d+)/;
=head2 open()
Loads an existing account database and returns an esmith::AccountsDB
object representing it.
=begin testing
use esmith::TestUtils qw(scratch_copy);
use_ok("esmith::AccountsDB");
use esmith::db;
use vars qw($a);
my $conf = scratch_copy('10e-smith-lib/accounts.conf');
$a = esmith::AccountsDB->open($conf);
isa_ok($a, 'esmith::AccountsDB');
is( $a->get("global")->prop('type'), "system", "We can get stuff from the db");
=end testing
=cut
sub open {
my($class, $file) = @_;
$file = $file || $ENV{ESMITH_ACCOUNT_DB} || "accounts";
return $class->SUPER::open($file);
}
=head2 open_ro()
Like esmith::DB->open_ro, but if given no $file it will try to open the
file in the ESMITH_ACCOUNT_DB environment variable or accounts.
=begin testing
=end testing
=cut
sub open_ro {
my($class, $file) = @_;
$file = $file || $ENV{ESMITH_ACCOUNT_DB} || "accounts";
return $class->SUPER::open_ro($file);
}
=head2 users(), groups(), ibays(), printers(), pseudonyms()
Returns a list of records (esmith::DB::db::Record objects) of the
given type.
=for testing
foreach my $t (qw(users groups pseudonyms)) {
my @list = $a->$t();
ok(@list, "Got a list of $t");
isa_ok($list[0], 'esmith::DB::db::Record');
}
=cut
sub AUTOLOAD {
my $self = shift;
my ($called_sub_name) = ($AUTOLOAD =~ m/([^:]*)$/);
my @types = qw( users groups ibays printers pseudonyms);
if (grep /^$called_sub_name$/, @types) {
$called_sub_name =~ s/s$//g; # de-pluralize
return $self->get_all_by_prop(type => $called_sub_name);
}
}
=head1 GROUP MANAGEMENT
=head2 $a->is_user_in_group($user, $group)
Returns true if the user is a member of the group, false otherwise. The
arguments are a user name and a group name.
This routine will return undef if there is no such group, false (but
defined) if the user is not in the group, and true if the user is in the
group.
=for testing
ok($a->is_user_in_group('bart', 'simpsons'), "Bart is in group Simpsons");
ok(not($a->is_user_in_group('moe', 'simpsons')), "Moe is not in group Simpsons");
ok(not(defined $a->is_user_in_group('moe', 'flanders')), "No such group as Flanders");
=cut
sub is_user_in_group {
my ($self, $user, $group) = @_;
$group = $self->get($group) || return undef;
my $members = $group->prop('Members');
return grep(/^$user$/, split /,/, $members) ? 1 : 0;
}
=head2 $a->user_group_list($user)
Get a list of groups (by name) of which a user is a member. The $user argument
is simply the username.
=for testing
my @groups = $a->user_group_list('bart');
is_deeply(\@groups, ['simpsons'], "Bart's group list is 'simpsons'");
=cut
sub user_group_list {
my ($self, $user) = @_;
my @groups = $self->groups();
my @user_groups;
foreach my $g (@groups) {
push(@user_groups, $g->key())
if $self->is_user_in_group($user, $g->key());
}
return @user_groups;
}
=head2 $a->add_user_to_groups($user, @groups)
Given a list of groups (by name), adds the user to all of them.
Doesn't signal the group-modify event, just does the DB work.
Note: the method used here is a bit kludgy. It could result in a user
being in the same group twice.
=for testing
my @groups = $a->groups();
$a->remove_user_from_groups('maggie', map { $_->key() } @groups);
my @mg = $a->user_group_list('maggie');
is(scalar @mg, 0, "Maggie has been removed from all groups");
$a->add_user_to_groups('maggie', 'simpsons');
@mg = $a->user_group_list('maggie');
is_deeply(\@mg, ['simpsons'], "Maggie has been added to group 'simpsons'");
$a->remove_user_from_groups('maggie', 'simpsons');
@mg = $a->user_group_list('maggie');
is_deeply(\@mg, [], "Maggie's been removed from all groups again");
$a->set_user_groups('maggie', 'simpsons');
@mg = $a->user_group_list('maggie');
is_deeply(\@mg, ['simpsons'], "Maggie's groups have been set to: 'simpsons'");
=cut
sub add_user_to_groups {
my ($self, $user, @groups) = @_;
GROUP: foreach my $group (@groups) {
unless (($group) = ($group =~ /(^[\w.-]+$)/))
{
warn "Group name doesn't look like a group!\n";
next GROUP;
}
my $group_rec = $self->get($group) || next GROUP;
my @members = split(/,/, $group_rec->prop('Members'));
push @members, $user;
# Remove duplicates
my %members = map { $_ => 1 } @members;
$group_rec->set_prop('Members', join(',', sort keys %members));
}
}
=head2 $a->remove_user_from_groups($user, @groups)
Given a list of groups, removes a user from all of them.
Doesn't signal the group-modify event, just does the DB work.
=cut
sub remove_user_from_groups {
my ($self, $user, @groups) = @_;
GROUP: foreach my $g (@groups) {
my $group_rec = $self->get($g) || next GROUP;
my $members = $group_rec->prop('Members');
my @members = split (/,/, $members);
@members = grep (!/^$user$/, @members);
@members = qw(admin) unless @members; # admin *must* be in every group
$group_rec->set_prop('Members', join(',', @members));
}
}
=head2 $a->set_user_groups($user, @groups)
Sets the user's groups in one fell swoop. Under the hood, it's removing
the user from every group they're in then adding them to the set you give.
=cut
sub set_user_groups
{
my ($self, $user, @groups) = @_;
my @old_groups = $self->user_groups_list($user);
$self->remove_user_from_groups($user, @old_groups);
$self->add_user_to_groups($user, @groups);
}
=head1 PSEUDONYM MANAGEMENT
=head2 $a->create_user_auto_pseudonyms($user)
Given a user name, creates standard pseudonyms ("dot" and "underbar" style)
for that user.
=for testing
my $user = 'bart';
ok($a->pseudonyms(), "There are pseudonyms in the accounts db");
$a->remove_user_auto_pseudonyms($user);
ok(! $a->get('bart.simpson'), "Removed dot-pseudonym");
ok(! $a->get('bart_simpson'), "Removed underbar-pseudonym");
$a->create_user_auto_pseudonyms($user);
ok($a->get('bart.simpson'), "Created dot-pseudonym");
ok($a->get('bart_simpson'), "Created underbar-pseudonym");
=cut
sub create_user_auto_pseudonyms {
my ($self, $user) = @_;
my $user_rec = $self->get($user);
my $firstName = $user_rec->prop("FirstName");
my $lastName = $user_rec->prop("LastName");
my $dot_pseudonym = dot_pseudonym($self, $user);
my $underbar_pseudonym = underbar_pseudonym($self, $user);
my $dot_acct = $self->get($dot_pseudonym) ||
$self->new_record($dot_pseudonym, { type => 'pseudonym',
Account => $user} );
my $underbar_acct = $self->get($underbar_pseudonym) ||
$self->new_record($underbar_pseudonym, { type => 'pseudonym',
Account => $user} );
}
=head2 $a->remove_all_user_pseudonyms($user)
Given a username, remove any pseudonyms related to that user from the
accounts database. Also removes any pseudonyms related to a pseudonym
being removed. Returns the number of pseudonym records deleted.
=cut
sub remove_all_user_pseudonyms {
my ($self, $user) = @_;
my $count = 0;
foreach my $p_rec (grep { $_->prop("Account") eq $user } $self->pseudonyms())
{
foreach my $p_p_rec (grep { $_->prop("Account") eq $p_rec->key } $self->pseudonyms())
{
$p_p_rec->delete;
$count++;
}
$p_rec->delete;
$count++;
}
return $count;
}
=head2 $a->remove_user_auto_pseudonyms($user)
Given a username, remove the dot_pseudonym and underbar_pseudonym
related to that user from the accounts database. Returns the number
of pseudonym records deleted.
=cut
sub remove_user_auto_pseudonyms {
my ($self, $user) = @_;
my $dot_pseudonym = dot_pseudonym($self, $user);
my $underbar_pseudonym = underbar_pseudonym($self, $user);
my $count = 0;
foreach my $p_rec ($self->get($dot_pseudonym),
$self->get($underbar_pseudonym))
{
if (defined $p_rec && $p_rec->prop("type") eq "pseudonym" &&
$p_rec->prop("Account") eq $user)
{
$p_rec->delete;
$count++;
}
}
return $count;
}
=head2 $a->dot_pseudonym($user)
Returns the "dot"-style pseudonym for a user as a string. For instance,
dot_pseudonym("bart") might return "bart.simpson".
=cut
sub dot_pseudonym {
my ($self, $user) = @_;
my $user_rec = $self->get($user);
my $firstName = $user_rec->prop("FirstName");
my $lastName = $user_rec->prop("LastName");
my $dot_pseudonym = lc("$firstName $lastName");
$dot_pseudonym =~ s/^\s+//; # Strip leading whitespace
$dot_pseudonym =~ s/\s+$//; # Strip trailing whitespace
$dot_pseudonym =~ s/\s+/ /g; # Multiple spaces become single spaces
$dot_pseudonym =~ s/\s/./g; # Change all spaces to dots
return $dot_pseudonym;
}
=head2 $a->underbar_pseudonym($user)
Returns the "underbar"-style pseudonym for a user as a string. For instance,
underbar_pseudonym("bart") might return "bart_simpson".
=begin testing
my @users = $a->users();
my $user = 'bart';
my $rec = $a->get($user);
my $firstName = $rec->prop("FirstName");
my $lastName = $rec->prop("LastName");
my $up = $a->underbar_pseudonym($user);
is($up, "bart_simpson", "Underbar pseudonym created correctly");
my $dp = $a->dot_pseudonym($user);
is($dp, "bart.simpson", "Underbar pseudonym created correctly");
=end testing
=cut
sub underbar_pseudonym {
my ($self, $user) = @_;
my $user_rec = $self->get($user);
my $firstName = $user_rec->prop("FirstName");
my $lastName = $user_rec->prop("LastName");
my $underbar_pseudonym = lc("$firstName $lastName");
$underbar_pseudonym =~ s/^\s+//; # Strip leading whitespace
$underbar_pseudonym =~ s/\s+$//; # Strip trailing whitespace
$underbar_pseudonym =~ s/\s+/ /g; # Multiple spaces become single spaces
$underbar_pseudonym =~ s/\s/_/g; # Change all spaces to underbars
return $underbar_pseudonym;
}
=head2 $a->activeUsers()
Returns the number of active users, ie, accounts which have passwords set and
are of type 'user'.
=begin testing
my $numActiveUsers = scalar $a->activeUsers();
like($numActiveUsers, qr/[0-9]+/, "active users returns a number");
=end testing
=cut
sub activeUsers()
{
my $self = shift;
my @users = $self->users();
return unless @users;
return grep { $_->prop("PasswordSet") eq 'yes' } @users;
}
=head2 get_next_uid
Returns the next available UID from /etc/passwd. All UIDs are above the range
reserved for 'system' accounts (currently 5000).
=for testing
SKIP: {
skip "Must be root to run get_next_uid" if $<;
my $u = $a->get_next_uid();
ok($u > 5000, "UID should be greater than 5000");
ok(! getpwuid($u), "UID should not yet exist");
}
=cut
sub get_next_uid {
use esmith::ConfigDB;
my $id;
my $db = esmith::ConfigDB->open || die "Couldn't open config db";
if ($id = $db->get('MinUid'))
{
$id = $id->value();
}
else
{
$db->new_record('MinUid');
$id = 5000;
}
my $maxid = 1 << 31;
setpwent();
setgrent();
while (getpwuid $id || getgrgid $id)
{
die "All userids in use" if ($id == $maxid);
$id++;
}
endpwent();
endgrent();
$db->set_value('MinUid', $id + 1);
return $id;
}
=pod
=head2 new_record ($key, \%props)
This method is overridden from esmith::DB::db. We do an additional check
for implicit accounts here - accounts that exist in /etc/passwd but not
in the db. Otherwise it behaves just like the superclass method.
=begin testing
isnt($a->new_record("root", {type=>'system'}), "OK",
"can't create existing account");
is($a->get("nobody"), undef, "nobody doesn't exist in db");
isnt($a->new_record("nobody", {type=>'system'}), "OK",
"can't create account in /etc/passwd");
isnt($a->new_record("screwy", {type=>'user'}), undef,
"created a regular user");
=end testing
=cut
sub new_record
{
my ($self, $key, $props) = @_;
if(getpwnam($key) || getgrnam($key))
{
warn "Attempt to create account '$key' which already exists ",
"in passwd";
return undef;
}
return $self->SUPER::new_record($key, $props);
}
=pod
=head2 validate_account_name ($name)
Check $name to see if it is a valid account name. Valid account names
start with a letter or number and contain only letters, numbers,
underscores, dots and dashes.
=begin testing
is($a->validate_account_name("root"), "OK", "root is a valid name");
is($a->validate_account_name("fred.frog"), "OK", "fred.frog is a valid name");
is($a->validate_account_name("jane_doe"), "OK", "jane_doe is a valid name");
isnt($a->validate_account_name("^root"), "OK", "^root is not a valid name");
is(esmith::AccountsDB::validate_account_name("root"), "OK", "called as a function");
=end testing
=cut
sub validate_account_name
{
my $self;
# Were we called as a method or a function?
if($#_ > 0)
{
$self = shift;
}
my $name = shift;
return ($name =~ /[^0-9a-z\-_\.]/ or $name !~ /^[a-z]/) ? undef : 'OK';
}
=head1 AUTHOR
SME Server Developers <bugs@e-smith.com>
See http://www.e-smith.org/ for more information

View File

@ -0,0 +1,398 @@
#----------------------------------------------------------------------
# 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::ConfigDB;
use strict;
use warnings;
use vars qw( $AUTOLOAD @ISA );
use esmith::DB::db;
@ISA = qw( esmith::DB::db );
use esmith::ConfigDB::Record;
=head1 NAME
esmith::ConfigDB - interface to esmith configuration database
=head1 SYNOPSIS
use esmith::ConfigDB;
my $db = esmith::ConfigDB->open;
my $db = esmith::ConfigDB->open_ro;
my @services = $db->services();
# Singleton Records
my $record = $db->get($key);
my $value = $record->value;
$record->set_value($value);
# BAD!
my $value = $db->get($key)->value() # Throws a runtime error if $key
# doesn't exist
$value = $db->get($key)->prop($p) # Throws a runtime error if $key
# doesn't exist
# GOOD
my $record = $db->get($key);
my $value;
if ($record)
{
$value = $record->prop($prop);
}
# Typed Records (eventually they all will be)
my $prop = $record->prop($p);
$record->set_prop($prop, $propvalue);
my $value = $db->get_value($key) # Returns undef if record doesn't exist
$value = $db->get_prop($key, $p) # Returns undef if record doesn't exist
=head1 DESCRIPTION
This module provides an abstracted interface to the esmith master
configuration database.
Unless otherwise noted, esmith::ConfigDB acts like esmith::DB::db.
=cut
our $VERSION = sprintf '%d.%03d', q$Revision: 1.29 $ =~ /: (\d+).(\d+)/;
=head2 open()
Like esmith::DB->open, but if given no $file it will try to open the
file in the ESMITH_CONFIG_DB environment variable or configuration.
=begin testing
use esmith::TestUtils qw(scratch_copy);
use_ok("esmith::ConfigDB");
my $scratch_copy_of_conf = scratch_copy('10e-smith-lib/configuration.conf');
$C = esmith::ConfigDB->open($scratch_copy_of_conf);
isa_ok($C, 'esmith::ConfigDB');
is( $C->get("AccessType")->prop('type'), "dedicated",
"We can get stuff from the db");
is( $C->get_prop("AccessType",'type'), "dedicated",
"We can get_prop stuff from the db");
is( $C->get_value("AccessType"), "dedicated",
"We can get_value stuff from the db");
is( $C->get_value("NoSuchKey"), undef,
"We can get_value non-existant keys");
is( $C->get_prop("diald","status"), "disabled",
"We can get_prop stuff from the db");
is( $C->get_prop("NoSuchKey","NoSuchProp"), undef,
"We can get_prop non-existant keys");
is( $C->get_prop("diald","NoSuchProp"), undef,
"We can get_prop non-existant props");
=end testing
=cut
sub open
{
my ( $class, $file ) = @_;
$file = $file || $ENV{ESMITH_CONFIG_DB} || "configuration";
return $class->SUPER::open($file);
}
=head2 open_ro()
Like esmith::DB->open_ro, but if given no $file it will try to open the
file in the ESMITH_CONFIG_DB environment variable or configuration.
=begin testing
=end testing
=cut
sub open_ro
{
my ( $class, $file ) = @_;
$file = $file || $ENV{ESMITH_CONFIG_DB} || "configuration";
return $class->SUPER::open_ro($file);
}
=head2 new_record()
This method creates a new record in the configuration database. As arguments,
it expects the key to the record, followed by a hash references with its
properties, including the type.
my $db = esmith::ConfigDB->open;
my $record = $db->new_record('zope', { type => 'service',
status => 'disabled' });
my %defaults = qw(
type => 'service',
status => 'disabled',
maintainer => 'admin@domain.com'
);
my $record = $db->get('zope');
unless ($record)
{
$record = $db->new_record('zope', \%defaults);
}
=head2 get()
Like their esmith::DB counterparts except they return
esmith::ConfigDB::Record objects which have a few extra methods.
my $record = $db->get('zope');
=begin testing
my $rec = eval { $C->get("I_dont_exist"); };
ok( !$rec, 'get() on a non-existent key' );
is( $@, '', ' doesnt blow up' );
isa_ok( $C->get("AccessType"), 'esmith::ConfigDB::Record',
"get()ened records are ConfigDB::Records" );
$rec = $C->new_record("I_dont_exist", { type => "foo" });
isa_ok( $rec, 'esmith::ConfigDB::Record',
"new_record()s are ConfigDB::Records" );
$rec->delete("I_dont_exist");
ok( !$C->get("I_dont_exist"), 'delete()' );
=end testing
=cut
sub get
{
my ($self) = shift;
my $rec = $self->SUPER::get(@_);
return $rec ? bless $rec, 'esmith::ConfigDB::Record' : undef;
}
sub new_record
{
my ($self) = shift;
my $rec = $self->SUPER::new_record(@_);
return $rec ? bless $rec, 'esmith::ConfigDB::Record' : undef;
}
=pod
=head2 getLocale()
Retrieves the locale and keyboard settings from the configuration database.
Returns ($lang, $kbdtype, $keytable) on success. Returns undef if the record
doesn't exist.
=cut
sub getLocale
{
my $self = shift;
my $rec = $self->get('sysconfig') or return undef;
my $lang = $rec->prop('Language') || 'en_US';
my $kbdtype = $rec->prop('KeyboardType') || 'pc';
my $keytable = $rec->prop('Keytable') || 'us';
return ( $lang, $kbdtype, $keytable );
}
=pod
=head2 hosts_allow_spec ($service [,$daemon])
Given a service, return the string suitable for /etc/hosts.allow,
checking to see if the service is defined, whether it is enabled and
whether access is set to public, private, or localhost.
An optional argument provides the tag which appears in hosts.allow. If not
given, the service name is used.
For example, one of the following:
# 'oidentd' is not defined in the configuration database
# 'oidentd' is disabled in the configuration database
in.identd: 127.0.0.1
in.identd: 127.0.0.1 192.168.1.1/255.255.255.0
in.identd: ALL
And here's the hosts.allow fragment:
{
$OUT = $DB->hosts_allow_spec('oidentd', 'in.identd');
}
=cut
sub hosts_allow_spec
{
my $self = shift;
my $service_name = shift;
my $daemon = shift || $service_name;
my $service = $self->get($service_name)
or return
"# '$service_name' is not defined in the configuration database";
my $status = $service->prop('status') || "disabled";
return "# '$service_name' is disabled in the configuration database"
unless ( $status eq "enabled" );
my $access = $service->prop('access') || "private";
use esmith::NetworksDB;
my $ndb = esmith::NetworksDB->open_ro;
my @spec = ( "$daemon:", $ndb->local_access_spec($access) );
return "@spec";
}
=pod
=head2 wins_server
Return the value of the WINS server from the config db
or undef if we don't have a WINS server set and we are
not the domain master
=cut
sub wins_server
{
my ($self) = @_;
my $wins_server = $self->get_prop( 'smb', 'WINSServer' );
return $wins_server if $wins_server;
my $server_role = $self->get_prop( 'smb', 'ServerRole' ) || 'WS';
return $self->get_prop( 'InternalInterface', 'IPAddress' )
if $server_role =~ m{^(PDC|ADS)$};
return undef;
}
=pod
=head2 services()
Returns a list of services in the configuration database
=for testing
foreach my $t (qw(services)) {
my @list = $C->$t();
ok(@list, "Got a list of $t");
}
=cut
sub AUTOLOAD
{
my $self = shift;
my ($called_sub_name) = ( $AUTOLOAD =~ m/([^:]*)$/ );
my @types = qw( services );
if ( grep /^$called_sub_name$/, @types )
{
$called_sub_name =~ s/s$//g; # de-pluralize
return $self->list_by_type($called_sub_name);
}
}
=pod
=head2 _loadDefaults ($forceReset)
Behaves just like the esmith::DB method of the same name. This is a private
method used internally.
=begin testing
$scratch_copy_of_conf = scratch_copy('10e-smith-lib/configuration.conf', 'configuration.conf.scratch');
is ($scratch_copy_of_conf, 'configuration.conf.scratch', 'scratch copy name');
$ENV{'ESMITH_CONFIG_DB'} = $scratch_copy_of_conf;
$C = esmith::ConfigDB->open();
is ($C->{file}, $scratch_copy_of_conf, 'file name');
my $accesstype = $C->get("AccessType")->value;
ok($C->new_record('foobar', {type=>'service', status=>'disabled'}),
"Set up foobar record");
is($C->get('foobar')->prop('status'), "disabled", "foobar is disabled");
$ENV{'ESMITH_DB_DEFAULTSDIR'} = "10e-smith-lib/db";
ok($C->_loadDefaults(), "Loaded defaults");
is($C->get('foobar')->prop('status'), 'enabled', "We forced status enabled");
is($C->get('bazbar')->prop('status'), 'enabled', "We included a new default");
is($C->get('AccessType')->value, $accesstype, "AccessType has not changed");
=end testing
=head2 record_has_defaults ($name)
Behaves just like the esmith::DB method of the same name.
=begin testing
$ENV{'ESMITH_DB_DEFAULTSDIR'} = "10e-smith-lib/db";
is($C->record_has_defaults('foobar'), 1, "foobar has some defaults");
is($C->record_has_defaults('notthisone'), undef, "notthisone does not");
=end testing
=cut
# There would normally be a method here, but we inherit _loadDefaults
# from esmith::DB. The tests need to go here because the superclass is
# all virtual and testing requires concrete open/get/set methods.
=pod
=head2 migrate
Just like the esmith::DB method of the same name.
=begin testing
$scratch_copy_of_conf = scratch_copy('10e-smith-lib/configuration.conf', 'configuration.conf.scratch');
is ($scratch_copy_of_conf, 'configuration.conf.scratch', 'scratch copy name');
$ENV{'ESMITH_CONFIG_DB'} = $scratch_copy_of_conf;
$C = esmith::ConfigDB->open();
is($C->get('quux'), undef, "No quux here");
$ENV{'ESMITH_DB_DEFAULTSDIR'} = "10e-smith-lib/db";
ok($C->migrate(), "We can migrate");
my $quux = $C->get('quux');
ok($quux, "We got quux");
is($quux->prop('status'), 'enabled', "We migrated to quux");
$quux->delete;
=end testing
=cut
# There would normally be a method here, but we inherit migrate
# from esmith::DB. The tests need to go here because the superclass is
# all virtual and testing requires concrete open/get/set methods.
=head1 AUTHOR
SME Server Developers <bugs@e-smith.com>
=head1 SEE ALSO
L<esmith::DB>, L<esmith::DB::db>, L<esmith::AccountsDB>, L<esmith::DomainsDB>,
L<esmith::HostsDB>, L<esmith::NetworksDB>, L<esmith::ConfigDB::Record>
=cut
1;

View File

@ -0,0 +1,108 @@
#----------------------------------------------------------------------
# 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::ConfigDB::Record;
use strict;
use warnings;
use esmith::ConfigDB;
require esmith::DB::db::Record;
our @ISA = qw(esmith::DB::db::Record);
=head1 NAME
esmith::ConfigDB::Record - record in an esmith::ConfigDB database.
=head1 SYNOPSIS
Just like esmith::DB::db::Record except...
my $value = $record->value;
$record->set_value($value);
=head1 DESCRIPTION
This provides some extra functionality needed by the esmith::ConfigDB
databases.
Unless noted, it works just like esmith::DB::db::Record.
=head2 New Methods
=over 4
=item B<value>
=item B<set_value>
my $value = $record->value;
$record->set_value($value);
Gets/sets the value of the $record. Some ConfigDB entries don't have
a set of properties, but rather a single value.
It will warn if you use these on $records with properties.
=begin testing
use esmith::ConfigDB;
$Scratch_Conf = '10e-smith-lib/scratch.conf';
unlink $Scratch_Conf;
$c = esmith::ConfigDB->create($Scratch_Conf);
END { unlink $Scratch_Conf }
{
my $warning = '';
local $SIG{__WARN__} = sub { $warning = join '', @_ };
my $wib = $c->new_record('wibble', { type => 'yar' });
$wib->set_value('foo');
is( $wib->value, 'foo', 'value/set_value' );
is( $warning, '', ' no warning' );
$wib->set_prop(bar => 42);
is( $wib->value, 'foo' );
like( $warning, qr/value\(\) should not be used on records with properties, use prop\(\)/, 'value() warns if the record has props');
$wib->set_value(92);
like( $warning, qr/set_value\(\) should not be used on records with properties, use set_prop\(\)/, 'value() warns if the record has props');
is( $wib->value, 92 );
}
=end testing
=cut
sub value {
my($self) = shift;
my %props = $self->props;
warn "value() should not be used on records with properties, use prop()" if
keys %props > 1;
return $self->prop('type');
}
sub set_value {
my($self, $value) = @_;
my %props = $self->props;
warn "set_value() should not be used on records with properties, ".
"use set_prop()" if keys %props > 1;
return $self->set_prop('type', $value);
}
=back
=head1 SEE ALSO
L<esmith::ConfigDB>, L<esmith::DB::db::Record>
=cut
1;

View File

@ -0,0 +1,22 @@
#----------------------------------------------------------------------
# Copyright 1999-2008 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::ConfigDB::UTF8;
use strict;
use warnings;
use esmith::DB::db;
use esmith::config::utf8;
our @ISA = qw( esmith::DB::db );
sub tie_class
{
return 'esmith::config::utf8';
}
1;

View File

@ -0,0 +1,705 @@
#----------------------------------------------------------------------
# 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::DB;
use strict;
use warnings;
use Carp;
use File::Basename;
use esmith::templates;
use constant TRUE => 1;
use constant FALSE => 0;
our $VERSION = sprintf '%d.%03d', q$Revision: 1.40 $ =~ /: (\d+).(\d+)/;
our $Error = undef;
=head1 NAME
esmith::DB - virtual interface to E-Smith databases
=head1 SYNOPSIS
# Note: Do not instantiate this class directly. Use a subclass.
# Examples in this documentation where you see it being used directly
# are merely for consistency. Substitute a subclass in our examples.
use esmith::DB;
my $db = esmith::DB->create($filename) or
die esmith::DB->error;
my $db = esmith::DB->open($filename) or
die esmith::DB->error;
my $db = esmith::DB->open_ro($filename) or
die esmith::DB->error;
my %DB = esmith::DB->as_hash($filename) or
die esmith::DB->error;
$db->reload;
my $file = $db->file;
my $record = $db->new_record($key, \%properties);
my $record = $db->get($key);
my @all_records = $db->get_all;
my @all_records_by_prop = $db->get_all_by_prop($prop => $val);
$db->set_prop($key, $prop, $value);
$db->set_value($key, $value);
$db->set_prop($key, $prop, $value, type => $type);
$db->set_value($key, $value, create => 0);
=head1 DESCRIPTION
This module is a general interface to E-Smith's databases of various
types and formats. It is not intended to be used directly, but that
subclasses will implement the interface presented here to provide a
single interface no matter what the underlying format.
For example, there is esmith::DB::db to interface with esmith::db
flatfile databases. There could also be esmith::DB::Berkeley to use
Berkeley database files, or even esmith::DB::DBI.
Most of the methods herein are "virtual". They don't exist. The
subclass is responsible for impelmenting them. There are a handful of
concrete methods that have been implemented for you that should work
with any subclass.
=head2 Virtual Methods
This is the esmith::DB interface. Subclassers are expected to
implement these methods.
=over 4
=item I<create>
my $db = esmith::DB->create($new_config_file) ||
die esmith::DB->error;
Creates a brand new, empty configuration database and returns a
subclass of the esmith::DB object representing it.
Should the $new_config_file already exist or for some reason you can't
write to it, esmith::DB->error will return the reason and
create() will return false.
=item I<open>
my $db = esmith::DB->open($config_file) ||
die esmith::DB->error
Loads an existing configuration database and returns a
subclass of the esmith::DB::db object representing it.
Should the $config_file not exist or not be openable it will return
false and esmith::DB->error will contain the reason.
=item I<open_ro>
my $db = esmith::DB->open_ro($config_file) ||
die esmith::DB->error;
Like open(), but the database is read-only. new_record() and all methods
which could change a record (set_prop(), merge_props(), delete(), etc...)
will both throw exceptions if used.
=item I<error>
my $error = esmith::DB->error;
Returns a string describing the error from the last failing method.
=item I<reload>
$db->reload;
Flushes out the $db's cache (if there is one) and reloads all
configuration data from disk.
=item I<file>
my $file = $db->file;
File which this $db represents.
=item I<new_record>
my $record = $db->new_record($key, \%properties);
Adds a new record at $key in the $db setting it to the given
%properties. Returns a subclass of the esmith::DB::Record object.
If a record already exists for the $key it will return false.
=item I<get>
my $record = $db->get($key);
Gets an existing record from the $db with the given $key. Returns an
esmith::DB::Record object representing the data in $key.
If there's no record for the $key it will return false.
=item I<get_all>
my @records = $db->get_all;
Gets all the records out of the given $db as a list of
esmith::DB::Record objects.
=back
=head2 Concrete methods
These are all implemented in terms of the esmith::DB interface and
its not necessary for a subclass to implement them.
=over 4
=item I<as_hash>
my %db = $db->as_hash;
my %db = esmith::DB->as_hash($file);
Returns the entire database as a hash of hashes. Each key is a key in
the database, and the value is a hash of it's properties.
my $value = $db{some_key}{some_prop};
When used as an object method it will use the already opened database.
When used as a class method it will open the given $file.
=cut
sub as_hash
{
my ( $proto, $file ) = @_;
my $class = ref $proto || $proto;
my $self;
if ( ref $proto )
{ # object method
$self = $proto;
}
else
{ # class method
$self = $class->open($file) or return;
}
my %hash = ();
foreach my $rec ( $self->get_all )
{
my $key = $rec->key;
my %props = $rec->props;
# Setup the hash
$hash{$key} = \%props;
}
return %hash;
}
=item I<get_all_by_prop>
my @records_by_prop = $db->get_all_by_prop($property => $value);
Like get_all() except it gets only those records whose $property has
the given $value. For properties with multiple comma-delimited values
(ie: name|val1,val2,val3), only one of the properties needs to match.
=cut
sub get_all_by_prop
{
my ( $self, $prop, @rest ) = @_;
my %props;
if ( ref($prop) eq 'HASH' )
{
carp "get_all_by_prop called with anonymous hash argument";
%props = ( %{$prop} );
}
else
{
%props = ($prop, @rest);
}
my @things = sort { $a->key cmp $b->key } grep
{
my $found = 1;
while ( my ($p, $v) = each (%props) )
{
$found &= ( defined $_->prop($p) and $_->prop($p) =~ /(?:^|,)$v(?:,|$)/ );
}
$found;
} $self->get_all;
@things;
}
=item I<get_value>
my $value = $db->get_value( $key );
Shortcut method to get the value from the record defined by the given
key. Returns undef if the record does not exist.
The following code is unsafe if the key doesn't exist:
my $value = $db->get("foo")->value || 'default';
and should be:
my $value = 'default';
if (my $r = $db->get("foo"))
{
$value = $r->value;
}
With this method, you can use:
my $value = $db->get_value("foo") || 'default';
=cut
sub get_value
{
my $self = shift;
my $item = $self->get(shift);
return undef unless $item;
return $item->value;
}
=item I<get_prop>
my $prop = $db->get_prop( $key, $prop );
Shortcut method to get a property from the record defined by the given key.
Returns undef if the record for that key doesn't exist, or the property does
not exist.
The following code is unsafe if either the key or property doesn't exist:
my $status = $db->get("foo")->prop('status') || 'disabled';
and should be written as:
my $status;
if (my $s = $db->get("foo"))
{
$status = $s->prop('status');
}
$status ||= "default";
With this method, you can use:
my $value = $db->get_prop("foo", "status") || 'default';
=cut
sub get_prop
{
my $self = shift;
my $item = $self->get(shift);
return undef unless $item;
return $item->prop(shift);
}
=item I<set_value>
$db->set_value($key, $value)[, create => 1]);
Shortcut method to set a value to a key in the database without extracting the
record first.
If the record is not pre-existing, it will be created, unless the 'create'
option is passed with a value of 0.
Returns 0 for any errors, 1 for success.
=cut
sub set_value
{
my $self = shift;
my ($key, $value, %options) = @_;
my %defaults = (create => 1);
%options = (%defaults, %options);
my $record = $self->get($key);
unless ($record)
{
if ($options{create})
{
$record = $self->new_record($key, {type => $value})
or return 0;
}
else
{
return 0;
}
}
$record->set_value($value)
or return 0;
return 1;
}
=item I<set_prop>
$db->set_prop($key, $prop, $value[, type => $type]);
Shortcut method to set a property on a record without having to extract the
record first.
If the optional type option is passed, it will be used to create the record if
it does not already exist. Otherwise, a non-existent record will cause this
method to return an error.
Returns 0 for any errors, 1 for success.
=cut
sub set_prop
{
my $self = shift;
my ($key, $prop, $value, %options) = @_;
my %defaults = (type => '');
%options = (%defaults, %options);
my $record = $self->get($key);
unless ($record)
{
if ($options{type})
{
$record = $self->new_record($key, {type => $options{type}})
or return 0;
}
else
{
return 0;
}
}
$record->set_prop($prop, $value)
or return 0;
return 1;
}
=item I<keys>
foreach my $key ($db->keys)
{
A simple convenience function to prevent having to access the config hash
inside the db object (technically private), or calling map across a get_all
call, which is what this is going to do. :)
This method returns a list of keys to the records in the db. It does not sort.
=cut
sub keys
{
my $self = shift;
return map { $_->{key} } $self->get_all;
}
=pod
=head2 migrate
Process the fragments in the migration queue for this database, using
processTemplate.
The defaults are loaded from /etc/e-smith/db/<dbname>/migrate by default, but
the environment variable ESMITH_DB_DEFAULTSDIR can be set to use a different
hierarchy if required.
The entries in "migrate" are perl fragments which will be evaluated and
so can munge anything they choose to. But, please be gentle :-)
So you could have
/etc/e-smith/db/configuration/migrate/sshd/access
which is a perl fragment which does something funky to migrate the access
property from some old value to some new value.
After running all the migration scripts, and reloading the DB's data into
its local cache, the private method _loadDefaults is called to set any
missing default values and any forced settings.
=cut
sub migrate
{
my ($self) = @_;
my $dbfile = basename( $self->{file} );
unless ($dbfile)
{
carp "migrate can't determine filename";
return undef;
}
my $defaults_dir = $ENV{ESMITH_DB_DEFAULTSDIR} || "/etc/e-smith/db";
my $dir = "$defaults_dir/$dbfile/migrate";
eval {
if ( -d $dir )
{
processTemplate(
{
MORE_DATA => { 'DB_FILENAME' => $dbfile },
TEMPLATE_PATH => '',
OUTPUT_TYPE => 'string',
TEMPLATE_EXPAND_QUEUE =>
[ $dir, "/etc/e-smith/templates-default" ]
}
);
$self->reload;
}
$self->_loadDefaults();
};
if ($@)
{
warn "Warning: Migration of $dbfile failed fatally: $@\n";
$self->set_error($@);
return FALSE;
}
return TRUE;
}
=pod
=head2 resetToDefaults
Reset all entries to their default values, if defaults exist. This calls
the internal method _loadDefaults with the forceReset flag set. It should
not be used lightly!!
=cut
sub resetToDefaults
{
my ($self) = @_;
$self->_loadDefaults(1);
}
=head2 record_has_defaults
Returns true if there are defaults or force directories for the
given record name
=cut
sub record_has_defaults
{
my ( $self, $name ) = @_;
my $dbfile = basename( $self->{file} );
unless ($dbfile)
{
carp "record_has_defaults can't determine filename";
return undef;
}
unless ($name)
{
carp "record_has_defaults can't determine record name";
return undef;
}
my $defaults_dir = $ENV{ESMITH_DB_DEFAULTSDIR} || "/etc/e-smith/db";
my $dir = "$defaults_dir/$dbfile";
return ( -d "$dir/defaults/$name" ) || ( -d "$dir/force/$name" );
}
=pod
=head2 _loadDefaults ($forceReset)
B<This is a private method.>
Load the default properties for a given database.
Caller can provide a flag to force resetting properties that already exist.
Any forced properties will be evaluated after setting the default properties.
The defaults are loaded from the following directories in order (the
environment variable ESMITH_DB_DEFAULTSDIR can be set to use a different
hierarchy if required):
/etc/e-smith/db/<dbname>/defaults
/etc/e-smith/db/<dbname>/force
Each of these directories is arranged as a set of subdirectories, with the
directory name equal to the key for the given database. With these
subdirectories are files, which are named by the properties of these
database keys.
The entries in "defaults" will be skipped if the existing key/property
already exists (unless the $forceReset argument is provided). These are
simple files, whose contents are the value to be used for that property.
The entries in "force" are always loaded into the given key/property.
These are again simple files, like "defaults".
To make this concrete, you might have:
/etc/e-smith/db/configuration/defaults/sshd/access
containing the single word "private", which would be the default. This
value would only be used if no "access" property existed, or the
$forceReset option is passed.
You can override both "defaults" and "migrate" with
/etc/e-smith/db/configuration/force/sshd/access
containing the single word "public" to force the value of that property.
=cut
sub _loadDefaults
{
my ( $self, $force ) = @_;
my $dbfile = basename( $self->{file} );
unless ($dbfile)
{
carp "_loadDefaults can't determine filename";
return undef;
}
my $defaults_dir = $ENV{ESMITH_DB_DEFAULTSDIR} || "/etc/e-smith/db";
my @propQueue =
( "$defaults_dir/$dbfile/defaults", "$defaults_dir/$dbfile/force", );
foreach my $dir (@propQueue)
{
# Always process the force dir
$force = 1 if ( $dir =~ /\/force$/ );
next unless opendir DH, $dir;
foreach my $key ( grep !/^\./, readdir DH )
{
if ( -d "$dir/$key" )
{
my %props = ();
my $rec = $self->get($key);
opendir DH2, "$dir/$key";
foreach my $prop ( grep !/^\./, readdir DH2 )
{
unless ($force)
{
next if ( $rec && defined $rec->prop($prop) );
}
open FH, "$dir/$key/$prop";
my $val = join "", (<FH>);
chomp $val;
$props{$prop} = $val;
close FH;
}
closedir DH2;
if ($rec)
{
$rec->merge_props(%props);
}
else
{
$rec = $self->new_record( $key, \%props );
}
}
else
{
warn "Found non-directory $key in $dir\n";
}
}
close DH;
}
return 1;
}
=pod
=head2 get_value_and_delete ($key)
Retrieve the value of the named key, return it, and delete the record.
If the key does not exist, it returns undef. This is normally called from
migration code.
=cut
sub get_value_and_delete
{
my ( $self, $key ) = @_;
my $ret;
my $rec = $self->get($key);
if ($rec)
{
$ret = $rec->value;
$rec->delete;
}
return $ret;
}
=pod
=head2 get_prop_and_delete ($key, $prop)
Retrieve the named property of the named key, return the value, and delete the
property from the record. Returns undef if the property or key does not exist.
This is normally called from migration code.
=cut
sub get_prop_and_delete
{
my ( $self, $key, $prop ) = @_;
my $ret;
my $rec = $self->get($key);
if ($rec)
{
$ret = $rec->prop($prop);
$rec->delete_prop($prop);
}
return $ret;
}
sub set_error
{
my $self = shift;
$Error = shift;
}
sub error
{
return $Error;
}
=back
=head1 AUTHOR
SME Server Developers <bugs@e-smith.com>
=cut
1;

View File

@ -0,0 +1,157 @@
#----------------------------------------------------------------------
# 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::DB::Record;
use strict;
use warnings;
use esmith::DB;
our $VERSION = sprintf '%d.%03d', q$Revision: 1.6 $ =~ /: (\d+).(\d+)/;
=head1 NAME
esmith::DB::Record - an individual record in an E-Smith database
=head1 SYNOPSIS
B<DO NOT USE THIS CLASS DIRECTLY!> use via esmith::DB.
my $key = $record->key;
my %properties = $record->props;
my $value = $record->prop($prop_key);
$record->set_prop($prop_key, $prop_val);
my $value = $record->delete_prop($prop_key);
$record->merge_props(%more_properties);
$record->reset_props(%new_properties);
$record->delete;
print $record->show;
=head1 DESCRIPTION
This class is a general interface to individual records in esmith::DB
databases. It should not be used directly, but rather esmith::DBs
should hand you esmith::DB::Record objects.
Each subclass of esmith::DB will also have to subclass and implement
an esmith::DB::Record subclass.
=head2 Virtual Methods
=over 4
=item B<key>
my $key = $record->key;
Returns the $key for this $record;
=item B<props>
my %properties = $record->props;
my $num_props = $record->props;
Returns a hash of all the properties for this $record. In scalar
context it will return the number of properties this $record has.
=item B<prop>
=item B<set_prop>
my $value = $record->prop($property);
$record->set_prop($property, $value);
Gets/sets the $value of the $property in this $record.
set_prop() will die if the database is read-only.
=item B<delete_prop>
my $value = $record->delete_prop($property);
Deletes a $property from the $record, returning the old $value.
delete_prop() will die if the database is read-only.
=item B<merge_props>
$record->merge_props(%properties);
Adds the %properties to the $records existing properties. Any new
keys will be added, any existing keys will be overwritten.
merge_props() will die if the database is read-only.
=item B<reset_props>
$record->reset_props(%properties);
Replaces the $record's properties with the contents of %properties.
Any old properties will be deleted.
reset_props() will die if the database is read-only.
=item B<delete>
$record->delete;
Deletes the $record from its database.
delete() will die if the database is read-only.
=back
=head2 Concrete methods
=over 4
=item B<show>
my $formatted = $record->show;
Returns the $record's key and properties in a nice, human readable
format suitable for printing.
=cut
sub show {
my($self) = shift;
my $out = $self->key."\n";
my %props = $self->props;
# Determine our longest key so we know how to format.
my $max_len = 0;
foreach (keys %props) { $max_len = length if length > $max_len }
# But don't go too far.
$max_len = 40 if $max_len > 40;
foreach my $prop (sort { $a cmp $b } keys %props) {
$out .= sprintf " %${max_len}s = %s\n", $prop, $props{$prop};
}
return $out;
}
=back
=head1 SEE ALSO
L<esmith::DB>
=cut
1;

View File

@ -0,0 +1,660 @@
#----------------------------------------------------------------------
# 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::DB::db;
use strict;
use warnings;
use Carp;
our $VERSION = sprintf '%d.%03d', q$Revision: 1.29 $ =~ /: (\d+).(\d+)/;
use esmith::db;
use esmith::config;
use esmith::DB::db::Record;
use esmith::DB;
our @ISA = qw(esmith::DB);
=for testing
use_ok('esmith::DB::db');
=head1 NAME
esmith::DB::db - interface to esmith::db databases
=head1 SYNOPSIS
I<Works just like an esmith::DB class except where noted>
=head1 DESCRIPTION
This module provides an abstracted interface to esmith::db flat-file
databases. It will read from and write to esmith::db files and can be
safely used right along side esmith::db. This follows the esmith::DB
interface and will work as documented there unless otherwise stated.
You should use this instead of esmith::db, and replace any existing
esmith::db code with this.
I<Note for esmith::db users> the old concept of a 'type' is now simply
another property.
my $type = $record->prop('type');
replaces db_get_type().
The $record returned by esmith::DB::db subclass is an esmith::DB::db::Record
subclass object. See the esmith::DB::db manpage for details on how it is used.
=head2 Methods
=over 4
=item B<create>
Puts its error on esmith::DB::db->error
=begin testing
$Scratch_Conf = '10e-smith-lib/scratch.conf';
unlink $Scratch_Conf;
$db = esmith::DB::db->create($Scratch_Conf);
END { unlink $Scratch_Conf }
isa_ok( $db, 'esmith::DB::db', 'create()' );
ok( -e $Scratch_Conf, 'created a new config file' );
ok(! esmith::DB::db->create($Scratch_Conf),
'create() wont walk over an existing config' );
like( esmith::DB::db->error, qr/^File exists/, ' right error message' );
=end testing
=cut
sub create
{
my ( $class, $file ) = @_;
$file = $class->_file_path($file);
my $self;
eval {
$self = $class->_init($file);
croak "File exists" if -e $file;
$self->{config} = $self->_get_config($file)
|| croak "Can't get the esmith::config object";
# touch the config file so it gets created immediately
open( FILE, ">>$file" )
or die "Failed to open $file for appending: $!\n";
close FILE;
# Migrate, and check for errors, propagating them if they happen.
unless ( $self->migrate() )
{
chomp $@;
$self->set_error($@);
return;
}
};
if ($@)
{
chomp $@;
$self->set_error($@);
return;
}
return $self;
}
=item B<open>
=for notes
There's currently no way to get the reason why from esmith::config.
=begin testing
unlink $Scratch_Conf;
ok( !esmith::DB::db->open($Scratch_Conf), 'open() on a non-existent db' );
is( esmith::DB::db->error, "File doesn't exist", ' right error' );
esmith::DB::db->create($Scratch_Conf);
$DB = esmith::DB::db->open($Scratch_Conf);
isa_ok( $DB, 'esmith::DB::db' );
=end testing
=cut
sub open
{
my ( $class, $file ) = @_;
$file = $class->_file_path($file);
my $self = $class->_init($file);
if ( -e $file && !-w $file )
{
$self->{ro} = 1;
}
return $self->_open($file) ? $self : undef;
}
=item B<open_local>
=for notes
There's currently no way to get the reason why from esmith::config.
=begin testing
unlink $Scratch_Conf;
ok( !esmith::DB::db->open_local($Scratch_Conf), 'open() on a non-existent db' );
is( esmith::DB::db->error, "File doesn't exist", ' right error' );
esmith::DB::db->create($Scratch_Conf);
$DB = esmith::DB::db->open_local($Scratch_Conf);
isa_ok( $DB, 'esmith::DB::db' );
=end testing
=cut
sub open_local
{
my ( $class, $file ) = @_;
$file = $class->_file_path($file);
my $self = $class->_init($file);
if ( -e $file && !-w $file )
{
$self->{ro} = 1;
}
return $self->_open($file) ? $self : undef;
}
=begin testing
ok( my $db = esmith::DB::db->open_ro($Scratch_Conf),
'open_ro on a non-existent db');
eval { $db->new_record('foo', { type => 'bar' }) };
like( $@, qr/^This DB is opened read-only/ );
=end testing
=cut
sub open_ro
{
my ( $class, $file ) = @_;
$file = $class->_file_path($file);
my $self = $class->_init($file);
$self->{ro} = 1;
return $self->_open($file) ? $self : undef;
}
=begin testing
ok( my $db = esmith::DB::db->open_ro_local($Scratch_Conf),
'open_ro on a non-existent db');
eval { $db->new_record('foo', { type => 'bar' }) };
like( $@, qr/^This DB is opened read-only/ );
=end testing
=cut
sub open_ro_local
{
my ( $class, $file ) = @_;
$file = $class->_file_path($file);
my $self = $class->_init($file);
$self->{ro} = 1;
return $self->_open($file) ? $self : undef;
}
sub is_ro
{
return $_[0]->{ro} ? 1 : 0;
}
sub _open
{
my ( $self, $file ) = @_;
eval {
# This is unfortunately not atomic, but I don't think
# that's a big deal.
die "File doesn't exist\n" unless -e $file;
die "File isn't readable\n" unless -r $file;
$self->{config} = $self->_get_config($file)
|| die "Can't get the esmith::config object";
};
if ($@)
{
chomp $@;
$self->set_error($@);
return;
}
return 1;
}
sub _get_config
{
my ( $self, $file ) = @_;
my %config;
tie %config, $self->tie_class, $file;
return \%config;
}
sub _init
{
my ( $class, $file ) = @_;
my $self = bless { file => $file }, $class;
return $self;
}
sub _file_path
{
my ( $class, $file ) = @_;
if ($file =~ m:/:)
{
use File::Basename;
warn "Deprecated pathname $file passed to _file_path()\n"
if dirname($file) eq "/home/e-smith";
return $file;
}
if (-e "/home/e-smith/db/$file")
{
return "/home/e-smith/db/$file";
} elsif (-e "/home/e-smith/$file") {
warn "Database found in old location /home/e-smith/$file";
return "/home/e-smith/$file";
} else {
return "/home/e-smith/db/$file";
}
}
=item B<as_hash>
=begin testing
use esmith::TestUtils qw(scratch_copy);
my $scratch = scratch_copy('10e-smith-lib/db_dummy.conf');
my %db = esmith::DB::db->as_hash($scratch);
my %expect = ( Foo => { type => 'Bar' },
Night => { type => 'Day' },
Squid => { type => 'cephalopod',
arms => 10,
species => 'Loligo' },
Pipe => { type => 'art',
pipe => 'this is not a | got that?',},
Haiku => { type => 'poem',
words =>
"Damian Conway\nGod damn! Damian Conway\nDamian Conway",
},
Octopus => { type => 'cephalopod',
arms => 8,
species => '',
}
);
is_deeply( \%db, \%expect );
%db = esmith::DB::db->open($scratch)->as_hash;
is_deeply( \%db, \%expect );
=end testing
=item B<reload>
=begin testing
my $db2 = esmith::DB::db->open($Scratch_Conf);
my $something = $DB->new_record('something', { type => "wibble" });
isa_ok( $something, 'esmith::DB::db::Record', 'new record in 1st DB' );
ok( !$db2->get('something'), ' 2nd DB still cant see new record' );
ok( $db2->reload, ' reload' );
ok( $db2->get('something'), ' 2nd DB can see new record' );
$something->delete;
=end testing
=cut
sub reload
{
my ($self) = shift;
$self->_open( $self->file );
}
=item B<file>
=for testing
is( $db->file, $Scratch_Conf, 'file()' );
=cut
sub file
{
my ($self) = shift;
return $self->{file};
}
=item B<new_record>
=begin testing
my $record = $DB->new_record('Big Brother', { year => 1984,
day => 'night',
type => 'Govt',
});
isa_ok( $record, 'esmith::DB::db::Record', 'new_record' );
is( $record->key, 'Big Brother', 'key' );
is( $record->prop('type'), 'Govt', 'type' );
is_deeply( {$record->props}, {year => 1984, day => 'night', type => 'Govt'},
'props' );
is( $record->prop('year'), 1984, 'prop() get' );
is( $record->prop('day'), 'night', 'prop() get again' );
$record = $DB->new_record('No props');
isa_ok( $record, 'esmith::DB::db::Record', 'new_record() w/o props' );
is( $record->key, 'No props', ' key' );
my $db2 = esmith::DB::db->open($DB->file);
ok( $db2->get('No props'), ' can be gotten' );
$record->delete;
=end testing
=cut
sub new_record
{
my ( $self, $key, $props ) = @_;
croak "This DB is opened read-only" if $self->is_ro;
if ( defined db_get( $self->{config}, $key ) )
{
return;
}
my $type = exists $props->{type} ? delete $props->{type} : '';
db_set( $self->{config}, $key, $type, $props );
$self->tie_class->_writeconf($self->{file}, $self->{config});
return esmith::DB::db::Record->_construct( $self, $key, $self->{config} );
}
=item B<get>
=begin testing
my $rec = $DB->get('Big Brother');
isa_ok( $rec, 'esmith::DB::db::Record', 'get' );
is( $rec->key, 'Big Brother', ' right key' );
=end testing
=cut
sub get
{
my ( $self, $key ) = @_;
unless ( defined db_get( $self->{config}, $key ) )
{
return;
}
return esmith::DB::db::Record->_construct( $self, $key, $self->{config} );
}
=item B<get_all>
=begin testing
$DB->new_record('Borg', { type => 'Govt', resistance => 'futile' });
my @records = $DB->get_all;
is( @records, 2, 'get_all' );
ok( !(grep { !$_->isa('esmith::DB::db::Record') } @records),
' theyre all records' );
=end testing
=cut
sub get_all
{
my ($self) = shift;
return
map { esmith::DB::db::Record->_construct( $self, $_, $self->{config} ) }
db_get( $self->{config} );
}
=item B<get_all_by_prop>
=begin testing
$DB->new_record('Pretz', { type => 'snack', flavor => 'old fashion' });
my @records = $DB->get_all_by_prop(type => 'Govt');
is( @records, 2, 'get_all_by_prop() type' );
ok( !(grep { $_->prop('type') ne 'Govt' } @records),
' theyre the right type' );
$DB->new_record('Pork lips', { type => 'snack', flavor => 'old fashion' });
@records = $DB->get_all_by_prop(flavor => 'old fashion');
is( @records, 2, 'get_all_by_prop()' );
ok( !(grep { $_->prop('flavor') ne 'old fashion' } @records),
' they have the right properties' );
=end testing
=cut
sub tie_class
{
return 'esmith::config';
}
sub close
{
}
=begin deprecated
=item B<list_by_type>
Given a type of item to look for in the database (eg "service", "ibay"),
returns a list of items which are that type. This is the underlying
routine behind esmith::AccountsDB::ibays() and similar methods.
=end deprecated
=for testing
ok($DB->list_by_type("Govt"), "list_by_type *deprecated*");
=cut
sub list_by_type
{
my ( $self, $type ) = @_;
return map $_->key, $self->get_all_by_prop( type => $type );
}
=back
=head1 EXAMPLE
The full docs can be found in esmith::DB and esmith::DB::Record, but
here's a cheat sheet for esmith::config and esmith::db users.
=over 4
=item opening the default config
use esmith::config
my %config;
tie %config, 'esmith::config;
Now:
use esmith::ConfigDB;
my $config = esmith::ConfigDB->open;
=item opening a specific config database
my %config;
tie %config, 'esmith::config', $config_file;
Now:
my $config = esmith::ConfigDB->open($config_file);
=item creating a new config database
This one's important. Before you could just tie esmith::config to any file
and it would create it for you. Now you have to explicitly create it.
my %config;
tie %config, 'esmith::config', $new_config_file;
Now:
my $config = esmith::ConfigDB->create($new_config_file);
=item checking if a record exists
print "Yep" if exists $config{foo};
now:
print "Yep" if $config->get('foo'); # unless of course, 'foo' is zero
=item creating a new record
Previously you could just create records on the fly:
# single value
$config{foo} = 'whatever';
# with properties
db_set(\%config, 'whatever', 'sometype', { with => 'properties' });
Now you have to explicitly create them:
# single value
my $foo = $config->new_record('foo');
$foo->set_value('foo');
# with properties
my %defaults = ( 'type' => 'sometype',
'linux' => 'stable',
'windows' => 'stable?' );
my $foo = $config->new_record('foo', \%defaults);
Note that 'type' is now just another property.
Here's a handy "create this if it doesn't already exist" idiom.
my $rec = $config->get($key) ||
$config->new_record($key);
=item getting a value
Entries in a database should no longer be thought of as values, but as
records.
my $val = $config{foo};
Now this only works with entries with single value. Things with
multiple properties are dealt with differently.
my $record = $config->get('foo');
my $val = $record->value;
=item setting a value
$config{foo} = 'something';
now
my $record = $config->get('foo');
$record->set_value('something');
=item getting a property
my $this = db_get_prop(\%config, 'foo', 'this');
now:
my $foo = $config->get('foo');
my $this = $foo->prop('this');
=item getting & setting properties
my $val = db_get_prop(\%config, 'foo', 'some prop');
db_set_prop(\%config, 'foo', 'some prop' => $new_val);
now:
my $val = $record->prop('some prop');
$record->set_prop('some prop' => $new_val);
=item get/setting the type
my $type = db_get_type(\%config, 'foo');
db_set_type(\%config, 'foo', $new_type);
type is now just a property
my $record = $db->get('foo');
my $type = $record->prop('type');
$record->set_prop('type', $new_type);
=item getting all the properties
my %props = db_get_prop(\%config, 'foo');
now
my %props = $record->props;
=back
=head1 AUTHOR
SME Server Developers <bugs@e-smith.com>
=head1 SEE ALSO
L<esmith::AccountsDB>, L<esmith::ConfigDB>, L<esmith::DB::db::Record>
=cut
1;

View File

@ -0,0 +1,353 @@
#----------------------------------------------------------------------
# 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::DB::db::Record;
use strict;
use warnings;
use Carp;
use esmith::db;
use esmith::DB::db;
require esmith::DB::Record;
our @ISA = qw(esmith::DB::Record);
=begin testing
use_ok('esmith::DB::db::Record');
use_ok('esmith::DB::db');
use File::Copy;
$Scratch_Conf = '10e-smith-lib/scratch.conf';
copy('10e-smith-lib/db_dummy.conf', $Scratch_Conf);
END { unlink $Scratch_Conf }
$DB = esmith::DB::db->open($Scratch_Conf);
$Squid = $DB->get('Squid');
=end testing
=head1 NAME
esmith::DB::db::Record - Individual records in an esmith::db database
=head1 SYNOPSIS
Unless otherwise noted, works just like esmith::DB::Record.
=head1 DESCRIPTION
This class represents entries in esmith::db flat-file database. A
single object is a single line.
This class is not useful by itself but rather they are handed out
via esmith::DB::db objects.
=begin protected
=head2 Protected Methods
These methods are only allowed to be called by esmith::DB::db classes.
=item B<_construct>
my $record = esmith::DB::db::Record->_construct($db, $key, $config);
Generates a new esmith::DB::db::Record representing data inside the
$db (an esmith::DB::db object).
This does *not* write anything into $db. This is here so a $db can
initialize a new Record from existing data.
=end protected
=cut
sub _construct {
my($class, $db, $key, $config) = @_;
die "_construct may only be called by esmith::DB::db"
unless caller->isa('esmith::DB::db');
my $self = {
db => $db,
config => $config,
key => $key
};
return bless $self, $class;
}
=head2 Methods
=over 4
=item B<key>
=for testing
is( $Squid->key, 'Squid', 'key()' );
=cut
sub key {
my($self) = shift;
return $self->{key};
}
=item B<props>
=for testing
is_deeply( {$Squid->props}, {arms => 10, species => 'Loligo',
type => 'cephalopod'}, 'props()' );
=cut
sub props {
my($self) = shift;
my %props = db_get_prop($self->{config}, $self->{key});
$props{type} = db_get_type($self->{config}, $self->{key});
foreach my $prop (keys %props) {
$props{$prop} =~ s{\\\|}{\|}g if $props{$prop};
}
return wantarray ? %props : keys %props;
}
=item B<prop>
=item B<set_prop>
=begin testing
is( $Squid->prop('arms'), 10, 'prop()' );
$Squid->set_prop('arms', 1000);
is( $Squid->prop('arms'), 1000, 'set_prop()' );
is( $Squid->prop('type'), 'cephalopod', 'prop() type get' );
$Squid->set_prop('type', 'tree dweller');
is( $Squid->prop('type'), 'tree dweller', 'set_prop() type set' );
$Squid->set_prop('bar', 'foo | bar');
is( $Squid->prop('bar'), 'foo bar', 'prop/set_prop with pipes - pipe stripped' );
{
my $warning = '';
local $SIG{__WARN__} = sub { $warning = join '', @_ };
$Squid->prop('bar', 'foo');
like( $warning, qr/^prop\(\) got extra arguments 'foo'. Maybe you ment set_prop\(\)\?/, 'prop()/set_prop() mixup warns' );
$warning = '';
is( $Squid->prop('I_dont_exist'), undef, 'prop() on non-existent prop' );
is( $warning, '', ' no warning' );
$warning = '';
$Squid->set_prop('I_dont_exist', undef);
is( $Squid->prop('I_dont_exist'), '', 'set_prop() with undef value' );
is( $warning, '', ' no warning' );
$Squid->delete_prop('I_dont_exist');
}
=end testing
=cut
sub prop {
my($self, $property) = splice @_, 0, 2;
warn sprintf "prop() got extra arguments '%s'. Maybe you ment set_prop()?",
"@_" if @_;
my $value;
if( $property eq 'type' ) {
$value = db_get_type($self->{config}, $self->{key});
}
else {
$value = db_get_prop($self->{config}, $self->{key}, $property);
}
# Unescape escaped pipes. esmith::db can't do this for us.
$value =~ s{\\\|}{\|}g if defined $value;
return $value;
}
sub set_prop {
my($self, $property, $value) = @_;
croak "The DB is open read-only" if $self->{db}->is_ro;
# Strip pipes - we can't safely escape them while some code
# still expects to split on pipe
$value =~ s{\|}{}g if defined $value;
my $ret;
if( $property eq 'type' ) {
$ret = db_set_type($self->{config}, $self->{key}, $value);
}
else {
$ret = db_set_prop($self->{config}, $self->{key},
$property => $value);
}
return $ret;
}
=item B<delete_prop>
A special case for esmith::DB::db::Record, you're not allowed to
delete the 'type' property.
=for testing
is( $Squid->delete_prop('species'), 'Loligo',
'delete_prop() returns the old value' );
is_deeply( {$Squid->props}, {arms => 1000, bar => 'foo bar',
type => 'tree dweller' },
' and deletes' );
=cut
sub delete_prop {
my($self, $property) = @_;
croak "The DB is open read-only" if $self->{db}->is_ro;
croak "You're not allowed to delete a type from an esmith::DB::db::Record"
if $property eq 'type';
my $val = $self->prop($property);
db_delete_prop($self->{config}, $self->{key}, $property);
return $val;
}
=item B<merge_props>
=begin testing
my $octopus = $DB->get('Octopus');
$octopus->merge_props( arms => '8 + 2i', name => 'Fluffy', pipe => 'not |');
is_deeply( {$octopus->props}, { arms => '8 + 2i', type => 'cephalopod',
species => '', name => 'Fluffy',
pipe => 'not ' }, 'merge_props()' );
$octopus->merge_props( type => 'foo' );
is_deeply( {$octopus->props}, { arms => '8 + 2i', type => 'foo',
species => '', name => 'Fluffy',
pipe => 'not ' }, ' with type' );
$octopus->merge_props( { type => 'foo' } );
like( $_STDERR_, qr/^merge_props\(\) was accidentally passed a hash ref/m,
' anti-hash ref protection');
=end testing
=cut
sub merge_props {
my($self, %new_props) = @_;
croak "The DB is open read-only" if $self->{db}->is_ro;
if( ref $_[1] ) {
carp("merge_props() was accidentally passed a hash ref");
}
my %props = $self->props;
my %merged_props = (%props, %new_props);
# Strip out pipes.
foreach my $prop (keys %merged_props) {
$merged_props{$prop} =~ s{\|}{}g
if defined $merged_props{$prop};
}
my $type = delete $merged_props{type};
db_set($self->{config}, $self->{key}, $type, \%merged_props);
}
=item B<reset_props>
=begin testing
my $octopus = $DB->get('Octopus');
eval { $octopus->reset_props( { type => 'foo' } ); };
like( $_STDERR_, qr/^reset_props\(\) was accidentally passed a hash ref/m,
' anti-hash ref protection');
$octopus->reset_props( arms => 8, name => 'Rupert', type => 'foo' );
is_deeply( {$octopus->props}, { arms => '8', name => 'Rupert',
type => 'foo' }, 'reset_props' );
eval { $octopus->reset_props( arms => '8 + 2i', name => 'Fluffy',
pipe => 'not ') };
like( $@, qr/^You must have a type property/, ' you must have a type');
=end testing
=cut
sub reset_props {
my($self, %new_props) = @_;
croak "The DB is open read-only" if $self->{db}->is_ro;
if( ref $_[1] ) {
carp("reset_props() was accidentally passed a hash ref");
}
die "You must have a type property" unless $new_props{type};
# Strip out pipes
foreach my $prop (keys %new_props) {
$new_props{$prop} =~ s{\|}{}g
if defined $new_props{$prop};
}
my $type = delete $new_props{type} || $self->prop('type');
db_set($self->{config}, $self->{key}, $type, \%new_props);
}
=item B<delete>
=for testing
my $foo = $DB->get('Foo');
$foo->delete;
ok( !$DB->get('Foo'), 'delete()' );
=cut
sub delete {
my($self) = shift;
croak "The DB is open read-only" if $self->{db}->is_ro;
db_delete($self->{config}, $self->{key});
}
=item B<show>
=begin testing
is( $Squid->show, <<SQUID, 'show' );
Squid
arms = 1000
bar = foo bar
type = tree dweller
SQUID
=end testing
=back
=head1 SEE ALSO
L<esmith::DB::db>
=cut
1;

View File

@ -0,0 +1,99 @@
#----------------------------------------------------------------------
# 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::DomainsDB;
use strict;
use warnings;
use esmith::DB::db;
our @ISA = qw( esmith::DB::db );
=head1 NAME
esmith::DomainsDB - interface to esmith domains database
=head1 SYNOPSIS
use esmith::DomainsDB;
my $c = esmith::DomainsDB->open;
# everything else works just like esmith::DB::db
=head1 DESCRIPTION
This module provides an abstracted interface to the esmith domain
database.
Unless otherwise noted, esmith::DomainsDB acts like esmith::DB::db.
=cut
=head2 open()
Like esmith::DB->open, but if given no $file it will try to open the
file in the ESMITH_DOMAINS_DB environment variable or domains.
=begin testing
use_ok("esmith::DomainsDB");
$C = esmith::DomainsDB->open('10e-smith-lib/domains.conf');
isa_ok($C, 'esmith::DomainsDB');
is( $C->get("test")->prop('foo'), "bar",
"We can get stuff from the db");
=end testing
=cut
sub open {
my ($self, $file) = @_;
$file = $file || $ENV{ESMITH_DOMAINS_DB} || "domains";
return $self->SUPER::open($file);
}
=head2 open_ro()
Like esmith::DB->open_ro, but if given no $file it will try to open the
file in the ESMITH_DOMAINS_DB environment variable or domains.
=begin testing
=end testing
=cut
sub open_ro {
my($class, $file) = @_;
$file = $file || $ENV{ESMITH_DOMAINS_DB} || "domains";
return $class->SUPER::open_ro($file);
}
=for testing
$C = esmith::DomainsDB->open('10e-smith-lib/domains.conf');
isa_ok($C, 'esmith::DomainsDB');
can_ok($C, 'domains');
can_ok($C, 'get_all_by_prop');
is(scalar($C->domains()), 2, "Found 2 domains with domains()");
=cut
sub domains {
my ($self) = @_;
return $self->get_all_by_prop(type => 'domain');
}
=head1 AUTHOR
SME Server Developers <bugs@e-smith.com>
=head1 SEE ALSO
L<esmith::ConfigDB>
=cut
1;

View File

@ -0,0 +1,230 @@
#----------------------------------------------------------------------
# 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::HostsDB;
use strict;
use warnings;
use esmith::DB::db;
our @ISA = qw( esmith::DB::db );
=head1 NAME
esmith::HostsDB - interface to esmith hostnames/addresses database
=head1 SYNOPSIS
use esmith::HostsDB;
my $hosts = esmith::HostsDB->open;
# everything else works just like esmith::DB::db
# these methods are added
my @hosts = $hosts->hosts;
my @new_hosts = $hosts->propogate_hosts;
=head1 DESCRIPTION
This module provides an abstracted interface to the esmith hosts
database.
Unless otherwise noted, esmith::HostsDB acts like esmith::DB::db.
=cut
=head2 Overridden methods
=over 4
=item I<open>
Like esmith::DB->open, but if given no $file it will try to open the
file in the ESMITH_HOSTS_DB environment variable or hosts.
=begin testing
use_ok("esmith::HostsDB");
$H = esmith::HostsDB->open('10e-smith-lib/hosts.conf');
isa_ok($H, 'esmith::HostsDB');
is( $H->get("otherhost.mydomain.xxx")->prop('InternalIP'), "192.168.1.3",
"We can get stuff from the db");
=end testing
=cut
sub open {
my($class, $file) = @_;
$file = $file || $ENV{ESMITH_HOSTS_DB} || "hosts";
return $class->SUPER::open($file);
}
=head2 open_ro()
Like esmith::DB->open_ro, but if given no $file it will try to open the
file in the ESMITH_HOSTS_DB environment variable or hosts.
=begin testing
=end testing
=cut
sub open_ro {
my($class, $file) = @_;
$file = $file || $ENV{ESMITH_HOSTS_DB} || "hosts";
return $class->SUPER::open_ro($file);
}
=back
=head2 Additional Methods
These methods are added be esmith::HostsDB
=over 4
=item I<hosts>
my @hosts = $hosts->hosts;
Returns a list of all host records in the database.
=begin testing
$db = esmith::HostsDB->open('10e-smith-lib/hosts.conf');
isa_ok($db, 'esmith::HostsDB');
can_ok($db, 'hosts');
my @hosts = $db->hosts();
isnt( @hosts, 0 );
is_deeply(\@hosts, [$db->get_all_by_prop('type' => 'host')]);
=end testing
=cut
sub hosts {
my ($self) = @_;
return $self->get_all_by_prop('type' => 'host');
}
=item I<propogate_hosts>
my @new_hosts = $hosts->propogate_hosts($old_name, $new_name);
When the name of your e-smith machine changes, this will change the
name of any hosts which also started with $old_name to use the
$new_name.
Returns a list of the newly tranlsated host records.
=begin testing
use esmith::ConfigDB;
my $hosts_file = '10e-smith-lib/propogate_hosts.conf';
END { unlink $hosts_file }
my $db = esmith::HostsDB->create($hosts_file);
use esmith::TestUtils qw(scratch_copy);
my $c_scratch = scratch_copy('10e-smith-lib/configuration.conf');
my $config = esmith::ConfigDB->open($c_scratch);
isa_ok($config, 'esmith::ConfigDB');
my $name = $config->get('SystemName')->value;
# setup some dummy hosts to propogate.
foreach my $host ( "$name.tofu-dog.com", "$name.wibble.org",
"wibble.$name.org", "yarrow.hack" )
{
$db->new_record($host, { type => 'host', HostType => 'Self',
ExternalIP => '', InternalIP => ''
});
}
$db->reload;
my @new_hosts = $db->propogate_hosts($name, "armondo");
my @hosts = $db->hosts;
is( @hosts, 4 );
is_deeply( [sort map { $_->key } @hosts],
[sort +('armondo.tofu-dog.com',
'armondo.wibble.org',
"wibble.$name.org",
'yarrow.hack',
)]
);
is( @new_hosts, 2 );
is_deeply( [sort map { $_->key } @new_hosts],
[sort qw(armondo.tofu-dog.com armondo.wibble.org)]
);
=end testing
=cut
sub propogate_hosts
{
my($self, $old_name, $new_name) = @_;
my @new_hosts = ();
foreach my $host ($self->hosts)
{
my $new_host = $host->key;
if( $new_host =~ s/^\Q$old_name.\E/$new_name./ )
{
push @new_hosts, $self->new_record($new_host,
{ $host->props }
);
$host->delete;
}
}
return @new_hosts;
}
=head2 $db->get_hosts_by_domain
Given a domain name (as a string), finds any hosts which match it and
return them as a list of record objects.
=begin testing
my $h = esmith::HostsDB->open('10e-smith-lib/hosts.conf');
my @hosts = $h->get_hosts_by_domain('otherdomain.xxx');
is(scalar(@hosts), 2, "Found two hosts in otherdomain.xxx");
isa_ok($hosts[0], 'esmith::DB::Record');
=end testing
=cut
sub get_hosts_by_domain {
my ($self, $domain) = @_;
my @all = $self->get_all();
my @return;
foreach my $h (@all) {
push @return, $h if $h->key() =~ /^[^\.]+\.$domain$/;
}
return @return;
}
=back
=head1 AUTHOR
SME Server Developers <bugs@e-smith.com>
=head1 SEE ALSO
L<esmith::ConfigDB>
=cut
1;

View File

@ -0,0 +1,331 @@
#----------------------------------------------------------------------
# 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::I18N;
use strict;
use esmith::ConfigDB;
use POSIX qw(setlocale LC_ALL LC_CTYPE);
use Locale::gettext;
use I18N::AcceptLanguage;
use I18N::LangTags qw(is_language_tag locale2language_tag);
=pod
=head1 NAME
esmith::I18N - Internationalization utilities Mitel Network SME Server
=head1 VERSION
This file documents C<esmith::I18N> version B<1.4.0>
=head1 SYNOPSIS
use esmith::I18N;
my $i18n = new esmith::I18N;
=head1 DESCRIPTION
This module provides general internationalization and localisation
utilities for developers of the Mitel Networks SME Server.
=begin testing
use I18N::LangTags qw(is_language_tag locale2language_tag language_tag2locale);
use_ok('esmith::I18N');
=end testing
=head1 GENERAL UTILITIES
=cut
sub new
{
my $self = shift;
my $class = ref($self) || $self;
my %args = @_;
return $self;
}
=head2 availableLocales()
Returns an array containing the available locales supported by the
server.
=begin testing
$ENV{ESMITH_CONFIG_DB}="10e-smith-lib/sysconfig-en_US.conf";
$ENV{ESMITH_I18N_USRSHARELOCALE}="10e-smith-lib/usr/share/locale";
my $i18n = new esmith::I18N;
my @locales = grep !/CVS/, sort $i18n->availableLocales;
# NOTE: de is not a valid locale for the test - no server-console file
is_deeply(\@locales, [('en_US', 'fr_CA', 'wx_YZ')], "Locales match" );
=end testing
=cut
sub availableLocales()
{
my ($self) = shift;
my $localedir = $ENV{ESMITH_I18N_USRSHARELOCALE} || '/usr/share/locale';
return () unless opendir LOCALE, $localedir;
my @locales;
foreach my $locale ( grep(!/\./, readdir LOCALE) )
{
push @locales, $locale if
(-f "$localedir/$locale/LC_MESSAGES/server-console.mo" or
-f "$localedir/$locale/LC_MESSAGES/server-console.po");
}
closedir LOCALE;
return @locales;
}
=head2 fallbackLocale()
Return system fallback locale
=cut
sub fallbackLocale()
{
return "en_US.utf8";
}
=head2 preferredLocale()
Retrieves the preferred locale for this server.
=begin testing
$ENV{ESMITH_CONFIG_DB}="10e-smith-lib/sysconfig-en_US.conf";
my $i18n = new esmith::I18N;
is($i18n->preferredLocale, 'en_US', "en_US.conf: Preferred locale is en_US");
$ENV{ESMITH_CONFIG_DB}="10e-smith-lib/sysconfig-fr_CA.conf";
$i18n = new esmith::I18N;
is($i18n->preferredLocale, 'fr_CA', "fr_CA.conf: Preferred locale is fr_CA");
=end testing
=cut
sub preferredLocale()
{
my ($self) = shift;
my $db = esmith::ConfigDB->open_ro || return $self->fallbackLocale;
my ($locale, @rest) = $db->getLocale();
return $locale || $self->fallbackLocale;
}
=head2 setLocale()
Configure the locale for gettext() for the supplied text domain.
The method takes two arguments, the text domain, and an optional argument
which can be either a language tag or a locale.
=cut
sub setLocale()
{
my ($self, $text_domain, $opt) = @_;
my $locale;
$locale = $self->langtag2locale($opt) if ($opt);
$locale ||= $self->preferredLocale;
$locale =~ s{(?:\..*)?$}{.utf8};
$ENV{'LANGUAGE'} = $locale;
$ENV{'LANG'} = $ENV{'LANGUAGE'};
setlocale(LC_MESSAGES, $locale);
setlocale(LC_MESSAGES, $locale);
setlocale(LC_ALL, $locale);
setlocale(LC_ALL, $locale);
bindtextdomain ($text_domain, "/usr/share/locale");
textdomain ($text_domain);
}
=head2 langtag2locale
Even though the directories appear in /usr/share/locale, they also need
to appear in /usr/lib/locale to actually be treated as locales. Read the
Perl locale docs for details of how horrid this is. For now, we're just
going to force things for supported languages.
=begin testing
my $i18n = new esmith::I18N;
is($i18n->langtag2locale("en"), "en_US", "en langtag is en_US locale");
is($i18n->langtag2locale("en-us"), "en_US", "en-us langtag is en_US locale");
is($i18n->langtag2locale("en-au"), "en_AU", "en-au langtag is en_AU locale");
is($i18n->langtag2locale("es"), "es_ES", "es langtag is es_ES locale");
is($i18n->langtag2locale("es-es"), "es_ES", "es-es langtag is es_ES locale");
is($i18n->langtag2locale("es-ar"), "es_AR", "es-ar langtag is es_AR locale");
is($i18n->langtag2locale("fr"), "fr_CA", "fr langtag is fr_CA locale");
is($i18n->langtag2locale("fr-ca"), "fr_CA", "fr-ca langtag is fr_CA locale");
is($i18n->langtag2locale("fr-fr"), "fr_FR", "fr-fr langtag is fr_FR locale");
=end testing
=cut
sub langtag2locale
{
my ($self, $opt) = @_;
my $locale;
if (is_language_tag($opt))
{
$locale = _language_tag2locale($opt) || $self->fallbackLocale;
unless (-d "/usr/lib/locale/$locale")
{
$locale = "da_DK" if ($opt =~ /^da(-.*)?/);
$locale = "de_DE" if ($opt =~ /^de(-.*)?/);
$locale = "el_GR" if ($opt =~ /^el(-.*)?/);
$locale = "en_US" if ($opt =~ /^en(-.*)?/);
$locale = "es_ES" if ($opt =~ /^es(-.*)?/);
$locale = "fr_CA" if ($opt =~ /^fr(-.*)?/);
$locale = "hu_HU" if ($opt =~ /^hu(-.*)?/);
$locale = "id_ID" if ($opt =~ /^id(-.*)?/);
$locale = "it_IT" if ($opt =~ /^it(-.*)?/);
$locale = "nl_NL" if ($opt =~ /^nl(-.*)?/);
$locale = "pt_BR" if ($opt =~ /^pt(-.*)?/);
$locale = "sl_SL" if ($opt =~ /^sl(-.*)?/);
$locale = "sv_SE" if ($opt =~ /^sv(-.*)?/);
}
}
else
{
$locale = $opt;
}
return $locale;
}
sub _language_tag2locale
{
my $langtags = $_[0];
my @locales;
foreach my $maybe (split /[\n\r\t ,]+/, $langtags)
{
push @locales,
lc($1) . ( $2 ? ('_' . uc($2)) : '' )
if $maybe =~ m/^([a-zA-Z]{2})(?:-([a-zA-Z]{2}))?$/s;
}
return $locales[0] unless wantarray; # might be undef!
return @locales; # might be empty!
}
=head2 availableLanguages()
Returns an array containing the available languages supported by the
server.
=begin testing
$ENV{ESMITH_CONFIG_DB}="10e-smith-lib/sysconfig-en_US.conf";
$ENV{ESMITH_I18N_ESMITHLOCALEDIR}="10e-smith-lib/etc/e-smith/locale";
my $i18n = new esmith::I18N;
my @locales = grep !/CVS/, sort $i18n->availableLanguages;
is_deeply(\@locales, [('en-us', 'es', 'fr-ca', 'jk', 'wx-yz')], "Locales match" );
=end testing
=cut
sub availableLanguages
{
my ($self) = shift;
my $localedir = $ENV{ESMITH_I18N_ESMITHLOCALEDIR} || '/etc/e-smith/locale';
return () unless opendir LOCALE, $localedir;
my @locales = grep(!/\./, readdir LOCALE);
closedir LOCALE;
return @locales;
}
=head2 fallbackLanguage()
Return system fallback language
=cut
sub fallbackLanguage()
{
return "en-us";
}
=head2 preferredLanguage()
Returns the preferred language, determined by the HTTP_ACCEPT_LANGUAGE
setting from the browser and the available languages on the server.
=begin testing
my $i18n = new esmith::I18N;
delete $ENV{HTTP_ACCEPT_LANGUAGE};
is( $i18n->preferredLanguage(), "en-us", "Preferred language is en-us");
is( $i18n->preferredLanguage("en-us"), "en-us", "Preferred language is en-us");
is( $i18n->preferredLanguage("en-us, fr-ca"), "en-us", "Preferred language is en-us");
is( $i18n->preferredLanguage("fr-ca, en-us"), "fr-ca", "Preferred language is fr-ca");
$ENV{HTTP_ACCEPT_LANGUAGE} = "de, es";
is( $i18n->preferredLanguage(), "es", "Preferred language is es");
$ENV{HTTP_ACCEPT_LANGUAGE} = "de, fr-ca, es, en-us";
is( $i18n->preferredLanguage(), "fr-ca", "Preferred language is fr-ca");
$ENV{HTTP_ACCEPT_LANGUAGE} = "de, es, fr-ca, en-us";
is( $i18n->preferredLanguage(), "es", "Preferred language is es");
=end testing
=cut
sub preferredLanguage
{
my ($self, $browser_languages) = @_;
$browser_languages ||= $ENV{HTTP_ACCEPT_LANGUAGE}
||= $self->fallbackLanguage;
my @availableLanguages = $self->availableLanguages;
my $acceptor = I18N::AcceptLanguage->new();
my $language = $acceptor->accepts($browser_languages, \@availableLanguages)
|| $self->fallbackLanguage;
}
1;

View File

@ -0,0 +1,77 @@
#----------------------------------------------------------------------
# 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::Logger;
use Sys::Syslog qw(:DEFAULT setlogsock);
=head1 NAME
esmith::Logger - A filehandle abstraction around Syslog.
=head1 SYNOPSIS
use esmith::Logger;
tie *FH, 'esmith::Logger';
print FH "log message";
close FH;
=head1 DESCRIPTION
=cut
our $VERSION = sprintf '%d.%03d', q$Revision: 1.100 $ =~ /: (\d+).(\d+)/;
sub TIEHANDLE
{
my $class = ref($_[0]) || $_[0]; shift;
my $self;
my $title = shift || 'e-smith';
setlogsock 'unix';
openlog($title, 'pid', 'local1');
return bless \$self, $class;
}
sub PRINT
{
my $self = shift;
syslog('info', "%s", "@_");
}
sub PRINTF
{
my $self = shift;
my $fmt = shift;
syslog('info', $fmt, @_);
}
sub WRITE
{
die "Sorry, WRITE unimplemented.\n";
}
sub READ
{
die "Can't read from logger.\n";
}
sub READLINE
{
die "Can't read from logger.\n";
}
sub GETC
{
die "Can't read from logger.\n";
}
sub CLOSE
{
closelog();
}
1;

View File

@ -0,0 +1,16 @@
#----------------------------------------------------------------------
# Copyright 1999-2008 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::NavigationDB;
use strict;
use warnings;
use esmith::ConfigDB::UTF8;
our @ISA = qw( esmith::ConfigDB::UTF8 );
1;

View File

@ -0,0 +1,157 @@
#----------------------------------------------------------------------
# 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::NetworksDB;
use strict;
use warnings;
use esmith::DB::db;
our @ISA = qw( esmith::DB::db );
=head1 NAME
esmith::NetworksDB - interface to esmith networks database
=head1 SYNOPSIS
use esmith::NetworksDB;
my $c = esmith::NetworksDB->open;
# everything else works just like esmith::DB::db
=head1 DESCRIPTION
This module provides an abstracted interface to the esmith master
configuration database.
Unless otherwise noted, esmith::NetworksDB acts like esmith::DB::db.
=cut
=head2 open()
Like esmith::DB->open, but if given no $file it will try to open the
file in the ESMITH_NETWORKS_DB environment variable or networks.
=begin testing
use_ok("esmith::NetworksDB");
$C = esmith::NetworksDB->open('10e-smith-lib/networks.conf');
isa_ok($C, 'esmith::NetworksDB');
is( $C->get("10.0.0.0")->prop('Mask'), "255.255.255.0",
"We can get stuff from the db");
=end testing
=cut
sub open
{
my ( $class, $file ) = @_;
$file = $file || $ENV{ESMITH_NETWORKS_DB} || "networks";
return $class->SUPER::open($file);
}
=head2 open_ro()
Like esmith::DB->open_ro, but if given no $file it will try to open the
file in the ESMITH_NETWORKS_DB environment variable or networks.
=begin testing
=end testing
=cut
sub open_ro
{
my ( $class, $file ) = @_;
$file = $file || $ENV{ESMITH_NETWORKS_DB} || "networks";
return $class->SUPER::open_ro($file);
}
=head2 networks
Return a list of all objects of type "network".
=cut
sub networks {
my ($self) = @_;
return $self->get_all_by_prop(type => 'network');
}
=head2 local_access_spec ([$access])
Compute the network/netmask entries which are to treated as local access.
There is also an optional access parameter which can further restrict
the values returned. If C<access> is C<localhost>, this routine will only
return a single value, equating to access from localhost only.
If called in scalar context, the returned string is suitable for
use in /etc/hosts.allow, smb.conf and httpd.conf, for example:
127.0.0.1 192.168.1.1/255.255.255.0
Note: The elements are space separated, which is suitable for use in
hosts.allow, smb.conf and httpd.conf. httpd.conf does not permit
comma separated lists in C<allow from> directives. Each element is either
an IP address, or a network/netmask string.
If called in list context, returns the array of addresses and network/netmask
strings. It's trivial, of course, to convert an array to a comma separated
list :-)
=cut
sub local_access_spec
{
my $self = shift;
my $access = shift || "private";
my @localAccess = ("127.0.0.1");
if ( $access eq "localhost" )
{
# Nothing more to do
}
elsif ( $access eq "private" )
{
foreach my $network ( $self->networks )
{
my $element = $network->key;
my $mask = $network->prop('Mask');
$element .= "/$mask" unless ($mask eq "255.255.255.255");
push @localAccess, $element;
}
}
elsif ( $access eq "public" )
{
@localAccess = ("ALL");
}
else
{
warn "local_access_spec: unknown access value $access\n";
}
return wantarray ? @localAccess : "@localAccess";
}
=head1 AUTHOR
SME Server Developers <bugs@e-smith.com>
=head1 SEE ALSO
L<esmith::DB::db>
L<esmith::DB::Record>
=cut
1;

View File

@ -0,0 +1,480 @@
#----------------------------------------------------------------------
# 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::cgi;
use strict;
use esmith::config;
use esmith::db;
use esmith::util;
BEGIN
{
}
=pod
=head1 NAME
esmith::cgi - Useful CGI routines for e-smith server and gateway
=head1 VERSION
This file documents C<esmith::cgi> version B<1.4.0>
=head1 SYNOPSIS
use esmith::cgi;
=head1 DESCRIPTION
This module contains a collection of useful routines for working with
the e-smith manager's CGI interface.
=head1 WEB PAGE HEADER GENERATION ROUTINES
=head2 genHeaderNonCacheable($q, $confref, $title)
=cut
sub genHeaderNonCacheable
{
my ($q, $confref, $title) = @_;
genHeader ($q, $confref, $title, '-20y', 1);
}
=pod
=head2 genHeaderCacheableNoPasswordCheck($q, $confref, $title)
=cut
sub genHeaderCacheableNoPasswordCheck
{
my ($q, $confref, $title) = @_;
genHeader ($q, $confref, $title, '+1d', 0);
}
=pod
=head2 genHeaderCacheableNoPasswordCheck($q, $confref, $title)
=cut
sub genHeaderNonCacheableNoPasswordCheck
{
my ($q, $confref, $title) = @_;
genHeader ($q, $confref, $title, '-20y', 0);
}
=pod
=head2 genHeader($q, $confref, $title, $expiry, $checkpassword)
=cut
sub genHeader
{
my ($q, $confref, $title, $expiry, $checkpassword) = @_;
print $q->header (-EXPIRES => $expiry, charset => 'UTF-8');
genHeaderStartHTML ($q, "panel_main");
print $q->h1 ($title);
}
=pod
=head2 genNavigationHeader($q)
=cut
sub genNavigationHeader
{
my ($q, $num) = @_;
print $q->header (-EXPIRES => '-20y', charset => 'UTF-8');
genHeaderStartHTML ($q, "panel_nav", $num);
}
=pod
=head2 genNoframesHeader($q)
=cut
sub genNoframesHeader
{
my ($q) = @_;
print $q->header (-EXPIRES => '-20y', charset => 'UTF-8');
genHeaderStartHTML ($q, "panel_main");
}
=pod
=head2 genHeaderStartHTML($q)
=cut
sub genHeaderStartHTML
{
my ($q, $page_type, $num) = @_;
my ($cssFile);
my ($bodyStyle);
my ($script) = "//This swaps the class of the selected item.\n"
."function swapClass(){\n"
."var i,x,tB,j=0,tA=new Array(),arg=swapClass.arguments;\n"
."if(document.getElementsByTagName){for(i=4;i<arg.length;i++){tB=document.getElementsByTagName(arg[i]);\n"
."for(x=0;x<tB.length;x++){tA[j]=tB[x];j++;}}for(i=0;i<tA.length;i++){\n"
."if(tA[i].className){if(tA[i].id==arg[1]){if(arg[0]==1){\n"
."tA[i].className=(tA[i].className==arg[3])?arg[2]:arg[3];}else{tA[i].className=arg[2];}\n"
."}else if(arg[0]==1 && arg[1]=='none'){if(tA[i].className==arg[2] || tA[i].className==arg[3]){\n"
."tA[i].className=(tA[i].className==arg[3])?arg[2]:arg[3];}\n"
."}else if(tA[i].className==arg[2]){tA[i].className=arg[3];}}}}}\n";
if ($page_type eq "panel_nav") {
$cssFile = "sme_menu.css";
$bodyStyle = "menu"
}
elsif ($page_type eq "panel_main") {
$cssFile = "sme_main.css";
$bodyStyle = "main"
}
# the -CLASS thing gets sent as a body class, not in the header
print $q->start_html (-TITLE => 'SME Server server manager',
-META => {'copyright' => 'Copyright 1999-2006 Mitel Networks Corporation, Copyright (C) ____COPYYEARS____ Koozali Foundation, Inc.'},
-SCRIPT => "$script",
-CLASS => "$bodyStyle",
-STYLE => {
-code => '@import url("/server-common/css/'.$cssFile.'");',
-src => '/server-common/css/sme_core.css'
});
}
=pod
=head1 WEB PAGE FOOTER GENERATION ROUTINES
=head2 genFooter($q)
=cut
sub genFooter
{
my ($q) = @_;
if ($q->isa('CGI::FormMagick'))
{
print $q->parse_template("/etc/e-smith/web/common/foot.tmpl");
return;
}
my $release = esmith::util::determineRelease();
print $q->p
($q->hr ({-CLASS => "sme-copyrightbar"}),
$q->div ({-CLASS => "sme-copyright"},
"SME Server server ${release}<BR>" .
"Copyright 1999-2006 Mitel Networks Corporation, Copyright (C) ____COPYYEARS____ Koozali Foundation, Inc..<BR>" .
"All rights reserved.")
);
print '</DIV>';
print $q->end_html;
}
=pod
=head2 genFooterNoCopyright($q)
=cut
sub genFooterNoCopyright
{
my ($q) = @_;
print $q->p ($q->hr);
print $q->end_html;
}
=pod
=head2 genNavigationFooter($q)
=cut
sub genNavigationFooter
{
my ($q) = @_;
print $q->end_html;
}
=pod
=head2 genNoframesFooter($q)
=cut
sub genNoframesFooter
{
my ($q) = @_;
print $q->end_html;
}
=pod
=head1 FONT ROUTINES
=head2 curFont()
Returns the preferred font faces eg. "Verdana, Arial, Helvetica, sans-serif".
This should be done by CSS now, so if you're calling this, you shouldn't be.
=cut
sub curFont
{
return "Verdana, Arial, Helvetica, sans-serif";
}
=pod
=head1 TABLE GENERATION ROUTINES
=head2 genCell($q, $text)
=cut
sub genCell
{
my ($q, $text, $class) = @_;
if ($text =~ /^\s*$/){$text = "&nbsp;"}
if ($class) { return $q->td({-class => "$class"}, $text),"\n";}
else { return $q->td ($text),"\n";}
}
=pod
=head2 genDoubleCell($q, $text);
Generates a cell which spans two columns, containing the text specified.
=cut
sub genDoubleCell
{
my ($q, $text) = @_;
if ($text =~ /^\s*$/){ $text = "&nbsp;" }
return $q->td ({colspan => 2}, $text),"\n";
}
=pod
=head2 genSmallCell($q, $text, $type, $colspan)
Generates a cell with "small" text (font size is 80%).
"$type" can be one of:
"normal" : creates <td class="sme-border"> cell
"header" : creates <th class="sme-border"> cell
=cut
sub genSmallCell
{
my ($q, $text, $type, $colspan) = @_;
$text = '' unless defined $text;
$type ||= 'normal';
$colspan ||= 1;
if ($text =~ /^\s*$/){ $text = "&nbsp;" }
if ("$type" eq "header") {
return $q->th ({class=>"sme-border", colspan=>$colspan}, $text)."\n";
} else {
return $q->td ({class=>"sme-border", colspan=>$colspan}, $text)."\n";
}
}
=pod
=head2 genSmallCellCentered($q, $text)
Generates a cell with "small" text (font size is 80%), centered.
creates <td class="sme-border-center"> cell
=cut
sub genSmallCellCentered
{
my ($q, $text) = @_;
if ($text =~ /^\s*$/){ $text = "&nbsp;" }
return $q->td ({class => "sme-border-center"}, $text)."\n";
}
=pod
=head2 genSmallCellRightJustified($q, $text)
=head2 genSmallCellCentered($q, $text)
Generates a cell with "small" text (font size is 80%), right justified.
creates <td class="sme-border-right"> cell
=cut
sub genSmallCellRightJustified
{
my ($q, $text) = @_;
if ($text =~ /^\s*$/){ $text = "&nbsp;" }
return $q->td ({class => "sme-border-right"}, $text)."\n";
}
=pod
=head2 genSmallRedCell($q, $text)
Generates a cell with "small" text (font size is 80%), left justified.
creates <td class="sme-border-warning"> cell
=cut
sub genSmallRedCell
{
my ($q, $text) = @_;
if ($text =~ /^\s*$/){ $text = "&nbsp;" }
return $q->td ({class => "sme-border-warning"}, $text)."\n";
}
=pod
=head2 genTextRow($q, $text)
Returns a table row containing a two-column cell containing $text.
=cut
sub genTextRow
{
my ($q, $text) = @_;
if ($text =~ /^\s*$/){ $text = "&nbsp;" }
return "\n",$q->Tr ($q->td ({colspan => 2}, $text)),"\n";
}
=pod
=head2 genButtonRow($q, $button)
Returns a table row containing an empty first cell and a second cell
containing a button with the value $button.
=cut
sub genButtonRow
{
my ($q, $button) = @_;
# return $q->Tr ($q->td ({-class => "sme-submitbutton", -colspan => "2"},$q->b ($button))),"\n";
# return $q->Tr ($q->td ('&nbsp;'),
# $q->td ({-class => "sme-submitbutton"},$q->b ($button))),"\n";
return $q->Tr ({-class => "sme-layout"}, $q->th ({-class => "sme-layout", colspan => "2"},$q->b ($button))),"\n";
}
=pod
=head2 genNameValueRow($q, $fieldlabel, $fieldname, $fieldvalue)
Returns a table row with two cells. The first has the text
"$fieldlabel:" in it, and the second has a text field with the default
value $fieldvalue and the name $fieldname.
=cut
sub genNameValueRow
{
my ($q, $fieldlabel, $fieldname, $fieldvalue) = @_;
return $q->Tr (
$q->td ({-class => "sme-noborders-label"},
"$fieldlabel:"),"\n",
$q->td ({-class => "sme-noborders-content"},
$q->textfield (
-name => $fieldname,
-override => 1,
-default => $fieldvalue,
-size => 32))),"\n";
}
=pod
sub genWidgetRow($q, $fieldlabel, $popup)
=cut
# used only by backup panel as far as I can see
sub genWidgetRow
{
my ($q, $fieldlabel, $popup) = @_;
return $q->Tr ($q->td ("$fieldlabel:"),
$q->td ($popup));
}
=pod
=head1 STATUS AND ERROR REPORT GENERATION ROUTINES
=head2 genResult($q, $msg)
Generates a "status report" page, including the footer
=cut
sub genResult
{
my ($q, $msg) = @_;
print $q->p ($msg);
genFooter ($q);
}
=pod
=head2 genStateError($q, $confref)
Subroutine to generate "unknown state" error message.
=cut
sub genStateError
{
my ($q, $confref) = @_;
genHeaderNonCacheable ($q, $confref, "Internal error");
genResult ($q, "Internal error! Unknown state: " . $q->param ("state") . ".");
}
END
{
}
#------------------------------------------------------------
# return "1" to make the import process return success
#------------------------------------------------------------
1;
=pod
=head1 AUTHOR
Mitel Networks Corporation
For more information, see http://e-smith.org/
=cut

View File

@ -0,0 +1,640 @@
#----------------------------------------------------------------------
# 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::config;
use strict;
use vars qw($VERSION);
$VERSION = 1.45;
use Sys::Syslog qw(:DEFAULT setlogsock);
use Fcntl qw(:DEFAULT :flock);
use Carp qw(cluck);
my $Default_Config = '/home/e-smith/db/configuration';
=pod
=head1 NAME
esmith::config - Access e-smith config files via hashes
=head1 SYNOPSIS
use esmith::config;
my %config;
my $config_obj = tie %config, 'esmith::config', $config_file;
# Read in the value of Wibble from the $config_file.
print $config{Wibble};
# Write out the value of Wibble to the $config_file.
$config{Wibble} = 42;
my $filename = $config_obj->filename;
=head1 DESCRIPTION
The esmith::config package enables Perl programs to read and write
entries from the e-smith configuration file using a simple hash
interface.
The configuration file has a simple ASCII representation,
with one "key=value" entry per line.
=begin testing
use_ok('esmith::config');
chdir '10e-smith-lib';
%Expect = ( foo => 'bar',
'this key' => 'has whitespace',
'that key ' => 'has trailing whitespace',
' another key' => 'has leading whitespace',
'this value' => ' has leading whitespace',
'that value' => 'has trailing whitespace ',
'tricky value' => 'with=equals.',
);
=end testing
=head2 Tying
tie %config, 'esmith::config', $config_file;
Reads in the configuration from the given $config_file, returning a
tied hash (%config) populated with the keys & values from the
$config_file which you can then use like a normal hash. Any writes or
deletes are immediately written back to the $config_file.
If no $config_file is supplied it falls back to the environment variable
ESMITH_CONFIG_DB, and finally defaults to F</home/e-smith/db/configuration>
If the $config_file doesn't exist it will create one for you.
=begin testing
my %config;
tie %config, 'esmith::config', 'dummy.conf';
ok( tied %config, 'tie worked' );
is( $config{foo}, 'bar', ' theres stuff in it' );
ok( !exists $config{FILENAME}, ' it only contains config info');
is( tied(%config)->{FILENAME}, 'dummy.conf',
' and the real object is inside');
tie %config, 'esmith::config', 'I_dont_exist';
ok( tied %config, 'tying a non-existant file' );
is( keys %config, 0, ' and its empty' );
$config{foo} = 42;
isnt( -s 'I_dont_exist', 0 );
untie %config;
ok( unlink 'I_dont_exist' );
$ENV{ESMITH_CONFIG_DB} = "dummy.conf";
tie %config, 'esmith::config';
ok( tied %config, 'tie to ESMITH_CONFIG_DB worked' );
is_deeply(\%config, \%Expect, " picked up data");
=end testing
=head2 Methods
You can get at the underlying esmith::config object by using tied().
my $config_obj = tied %config;
it has a few useful methods.
=over 4
=item filename
my $file = $config_obj->filename;
Gets the config filename this object is tied to.
=begin testing
my %config;
my $obj = tie %config, 'esmith::config', 'dummy.conf';
is( $obj->filename, 'dummy.conf', 'filename()' );
=end testing
=cut
sub filename {
my($self) = shift;
return $self->{FILENAME};
}
=back
=begin _private
=head2 Private methods
=over 4
=item _readconf
my $config = _readconf($config_file);
Returns a hash ref of config key/value pairs read out of the given
$config_file. If $config_file doesn't exist an empty hash ref will be
returned.
_readconf() understands the config file to be formatted as individual
lines of simply:
key=value
any further complexity of parsing the value is handled elsewhere.
=end _private
=begin testing
my $config = esmith::config::_readconf('dummy.conf');
isnt( keys %$config, 0, '_readconf() got something' );
is_deeply( $config, \%Expect, ' read in the right values' );
$config = esmith::config::_readconf('I_dont_exist');
isa_ok( $config, 'HASH', '_readconf from a non-existent file' );
is( keys %$config, 0, ' and its empty' );
=end testing
=cut
sub _readconf
{
my ($self, $filename) = @_;
my %config = ();
unless (open (FH, $filename))
{
if (-f $filename)
{
&log("Config: ERROR: \"$filename\" exists but is not readable");
}
return \%config;
}
my $binmode = $self->_read_binmode;
binmode(FH, $binmode) if $binmode;
while (my $line = <FH>)
{
chomp $line;
# BLIND UNTAINT! Much code wrongly depends on this and
# they should be moved away from it.
$line =~ /(.*)/;
$line = $1;
# ignore comments and blank lines
next if $line =~ /^\s*$/ || $line =~ /^\s*#/;
my($key, $value) = split /=/, $line, 2;
$config{$key} = $value;
}
close(FH);
return \%config;
}
=begin _private
=item _writeconf
my $success = _writeconf($config_file, \%config);
The given $config_file is overwritten using the entries in %config.
Returns whether or not the write succeded.
=end _private
=begin testing
my $scratch = 'scratch.conf';
ok( esmith::config::_writeconf($scratch, \%Expect),
'_writeconf() says it worked' );
is_deeply( esmith::config::_readconf($scratch), \%Expect,
' wrote the right things' );
unlink $scratch;
=end testing
=cut
sub _writeconf
{
my ($self, $filename, $config) = @_;
eval {
if (-f $filename && ! -r $filename)
{
die "'$filename' exists but is not readable\n";
}
sysopen (FH, "$filename.$$", O_RDWR | O_CREAT, 0660)
or die "Cannot open $filename.$$: $!\n";
my $binmode = $self->_write_binmode;
binmode(FH, $binmode) if $binmode;
die "Error writing to $filename.$$: $!" unless
printf FH <<EOF, scalar localtime;
# DO NOT MODIFY THIS FILE.
# This file is automatically maintained by the Mitel Networks SME Server
# configuration software. Manually editing this file may put your
# system in an unknown state.
#
# updated: %s
EOF
foreach my $key (sort keys %$config)
{
print FH "$key=$config->{$key}\n"
or die "Error writing to $filename.$$: $!";
}
close (FH) or die "Error closing $filename.$$: $!";
rename("$filename.$$", $filename)
or die "Couldn't rename $filename.$$ to $filename: $!";
my $gid = getgrnam ('admin') || 0;
chown (0, $gid, $filename);
};
if($@) {
chomp $@;
&log($@);
&log("'$filename' will not be updated");
return;
}
else {
return 1;
}
}
=begin _private
=item B<_lock_write>
=item B<_lock_read>
$self->_lock_write;
$self->_lock_read;
Sets up read (shared) or write (exclusive) locks on the config file.
This is actually locking a semaphore file.
Returns if the lock succeeded or failed.
=item B<_unlock>
$self->_unlock
Unlocks the config file.
=end _private
=cut
sub _lock_write { $_[0]->_lock(LOCK_EX) }
sub _lock_read { $_[0]->_lock(LOCK_SH) }
sub _lock {
return if $] eq 5.006; # Locking is broken in perl 5.6.0
my($self, $lock) = @_;
my $semaphore = $self->{SEMAPHORE_FILE} = $self->{FILENAME}.'.lock';
eval {
open(my $fh, ">>$semaphore") or
die "Can't open '$semaphore' semaphore: $!";
$self->{SEMAPHORE} = $fh;
flock($fh, $lock) or
die "Can't lock '$semaphore' semaphore: $!";
};
if( $@ ) {
warn $@;
return;
}
else {
return 1;
}
}
sub _unlock {
return if $] eq 5.006; # Locking is broken in perl 5.6.0
my($self) = @_;
eval {
flock($self->{SEMAPHORE}, LOCK_UN) or
die "Can't unlock $self->{SEMAPHORE_FILE}: $!";
unlink $self->{SEMAPHORE_FILE};
delete $self->{SEMAPHORE_FILE};
delete $self->{SEMAPHORE};
};
if( $@ ) {
warn $@;
return;
}
else {
return 1;
}
}
=end _private
=back
=cut
#------------------------------------------------------------
# Constructor for the tied hash. If filename not specified,
# defaults to '/home/e-smith/db/configuration'.
#------------------------------------------------------------
sub TIEHASH
{
my $class = shift;
my $filename = shift || $ENV{ESMITH_CONFIG_DB} || $Default_Config;
if ($filename =~ m:^/home/e-smith/\w+$: )
{
cluck "*WARNING* esmith::config($filename) called with old " .
"database path. The following package needs to be updated: ";
$filename =~ s:e-smith:e-smith/db:;
}
my $self =
{
FILENAME => $filename,
CONFIG => {},
};
bless $self, $class;
$self->{CONFIG} = $self->_readconf($filename);
return $self;
}
#------------------------------------------------------------
# Look up a configuration parameter.
#------------------------------------------------------------
sub FETCH
{
my $self = shift;
my $key = shift;
# Trim leading and trailing whitespace from the key.
$key =~ s/^\s+|\s+$//g;
return $self->{CONFIG}{$key};
}
#------------------------------------------------------------
# Store a configuration parameter.
#------------------------------------------------------------
sub STORE
{
my $self = shift;
my $key = shift;
my $value = shift;
die "key not defined" unless defined $key;
die "value not defined for key $key" unless defined $value;
if( $value =~ /\n/ or $key =~ /\n/ ) {
&log("$self->{FILENAME}: esmith::config doesn't support newlines in ".
"keys or values. Truncating.");
$key =~ s/\n.*//s;
$value =~ s/\n.*//s;
}
# Trim leading and trailing whitespace from the key and value.
$key =~ s/^\s+|\s+$//g;
$value =~ s/^\s+|\s+$//g;
# Make sure that the value has a type. Given the format, it should be
# sufficient to ensure that it does not begin with a pipe char.
if ($value =~ /^\|/)
{
warn "ERROR: You should not set a config record without a type (key was $key).\n";
}
# read in config again, just in case it changed
$self->_lock_write;
$self->{CONFIG} = $self->_readconf($self->{FILENAME});
if (exists $self->{CONFIG}{$key} and
$self->{CONFIG}{$key} eq $value)
{
$self->_unlock;
return undef;
}
my $msg = "$self->{FILENAME}: OLD $key=";
if (exists $self->{CONFIG}{$key})
{
$msg .= "$self->{CONFIG}{$key}";
}
else
{
$msg .= "(undefined)";
}
&log($msg);
$self->{CONFIG} {$key} = $value;
&log("$self->{FILENAME}: NEW $key=$self->{CONFIG}{$key}");
$self->_writeconf ($self->{FILENAME}, $self->{CONFIG});
$self->_unlock;
return undef;
}
#------------------------------------------------------------
# Delete a configuration parameter.
#------------------------------------------------------------
sub DELETE
{
my $self = shift;
my $key = shift;
# Trim leading and trailing whitespace from the key.
$key =~ s/^\s+|\s+$//g;
# read in config again, just in case it changed
$self->_lock_write;
$self->{CONFIG} = $self->_readconf($self->{FILENAME});
my $previous = delete $self->{CONFIG} {$key};
$self->_writeconf ($self->{FILENAME}, $self->{CONFIG});
$self->_unlock;
&log("$self->{FILENAME}: DELETE $key=$previous");
return $previous;
}
=begin _private
=item CLEAR
tie method: Clear the configuration file
=end _private
=begin testing
my $scratch = 'scratch.conf';
tie %config, 'esmith::config', $scratch;
ok( tied %config, 'tying a non-existant file' );
is( keys %config, 0, ' and its empty' );
$config{fibble} = 'blah';
isnt( keys %config, 0, ' and its not empty now' );
%config = ();
is( keys %config, 0, ' and CLEAR made it empty again' );
unlink $scratch;
=end testing
=cut
sub CLEAR
{
my $self = shift;
$self->{CONFIG} = ();
$self->_writeconf ($self->{FILENAME}, $self->{CONFIG});
&log("$self->{FILENAME}: CLEAR");
return undef;
}
#------------------------------------------------------------
# Check whether a particular key exists in the configuration file.
#------------------------------------------------------------
sub EXISTS
{
my $self = shift;
my $key = shift;
# Trim leading and trailing whitespace from the key.
$key =~ s/^\s+|\s+$//g;
return exists $self->{CONFIG} {$key};
}
#------------------------------------------------------------
# FIRSTKEY is called whenever we start iterating over the
# configuration table. We cache the configuration table at
# this point to ensure reasonable results if the
# configuration file is changed by another program during
# the iteration.
#------------------------------------------------------------
sub FIRSTKEY
{
my $self = shift;
my $discard = keys %{$self->{CONFIG}}; # reset each() iterator
return each %{$self->{CONFIG}};
}
#------------------------------------------------------------
# NEXTKEY is called for all iterations after the first. We
# just keep returning results from the cached configuration
# table. A null array is returned at the end. If the caller
# starts a new iteration, the FIRSTKEY subroutine is called
# again, causing the cache to be reloaded.
#------------------------------------------------------------
sub NEXTKEY
{
my $self = shift;
return each %{$self->{CONFIG}};
}
#------------------------------------------------------------
# Log messages to syslog
#------------------------------------------------------------
sub log
{
# There is a bug in Perl 5.00504 and above. If you are using the unix
# domain socket, do NOT use ndelay as part of the second argument
# to openlog().
my $msg = shift;
$msg =~ s/[^[:ascii:]]/_/g;
my $program = $0;
setlogsock 'unix';
openlog($program, 'pid', 'local1');
syslog('info', "%s", $msg);
closelog();
}
=item _read_binmode
return undef, indicating that by default binmode() need not be called after
file open.
=end _private
=cut
sub _read_binmode
{
return undef;
}
sub _write_binmode
{
return undef;
}
=head1 BUGS and CAVEATS
You can't have newlines in keys or values.
While the config values happen to be untainted B<do not depend on this
behavior> as it will change in the future.
=head1 AUTHOR
SME Server Developers <bugs@e-smith.com>
For more information, see http://www.e-smith.org/
=head1 SEE ALSO
esmith::db
=cut
1;

View File

@ -0,0 +1,25 @@
#----------------------------------------------------------------------
# Copyright 1999-2008 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::config::utf8;
use warnings;
use strict;
use vars qw(@ISA);
@ISA = qw(esmith::config);
sub _read_binmode
{
return ":encoding(UTF-8)";
}
sub _write_binmode
{
return ":utf8";
}
1;

View File

@ -0,0 +1,603 @@
#----------------------------------------------------------------------
# Copyright 1999-2006 Mitel Corporation
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#----------------------------------------------------------------------
=head1 NAME
esmith::console - A class to provide a backend library to the server console.
=head1 SYNOPSIS
use esmith::console;
my $console = esmith::console->new();
($rc, $choice) = $console->message_page
(
title => gettext("Administrator password not set"),
text => gettext("Sorry, you must set the administrator password."),
);
=head1 DESCRIPTION
This class provides a backend library of methods for the frontend console on
the server. The intent is that all of the whiptail code is hidden in this
library, and the frontend can just concern itself with the logical progression
through any and all applicable screens.
=head1 Methods
=cut
package esmith::console;
use strict;
use vars qw($VERSION @ISA @EXPORT_OK);
use esmith::util;
use Locale::gettext;
use esmith::ConfigDB;
use esmith::I18N;
@ISA = qw(Exporter);
use constant SCREEN_ROWS => 22;
use constant SCREEN_COLUMNS => 76;
use constant CONSOLE_SCREENS => "/sbin/e-smith/console-screens";
BEGIN
{
# disable CTRL-C
$SIG{INT} = 'IGNORE';
# Set PATH explicitly and clear related environment variables so that calls
# to external programs do not cause results to be tainted. See
# "perlsec" manual page for details.
$ENV {'PATH'} = '/sbin:/bin:/usr/sbin:/usr/bin:/usr/local/sbin:/usr/local/bin';
$ENV {'SHELL'} = '/bin/bash';
delete $ENV {'ENV'};
delete $ENV {'BASH_ENV'};
}
=head2 new
This is the class constructor.
=cut
sub new
{
my $class = ref($_[0]) || $_[0];
my $self = {};
esmith::util::setRealToEffective ();
my $i18n = new esmith::I18N;
$i18n->setLocale("server-console");
#------------------------------------------------------------
# Set stdin, stdout and stderr to console
#------------------------------------------------------------
if (defined $ARGV [0])
{
$ARGV[0] =~ /(console|tty\d*)/ && -c "/dev/$1"
or die gettext("Bad ttyname:"), " ", $ARGV[0], "\n";
my $tty = $1;
open (STDIN, "</dev/$tty") or die gettext("Can't redirect stdin"), ": $!\n";
open (STDOUT, ">/dev/$tty") or die gettext("Can't redirect stdout"), ": $!\n";
my $pid = open(STDERR, "|-");
die gettext("Can't fork"), ": $!\n" unless defined $pid;
unless ($pid)
{
exec qw(/usr/bin/logger -p local1.info -t console);
}
}
$self = bless $self, $class;
return $self;
}
=head2 screen and dialog
These method are wrappers around whiptail and dialog, and permit the creation
of custom screens depending on the arguments passed. They are typically not
called directly, but are used by all of the other page methods that
follow. You should only call these method directly if none of the other
methods apply.
=cut
sub screen
{
_screen(shift, "/usr/bin/dialog", @_);
}
sub dialog
{
_screen(shift, "/usr/bin/dialog", @_);
}
sub whiptail
{
_screen(shift, "/usr/bin/whiptail", @_);
}
sub _screen
{
my $self = shift;
my $whiptail = shift;
my @whiptailArgs = @_;
# now would be a good time to flush output buffers, so the partial
# buffers don't get copied:
$| = 1;
print "";
pipe (READER, WRITER)
or die gettext("Couldn't create pipe") . ": $!\n";
my $pid = fork;
if (! defined $pid)
{
die gettext("Couldn't fork") . ": $!\n";
}
elsif ($pid == 0)
{
#----------------------------------------
# Child
#----------------------------------------
# Attach child's STDIN to the reading end of the pipe
close READER
or die gettext("Couldn't close reading end of pipe") , ": $!\n";
if ($whiptail =~ m{\bwhiptail$} ) {
# whiptail sends its output via STDERR. We temporarily
# shut off warnings so they don't interfere with that.
local $^W = 0;
open STDERR, ">& WRITER"
or die gettext("Couldn't connect STDERR to pipe"), ": $!\n";
close WRITER
or die gettext("Couldn't close writing end of pipe"), ": $!\n";
unshift @whiptailArgs, $whiptail,
'--backtitle', $self->backtitle;
} else {
use Fcntl qw/F_SETFD/;
# Clear close-on-exec on WRITER so that it stays open for dialog to use
fcntl(WRITER, F_SETFD, 0);
unshift @whiptailArgs, $whiptail,
'--backtitle', $self->backtitle, "--output-fd", fileno(WRITER);
}
exec @whiptailArgs;
die gettext("Couldn't exec:"), ": $!\n";
}
#----------------------------------------
# Parent
#----------------------------------------
close WRITER;
my $choice = <READER>;
close READER;
waitpid ($pid, 0);
my $rc = $?;
return ($rc, $choice);
}
=head2 backtitle
Console header line for each page
=cut
sub backtitle
{
my $self = shift;
my $db = esmith::ConfigDB->open_ro or die "Couldn't open ConfigDB\n";
sprintf("%-33s%45s",
($db->get_prop('sysconfig', 'ProductName') || "SME Server") . " " .
($db->get_prop('sysconfig', 'ReleaseVersion') || "UNKNOWN"),
"Copyright (C) 1999-2006 Mitel Corporation, Copyright (C) ____COPYYEARS____ Koozali Foundation, Inc."
);
}
=head2 message_page
This method should be used whenever a screen that displays a simple message
is required.
=cut
sub message_page
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $message_box = $params{text};
my $left = defined $params{left} ? $params{left} : gettext("Back");
my $right = defined $params{right} ? $params{right} : gettext("Next");
$self->screen ("--title", $title,
"--cancel-label", $left,
"--ok-label", $right,
"--clear",
"--msgbox", $message_box,
SCREEN_ROWS,
SCREEN_COLUMNS,
);
}
=head2 tryagain_page
This method displays a simple "try again" screen.
=cut
sub tryagain_page
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $choice = $params{choice};
my $try_again = "; " . gettext("please try again");
my $message_box = $title . ":'${choice}'" . $try_again;
$self->screen ("--title", $title,
"--cancel-label", gettext("Back"),
"--ok-label", gettext("Next"),
"--clear",
"--msgbox", $message_box,
SCREEN_ROWS,
SCREEN_COLUMNS,
);
}
=head2 password_page
This method displays a screen suitable for entering a password.
=cut
sub password_page
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $message_box = $params{text};
my $left = defined $params{left} ? $params{left} : gettext("Back");
my $right = defined $params{right} ? $params{right} : gettext("Next");
$self->dialog ("--title", $title,
"--insecure",
"--cancel-label", $left,
"--ok-label", $right,
"--clear",
"--passwordbox", "\n" . $message_box,
SCREEN_ROWS,
SCREEN_COLUMNS,
);
}
=head2 yesno_page
This method displays a simple yes/no screen, so the user can make a
simple binary selection.
=cut
sub yesno_page
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $text = $params{text};
my $left = defined $params{left} ? $params{left} : gettext("Yes");
my $right = defined $params{right} ? $params{right} : gettext("No");
my @args = (
"--title" => $title,
"--yes-label" => $left,
"--no-label" => $right,
);
push @args, "--defaultno" if defined $params{defaultno};
push @args, "--clear";
$self->screen (@args,
"--yesno", $text,
SCREEN_ROWS,
SCREEN_COLUMNS,
);
}
=head2 input_page
This method displays a simple input screen with an input box.
=cut
sub input_page
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $text = $params{text};
my $value = $params{value};
my $left = defined $params{left} ? $params{left} : gettext("Back");
my $right = defined $params{right} ? $params{right} : gettext("Next");
$self->screen("--title", $title,
"--cancel-label", $left,
"--ok-label", $right,
"--clear",
"--inputbox", $text,
SCREEN_ROWS,
SCREEN_COLUMNS,
$value
);
}
=head2 infobox
This method is similar to a messagebox, but exits immediately, without clearing the screen.
=cut
sub infobox
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $text = $params{text};
my $height = $params{height} || "8";
my $width = $params{width} || SCREEN_COLUMNS;
$self->screen("--title", $title,
"--infobox", $text,
$height,
$width,
);
}
=head2 textbox
A text box lets you display the contents of a text file in a dialog box.
It is like a simple text file viewer.
=cut
sub textbox
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $file = $params{file};
my $height = $params{height} || '20';
my $width = $params{width} || SCREEN_COLUMNS;
$self->screen("--title", $title,
"--textbox", $file,
$height,
$width,
);
}
=head2 menu_page
This method displays a screen with a menu.
=cut
sub menu_page
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $text = $params{text};
my @args = ("--clear", "--title", $title);
if ($params{default})
{
push @args, "--default-item", $params{default};
}
my $value = $params{value};
my $argsref = $params{argsref};
my $menu_rows = scalar @$argsref / 2;
$menu_rows = 10 if ($menu_rows > 10);
my $left = defined $params{left} ? $params{left} : gettext("Back");
my $right = defined $params{right} ? $params{right} : gettext("Next");
$self->dialog(@args,
"--cancel-label", $left,
"--ok-label", $right,
"--menu", $text,
SCREEN_ROWS,
SCREEN_COLUMNS,
$menu_rows,
@$argsref,
);
}
=head2 keep_option
??
=cut
sub keep_option
{
my $self = shift;
my ($value) = @_;
my $keep_phrase = gettext("Keep the current setting");
return ( gettext("keep"), "${keep_phrase}: $value" );
}
=head2 gauge
This method displays a progress bar. It takes a coderef as parameter, and uses
the coderef to drive the --gauge widget of the dialog program, as well as to
perform whatever actions are being reported by the progress bar. The coderef
should take one parameter, which is the file handle to write the controlling
text to. If the return value of the coderef is defined, it is displayed by a
message_page after the progress bar terminates.
All text used to update the progress bar should either be numbers between 0
and 100, or arbitrary text sandwiched between leading and training lines
of 'XXX' followed by newline. The numbers will update the percentage complete
of the display, and the text will update the displayed text. Updating the
displayed text will reset the precentage complete to 0, so text should always
be followed by number.
=cut
sub gauge
{
my $self = shift;
my $sub = shift;
my %params = @_;
my $title = $params{title} || 'Progress';
my $feedback_title = $params{feedback_title} || 'Status';
my $init_text = $params{text} || 'Progress';
my @args = (
'--backtitle', $self->backtitle,
'--title', gettext($title),
);
push @args, "--clear" if $params{clear};
push @args, "--colors" if $params{colors};
push @args, "--no-collapse" if $params{no_collapse};
use FileHandle;
unless (open(WR, '|-'))
{
exec('/usr/bin/dialog',
@args,
'--gauge',
gettext($init_text),
SCREEN_ROWS,
SCREEN_COLUMNS,
);
}
WR->autoflush(1);
my $text = &$sub(*WR);
close(WR);
$self->message_page('title' => $feedback_title, 'text' => $text)
if defined $text;
}
=head2 run_screens
This method takes a directory of screens to run, and runs them in order.
To support navigation between screens, this method respects an integer
return value from the screens.
0 = all is well, continue to the next screen
1 = all is not well, go back to the previous screen
2 = catastrophic failure - return from run_screen
=cut
sub run_screens
{
my $self = shift;
my ($subdir) = @_;
my $dir = CONSOLE_SCREENS . "/$subdir";
# This is fine. Noop if the directory isn't there.
unless (-d $dir)
{
return 1;
}
# This is not fine. If it's there, we should be able to open it.
unless ( opendir(SCREENS, $dir) )
{
warn "Failed to open directory $dir: $!\n";
return 0;
}
my @screens = sort grep (!/^(\.\.?)$/, readdir (SCREENS));
my @previous_screens = ();
while (@screens)
{
my $screen = shift @screens;
unless ( $screen =~ /(S\d\d[\d\w]+)/ )
{
warn "Unknown screen type $dir/$screen\n";
next;
}
$screen = $1;
my $rv = system( "$dir/$screen" );
$rv >>= 8;
if ($rv == 0)
{
# Success, move to next screen.
push @previous_screens, $screen;
}
elsif ($rv == 1)
{
# Failure, go back one screen.
unshift @screens, $screen;
if (@previous_screens)
{
unshift @screens, pop @previous_screens;
}
else
{
# We're at the beginning of the stack. Just return.
return 0;
}
}
else
{
# Catastrophic failure, return. While 2 is the agreed-upon
# return code for this, consider it a catastrophic failure
# if we don't get a valid return code.
return 0;
}
}
return 1;
}
=head1 AUTHOR
SME Server Developers <smebugs@mitel.com>
=cut
1;

View File

@ -0,0 +1,743 @@
#----------------------------------------------------------------------
# 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::db;
use esmith::config;
use strict;
=head1 NAME
esmith::db - Routines for handling the e-smith configuration database
=head1 SYNOPSIS
B<THIS MODULE HAS BEEN DEPRECATED>
use esmith::db;
use esmith::config;
my %config;
tie %config, 'esmith::config', $config_file;
db_set(\%config, $key, $type, \%properties);
db_set_type(\%config, $key, $type);
db_set_prop(\%config, $key, $property => $new_value);
my($type, %properties) = db_get(\%config, $key);
my $type = db_get_type(\%config, $key);
my %properties = db_get_prop(\%config, $key);
my $value = db_get_prop(\%config, $key, $property);
db_delete(\%config, $key);
db_delete_prop(\%config, $key, $property);
db_print(\%config, $key);
db_show(\%config, $key);
db_print_type(\%config, $key);
db_print_prop(\%config, $key, $prop);
=head1 DESCRIPTION
B<THIS MODULE HAS BEEN DEPRECATED>. Please use a subclass of
esmith::DB::db instead, such as esmith::AccountsDB or esmith::ConfigDB.
I<Do not try to change this module>. Much code depends on subtle
nuances and bugs and you will break things if you try to fix it.
Instead, move any existing code away from esmith::db and towards
esmith::DB::db.
This module provides utility routines for manipulating e-smith
configuration data. OO and non-OO versions of the routines are provided.
For example, db_set() is the non-OO while set() can be called with an
object reference.
E-Smith DB entries have three parts. A key, a type and a hash of
properties.
key squid
type cephalopod
properties arms => 10
species => Loligo
=cut
use vars qw($VERSION @ISA @EXPORT);
$VERSION = sprintf "%d.%03d", q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
db_set
db_get
db_delete
db_set_type
db_get_type
db_get_prop
db_set_prop
db_delete_prop
db_print
db_show
db_print_type
db_print_prop
);
=head2 Functions
=over 4
=item B<db_set>
my $success = db_set(\%config, $key, $raw_value);
my $success = db_set(\%config, $key, $type);
my $success = db_set(\%config, $key, $type, \%properties);
Enters a new $key into the %config or replaces an existing $key. It
sets the $type and optionally %properties.
As a "bug which has become a feature" you can feed db_set() the
$raw_value for a $key (ie. 'type|prop1|val1|prop2|val2') and it will
setup the types and properties properly. I<Do not depend on this> but
don't change it either. There's code that depends on this behavior.
It returns true on success, false on failure.
If the $key contains a newline it will fail.
=cut
sub db_set
{
my ($hash, $key, $new_value, $hashref) = @_;
return undef if ($key =~ /\n/);
if (defined $hashref)
{
my $properties = _db_hash_to_string($hashref);
if (defined $properties && $properties ne '')
{
$new_value .= "|$properties";
}
}
$new_value and $new_value =~ s/\n/\\n/g;
$$hash{$key} = $new_value;
return undef unless defined db_get($hash, $key);
return 1;
}
=head2 B<db_get>
my($type, %properties) = db_get(\%config, $key);
my $raw_value = db_get(\%config, $key);
my @keys = db_get(\%config);
Reads the $type and %properties for the given $key in %config.
In scalar context it returns the raw value of $config{$key} B<NOT> the
type! But it unescapes newlines. I<Use db_get_type() instead>.
If a $key is not given it returns all the @keys in the %config.
=cut
sub db_get
{
my ($hash, $key) = @_;
return sort keys %$hash unless defined $key;
return undef unless exists $$hash{$key};
my $value = $$hash{$key};
$value and $value =~ s/\\n/\n/g;
return wantarray() ? _db_string_to_type_and_hash($value) : $value;
}
=item B<db_delete>
db_delete(\%config, $key)
Deletes the $key from %config.
=cut
sub db_delete
{
my ($hash, $key) = @_;
return undef unless defined db_get($hash, $key);
delete $$hash{$key};
return 1;
}
=item B<db_set_type>
my $success = db_set_type(\%config, $key, $type)
Sets the $type for $config{$key}.
Returns true if the set succeeded, false otherwise.
=cut
sub db_set_type
{
my ($hash, $key, $type) = @_;
return undef unless defined db_get($hash, $key);
my %properties = db_get_prop($hash, $key);
return db_set($hash, $key, $type, \%properties);
}
=item B<db_get_type>
my $type = db_get_type(\%config, $key);
Returns the $type associated with the $key in the %config database.
Will return undef if the $key doesn't exist.
=cut
sub db_get_type
{
my ($hash, $key) = @_;
return undef unless defined db_get($hash, $key);
my ($type) =
_db_string_to_type_and_hash(db_get($hash, $key));
return $type;
}
=item B<db_set_prop>
my $success = db_set_prop(\%config, $key, $property => $new_value)
Sets the given $property of the $key in the %config database to the
$new_value. If the $property didn't exist, it will be added.
Returns true/value if it succeeded/failed.
=cut
sub db_set_prop
{
my ($hash, $key, $prop, $new_value) = @_;
return undef unless defined db_get($hash, $key);
my $type = db_get_type($hash, $key);
my %properties = db_get_prop($hash, $key);
$properties{$prop} = $new_value;
return db_set($hash, $key, $type, \%properties);
}
=item B<db_get_prop>
my %properties = db_get_prop(\%config, $key);
my $value = db_get_prop(\%config, $key, $property);
Returns the %properties for a $key in the %config database. If you
ask for a specific $property you'll get the $value for that $property.
Returns undef if the $key or $property doesn't exist.
=cut
sub db_get_prop
{
my ($hash, $key, $prop) = @_;
my $val = db_get($hash, $key);
return (defined $prop ? undef : ()) unless defined $val;
my($type, %properties) = _db_string_to_type_and_hash($val);
return %properties unless defined $prop;
return undef unless exists $properties{$prop};
return $properties{$prop};
}
=item B<db_delete_prop>
db_delete_prop(\%config, $key, $property)
Deletes a $property from the $key in the %config.
Returns undef if the $key doesn't exist.
=cut
sub db_delete_prop
{
my ($hash, $key, $prop) = @_;
return undef unless defined db_get($hash, $key);
my $type = db_get_type($hash, $key);
my %properties = db_get_prop($hash, $key);
delete $properties{$prop};
return db_set($hash, $key, $type, \%properties);
}
=back
=head2 Debugging Functions
These functions are useful for debugging.
=over 4
=item B<db_print>
db_print(\%config);
db_print(\%config, $key);
Prints out keys and raw values in the %config database. If $key is
given it prints the $key and its raw value. If no $key is given it
prints out all the keys and their raw values.
=cut
sub db_print
{
my ($hash, $key) = @_;
my @list;
if (defined $key)
{
return undef unless defined db_get($hash, $key);
@list = ($key);
}
else
{
@list = db_get($hash);
}
return undef unless scalar @list;
foreach (@list)
{
print "$_=", scalar db_get($hash, $_),"\n";
}
return 1;
}
=item B<db_show>
db_show(\%config);
db_show(\%config, $key);
Prints out keys and their values in a human readable format.
If $key is given it prints out the $key, type and properties of that
$key. Otherwise it prints out the key, type and properties for all
keys.
=cut
sub db_show
{
my ($hash, $key) = @_;
my @list;
if (defined $key)
{
return undef unless defined db_get($hash, $key);
@list = ($key);
}
else
{
@list = db_get($hash) unless defined $key;
}
return undef unless scalar @list;
foreach (@list)
{
print "$_=";
my $type = db_get_type($hash, $_);
if (defined $type)
{
print "$type\n";
}
else
{
print "\n";
next;
}
my %properties = db_get_prop($hash, $_);
next unless scalar keys %properties;
foreach my $property (sort keys %properties)
{
print " $property=$properties{$property}\n";
}
}
return 1;
}
=item B<db_print_type>
db_print_type(\%config);
db_print_type(\%config, $key);
Prints out keys and their types in the %config database.
If $key is given, it prints out just that $key and its type.
Otherwise it prints out all the keys and their types.
=cut
sub db_print_type
{
my ($hash, $key) = @_;
my @list;
if (defined $key)
{
return undef unless defined db_get($hash, $key);
@list = $key;
}
else
{
@list = db_get($hash);
}
return undef unless scalar @list;
foreach (@list)
{
print "$_=";
my $type = db_get_type($hash, $_);
print db_get_type($hash, $_),"\n" if defined $type;
print "\n" unless defined $type;
}
return 1;
}
=item B<db_print_prop>
db_print_prop(\%config, $key);
db_print_prop(\%config, $key, $property);
Prints out the properties (or a single $property) of the given $key in
the %config.
=cut
sub db_print_prop
{
my ($hash, $key, $prop) = @_;
my @list;
my %list;
return undef unless defined db_get($hash, $key);
if (defined $prop)
{
my $value = db_get_prop($hash, $key, $prop);
return undef unless defined $value;
%list = ($prop => $value);
}
else
{
%list = db_get_prop($hash, $key);
}
return undef unless scalar keys %list;
foreach (sort keys %list)
{
print "$_=$list{$_}\n";
}
return 1;
}
=head2 OO Interface
To add to the confusion, esmith::db has a vestigal object-oriented
interface. Use esmith::DB::db instead.
=over 4
=item B<new>
my $db = esmith::db->new($db_file)
Generates a new esmith::db object from the given $db_file
=cut
sub new
{
my($class,$dbname) = @_;
return $class->open($dbname);
}
=item B<open>
my $db = esmith::db->open($db_name);
my $db = esmith::db->open($db_file);
Takes a database name (or pathname) and opens the named database.
The database name form is preferred over the explicit pathname.
For example
$db->open( 'configuration' );
or
$db->open( '/path/to/configuration' );
=cut
sub open
{
my $self = shift;
my $dbName = shift;
my $class = ref($self) || $self;
my $dataFile = _db_path($dbName);
unless ( $esmith::db::REFCOUNT{$dataFile} )
{
warn "Reading $dataFile into cache\n" if ($esmith::db::DEBUG);
my %db;
tie %db, 'esmith::config', $dataFile;
$esmith::db::CACHE{$dataFile} = \%db;
}
$self = bless {
DBNAME => $dataFile,
CACHE => $esmith::db::CACHE{$dataFile}
}, $class;
$esmith::db::REFCOUNT{$dataFile}++;
return $self;
}
sub DESTROY
{
my $self = shift;
return $self->close();
}
=item B<close>
$db->close;
Closes this database.
=cut
sub close
{
my $self = shift;
my $dataFile = $self->{'DBNAME'};
$esmith::db::REFCOUNT{$dataFile}--;
if ( $esmith::db::REFCOUNT{$dataFile} == 0 )
{
delete $esmith::db::CACHE{$dataFile};
warn "esmith::db::close Closing $dataFile\n" if ($esmith::db::DEBUG);
}
elsif ( $esmith::db::REFCOUNT{$dataFile} > 0 )
{
warn "esmith::db::close Not closing $dataFile, references ",
$esmith::db::REFCOUNT{$dataFile}, "\n" if ($esmith::db::DEBUG);
}
else
{
$esmith::db::REFCOUNT{$dataFile} = 0;
warn "esmith::db::close Not closing $dataFile, zero references\n"
if ($esmith::db::DEBUG);
}
}
=item B<set>
=item B<set_type>
=item B<set_prop>
=item B<get>
=item B<get_type>
=item B<get_prop>
=item B<delete>
=item B<delete_prop>
These all work like their functional versions (ie. set() == db_set())
except it is not necessary to input the %config database.
=cut
sub AUTOLOAD
{
no strict 'refs';
# fully qualified sub-name stored in $AUTOLOAD package variable
$esmith::db::AUTOLOAD =~ /^(.*::)(.*)$/;
my ($pkg, $sub) = ($1, $2);
# use *foo{THING} syntax to check if sub is defined (see perlref)
if (defined *{"${pkg}db_${sub}"}{CODE})
{
my $self = shift;
my $cache = $esmith::db::CACHE{$self->{DBNAME}};
wantarray ? return (my @p = &{"${pkg}db_${sub}"}($cache, @_))
: return (my $p = &{"${pkg}db_${sub}"}($cache, @_));
}
}
=begin private
=head2 Private functions
=over4
=item B<_db_hash_to_string>
my $raw_value = _db_hash_to_string($hashref);
Takes a reference to a hash and returns a string of pipe "|" delimited
pairs suitable for being stored.
=cut
sub _db_hash_to_string
{
my ($hash) = @_;
my $string = '';
foreach (sort keys %$hash)
{
$string .= '|' if length($string);
$string .= "$_|";
$string .= $$hash{$_} if defined $$hash{$_};
}
return $string;
}
=pod
=item B<_db_string_to_type_and_hash>
my($type, %properties) = _db_string_to_type_and_hash($raw_value);
Takes the $raw_value, which is a | delimited string, and spits it up
into the $type (the first field) and its %properties (the rest).
Escaped pipes (\|) are properly ignored as a delimiter.
=cut
sub _db_string_to_type_and_hash ($)
{
my ($arg) = @_;
return ('', ()) unless defined $arg;
# The funky regex is to avoid escaped pipes.
# If you specify a negative limit empty trailing fields are omitted.
return split(/(?<!\\)\|/, $arg, -1);
}
=item B<_db_path>
my $dfile = _db_path($database_name);
Takes a $database_name and returns the $file where it lives.
=cut
sub _db_path($)
{
my ($file) = @_;
if ($file =~ m:^/:)
{
return $file;
}
return "/home/e-smith/db/$file" if (-e "/home/e-smith/db/$file");
if (-e "/home/e-smith/$file")
{
warn "Database found in old location /home/e-smith/$file";
return "/home/e-smith/$file";
}
else
{
return "/home/e-smith/db/$file";
}
}
=back
=end private
=head1 BUGS and CAVEATS
keys cannot contain newlines or pipes.
types and properties cannot contain pipes.
=head1 AUTHOR
Mitel Networks Corporation
For more information, see http://www.e-smith.org/
=cut
1;

View File

@ -0,0 +1,133 @@
#----------------------------------------------------------------------
# Copyright 1999-2005 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::ethernet;
#----------------------------------------------------------------------
use strict;
use File::Basename;
=head1 NAME
esmith::ethernet - Ethernet-related utility routines for e-smith
=head1 VERSION
This file documents C<esmith::ethernet> version B<1.4.0>
=head1 SYNOPSIS
use esmith::ethernet;
=head1 DESCRIPTION
This module contains routines for
=pod
=head2 probeAdapters()
Probe for any recognised adapters
=cut
sub probeAdapters ()
{
opendir(my $dh, "/sys/class/net") or die "Couldn't open /sys/class/net: $!";
my @nics = grep { $_ !~ m/^\./ } readdir($dh);
closedir($dh);
my $adapters = '';
my $index = 1;
foreach my $nic (@nics){
# Untaint $nic and makes sure the name looks OK
next unless ($nic =~ m/^(\w+[\.:]?\d+)$/);
$nic = $1;
next if (
# skip loopback
$nic eq 'lo' ||
# skip non links
!-l "/sys/class/net/$nic" ||
# skip wireless nics
-d "/sys/class/net/$nic/wireless" ||
-l "/sys/class/net/$nic/phy80211" ||
# skip bridges
-d "/sys/class/net/$nic/bridge" ||
# skip vlans
-f "/proc/net/vlan/$nic" ||
# skip bonds
-d "/sys/class/net/$nic/bonding" ||
# skip tun/tap
-f "/sys/class/net/$nic/tun_flags" ||
# skip dummy
-d "/sys/devices/virtual/net/$nic"
);
# Now we should be left only wth ethernet adapters
open HW, "/sys/class/net/$nic/address";
my $mac = join("", <HW>);
close HW;
# Check MAC Addr and untaint it
next unless ($mac =~ m/^(([\da-f]{2}:){5}[\da-f]{2})$/i);
$mac = $1;
# If the device is a slave of a bridge, it's real MAC
# address can be found in /proc/net/bonding/bondX
if (-l "/sys/class/net/$nic/master"){
my $bond = basename (readlink "/sys/class/net/$nic/master");
local $/ = '';
open SLAVES, "/proc/net/bonding/$bond";
my @slaves = <SLAVES>;
close SLAVES;
my @slaveInfo = grep { /^Slave\ Interface:\ $nic/m } @slaves;
foreach (split /\n+/, (join "", @slaveInfo)){
$mac = $1 if (/^Permanent\ HW\ addr:\ (.*)$/);
}
}
chomp($mac);
my $driver = basename (readlink "/sys/class/net/$nic/device/driver");
# Untaint driver name
next unless ($driver =~ m/^([\w\-]+)$/);
$driver = $1;
my $bus = basename (readlink "/sys/class/net/$nic/device/subsystem");
my $desc = $nic;
if ($bus eq 'pci'){
my $dev = basename (readlink "/sys/class/net/$nic/device");
# Untaint $dev
if ($dev =~ m/^(\d+:\d+:\d+\.\d+)$/){
$dev = $1;
$desc = `/sbin/lspci -s $dev`;
# Extract only description
$desc =~ m/^.*:.*:\s+(.*)\s*/;
$desc = $1;
}
}
elsif ($bus eq 'virtio'){
$desc = 'Virtio Network Device';
}
# TODO: we should also try to get the description of USB devices
$adapters .= "EthernetDriver" . $index++ . "\t" . $driver . "\t" .
$mac . "\t" . "\"$desc\"" . "\t" . $nic ."\n";
}
return $adapters;
}
#----------------------------------------------------------------------
# Return one to make the import process return success.
#----------------------------------------------------------------------
1;
=pod
=AUTHOR
SME Server Developers <bugs@e-smith.com>
For more information see http://www.e-smith.org/
=cut

View File

@ -0,0 +1,220 @@
#----------------------------------------------------------------------
# Copyright 1999-2005 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::event;
use strict;
use Exporter;
use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
use esmith::Logger;
use File::Basename;
use File::Temp qw/ :mktemp /;
use esmith::ConfigDB;
use POSIX;
=pod
=head1 NAME
esmith::event - Routines for handling e-smith events
=head1 SYNOPSIS
use esmith::event;
my $exitcode = event_signal($event, @args);
=head1 DESCRIPTION
=cut
our $VERSION = sprintf '%d.%03d', q$Revision: 1.16 $ =~ /: (\d+).(\d+)/;
our @ISA = qw(Exporter);
our @EXPORT = qw(event_signal);
our @EXPORT_OK = ();
our %EXPORT_TAGS = ();
our $return_value = undef;
tie *LOG, 'esmith::Logger', 'esmith::event';
sub event_signal
{
my ($event, @args) = @_;
if ($event eq "actions")
{
warn("'actions' is not a valid event name.\n");
return;
}
my $events = "/etc/e-smith/events";
my $handlerDir = "$events/$event";
#------------------------------------------------------------
# get event handler filenames
#------------------------------------------------------------
opendir (DIR, $handlerDir)
|| die "Can't open directory $handlerDir\n";
# Create a hash of handlers (ignore directories),
# with value of basename(handler)
my %handlers = ();
foreach (grep {! -d "$handlerDir/$_"} readdir (DIR))
{
$handlers{"$handlerDir/$_"} = $_;
}
closedir (DIR);
# Add generic handlers to list, if their metadata directories
# exist
$handlers{"$events/actions/generic_template_expand"} = "S05generic_template_expand"
if ( -d "$handlerDir/templates2expand");
$handlers{"$events/actions/adjust-services"} = "S90adjust-services"
if ( -d "$handlerDir/services2adjust");
#------------------------------------------------------------
# Execute all handlers, sending any output to the system log.
#
# Event handlers are not supposed to generate error messages
# under normal conditions, so we do not provide a mechanism
# for event handlers to signal errors to the user. Errors can
# only be written to the log file.
#------------------------------------------------------------
print LOG "Processing event: $event @args";
#------------------------------------------------------------
# Run handlers, logging all output.
#------------------------------------------------------------
# assume success
my $exitcode = 1;
foreach my $filename
(sort { $handlers{$a} cmp $handlers{$b} } keys %handlers)
{
my $handler = basename $filename;
my $startTime = [gettimeofday];
my $status = -1;
if (-x $filename)
{
print LOG "Running event handler: $filename";
unless (($status = _mysystem(\*LOG, $filename, $event, @args)) == 0)
{
# if any handler fails, the entire event fails
$exitcode = 0;
}
}
else
{
print LOG "Skipping non-executable event handler: $filename";
next;
}
my $endTime = [gettimeofday];
my $elapsedTime = tv_interval($startTime, $endTime);
my $log = "$handler=action|Event|$event|Action|$handler";
$log .= "|Start|@$startTime|End|@$endTime|Elapsed|$elapsedTime";
$log .= "|Status|$status" if $status;
print LOG $log;
}
# Implement event queuing for clustered systems.
my $qfifo = "/var/spool/eventq";
return $exitcode unless (-e $qfifo);
# Ensure we aren't called by a cascaded event. We only need to
# queue the top-level of such a beast.
my $ppid = getppid();
open F, "/proc/$ppid/cmdline";
my $cmd = <F>;
close F;
unless($cmd =~ "/etc/e-smith/event")
{
my $fd = POSIX::open($qfifo, &POSIX::O_WRONLY) or return $exitcode;
my $argstr = join(" ",$event,@args);
$argstr .= "\n";
POSIX::write($fd, $argstr, length($argstr));
POSIX::close($fd);
}
return $exitcode;
}
sub _mysystem
{
my ($logger, $filename, $event, @args) = @_;
my $pid = open(PIPE, "-|");
die "Failed to fork: $!\n" unless defined $pid;
if ($pid)
{
# Parent
while (my $line = <PIPE>)
{
print $logger $line;
}
}
else
{
# Child
open(STDERR, ">&STDOUT");
exec($filename, $event, @args);
}
close(PIPE);
return $?;
}
#------------------------------------------------------------
# Attempt to eval perl handlers for efficiency - not currently used
# return 1 on success; 0 on error
#------------------------------------------------------------
sub _runHandler($)
{
my ($filename) = @_;
open(FILE, $filename) || die "Couldn't open $filename: $!";
my @lines = <FILE>;
close FILE;
my $string = "";
unless ( $lines[0] =~ /^#!.*perl/ )
{
# STDOUT and STDERR are both redirected going to LOG
return (system($filename, @ARGV) == 0) ? 1 : 0;
}
map { $string .= $_ } @lines;
print "Eval of $filename...";
# Override 'exit' in symbol table for handlers
sub exit { die "$_[0]\n" };
*CORE::GLOBAL::exit = \&esmith::event::exit;
my $status = eval $string;
chomp $@;
# if $@ is defined, then die or exit was called - use that status
$status = $@ if defined $@;
# for all exit values except 0, assume failure
if ($@)
{
print "Eval of $filename failed: $status\n";
return 0;
}
print "$status\n";
return 1;
}
1;

View File

@ -0,0 +1,61 @@
#----------------------------------------------------------------------
# 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::lockfile;
use strict;
use vars qw($VERSION @ISA @EXPORT_OK);
use Exporter;
use Fcntl ":flock";
use FileHandle;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
LockFileOrReturn LockFileOrWait UnlockFile
);
sub LockFileOrReturn ($)
{
# Attempt to lock a file. If the lock fails, return immediately.
my $lock_file = shift;
my $FH = new FileHandle;
$FH->open(">> $lock_file")
or die "Cannot open lock file $lock_file for writing: $!.\n";
flock($FH, LOCK_EX | LOCK_NB) or return 0;
return $FH;
}
sub LockFileOrWait ($)
{
# Attempt to lock a file. Wait until the file is available.
my $lock_file = shift;
my $FH = new FileHandle;
$FH->open(">> $lock_file")
or die "Cannot open lock file $lock_file for writing: $!.\n";
flock($FH, LOCK_EX) or return 0;
return $FH;
}
sub UnlockFile ($)
{
my $FH = shift;
flock($FH, LOCK_UN);
$FH->close;
}
1;

View File

@ -0,0 +1,76 @@
#----------------------------------------------------------------------
# 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::event;
use strict;
=pod
=head1 NAME
esmith::logrotate - Routines for handling rotation of log files
=head1 SYNOPSIS
use esmith::logrotate;
NewLogFileSymlink($file);
MakeFilenameFromSymlink($file);
=head1 DESCRIPTION
=cut
BEGIN
{
}
sub NewLogFileSymlink
{
my $file = shift;
unless (defined $file)
{
warn("newlogfilesymlink called with no argument");
return;
}
my $time = time();
if (-f "/var/log/${file}")
{
my ($sec,$min,$hour,$mday,$mon,$year) = localtime($time - 1);
my $target = sprintf("%s%04d%02d%02d%02d%02d%02d",
$file, $year+1900, $mon, $mday, $hour, $min, $sec);
move("/var/log/${file}", "/var/log/${target}") or
die "Could not move /var/log/${file} to /var/log/${target}";
}
my ($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
my $target = sprintf("%s%04d%02d%02d%02d%02d%02d",
$file, $year+1900, $mon, $mday, $hour, $min, $sec);
unlink("/var/log/${file}") or
warn "Could not unlink /var/log/${file}";
symlink("/var/log/${target}", "/var/log/${file}") or
warn "Could not symlink /var/log/${target} to /var/log/${file}";
}
sub MakeFilenameFromSymlink
{
use File::Basename;
my $filename = shift;
return $filename unless (-l $filename);
my $link = readlink $filename;
my $directory = dirname($filename);
return "${directory}/${link}";
}
END
{
}
1;

View File

@ -0,0 +1,140 @@
#----------------------------------------------------------------------
# Copyright 2005-2006 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::tcpsvd;
use strict;
=pod
=head1 NAME
esmith::tcpsvd - Manage tcpsvd "peers" directory
=head1 SYNOPSIS
use esmith::tcpsvd;
esmith::tcpsvd::configure_peers($service)
=head1 DESCRIPTION
This module provides utility functions for use with tcpsvd from Gerrit
Pape's ipsvd package - see http://smarden.org/ipsvd/.
=cut
use esmith::NetworksDB;
use esmith::ConfigDB;
use esmith::util;
use esmith::lockfile;
use Carp;
=head2 configure_peers($service [, $peers_directory] )
configure_peers() configures the "peers" direectory used by tcpsvd for
access control and environment maipulation. $service identifies the name
of the service managed by supervise or runit. The peers directory (as
specified by the optional $peers_directory argument, defaulting to
"/var/service/$service/peers") is expected to contain files "0" defining
access conditions for public (default) accesss, and "local", defining
access conditions for local access. configure_peers() creates a set of
symlinks so that tcpsvd uses "local" for all local network access to
the service.
See http://smarden.org/ipsvd/ipsvd-instruct.5.html for all details of
the contents of the peers directory.
=cut
sub configure_peers
{
my $service = shift;
my $peers = shift || "/var/service/$service/peers";
unless (opendir(PEERS, $peers))
{
carp "Cannot read peers directory: $!";
return;
}
my $config = esmith::ConfigDB->open;
unless ($config)
{
carp "Could not open config db.";
return;
}
$service = $config->get($service);
unless ($service)
{
carp "No service record for $service";
return;
}
my $access = $service->prop('access') || "localhost";
my $nets = esmith::NetworksDB->open;
unless ($nets)
{
carp "Could not open networks db.";
return;
}
my $gw = $config->get('GatewayIP');
# Make a list of local networks, in prefix format
my %nets = ($access eq "localhost") ? () :
map
{
$_ => 1,
}
map
{
esmith::util::computeAllLocalNetworkPrefixes($_->key, $_->prop('Mask'));
}
($nets->get_all_by_prop('type', 'network'));
$nets{'127.0.0.1'} = 1;
# Setup lock on peers directory while we manipulate it
my $lock = esmith::lockfile::LockFileOrWait("$peers/local");
# Now manage a set of symlinks to the "local" instructions file
foreach my $insfile (readdir (PEERS))
{
next unless -l "$peers/$insfile";
if (exists $nets{$insfile})
{
# Cross this one off the list so that we don't bother creating it
delete $nets{$insfile};
}
else
{
# We no longer need this entry
unlink "$peers/$insfile" or
warn "Could not delete access control file $peers/$insfile: $!\n";
}
}
closedir(PEERS);
foreach my $insfile (keys %nets)
{
symlink "local", "$peers/$insfile" or
warn "Cannot add instructions file for $peers/$insfile: $!\n";
}
if (defined $gw)
{
# We have a defined gateway address - make sure that the router doesn't have
# relay privileges
my $gw_ip = $gw->value;
unlink "$peers/$gw_ip";
symlink "0", "$peers/$gw_ip" or
warn "Cannot add instructions file for $peers/$gw_ip: $!\n";
}
# Unlock peers directory
$lock && esmith::lockfile::UnlockFile($lock);
}
1;

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,201 @@
#----------------------------------------------------------------------
# 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::link;
use strict;
use esmith::ConfigDB;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(getExternalLink);
=head1 NAME
esmith::util::link - utilities for manipulating network links
=head1 SYNOPSIS
use esmith::util::link qw(getExternalLink);
# wait at most 60 seconds for the link to come up
my $timeout = 60;
# now just get the link
if (getExternalLink($timeout))
{
# the link is up
}
else
{
# the link didn't come up
}
=head1 DESCRIPTION
This is a collection of generally useful functions for manipulating network
links.
Functions are exported only on request.
=head2 Functions
=over 4
=item I<getExternalLink($timeout)>
Bring up the external link if it is not already up, waiting at most $timeout
seconds. If a $timeout is not specified, it defaults to 300 (5 minutes) for
dialup connections. This function can be used for both dialup and dedicated
connections, but dedicated connections will always return 1 (true).
Returns 1 if the external link is already up, or if it comes up within the
specfied $timeout period.
Returns 0 if the external link does not come up within the specified $timeout
period.
=cut
sub getExternalLink
{
my $timeout = shift;
my $configdb = esmith::ConfigDB->open;
my $rec = $configdb->get("AccessType");
my $accessType = $rec->value;
if ($accessType eq "dialup")
{
return _getDialupLink($timeout);
}
elsif ($accessType eq "dedicated")
{
# assume we are up
return 1;
}
else
{
# unknown access type
return 0;
}
}
=begin _private
=item I<getDialupLink($timeout)>
Bring up the ppp0 link, waiting at most $timeout seconds.
Returns 1 if the link comes up within the timeout period.
Returns 0 if the link does not come up within the timeout period.
The default timeout is 300 seconds.
=end _private
=cut
sub _getDialupLink
{
local $|=1;
my $timeout = shift(@_) || 300;
# check for existing ppp link
if (-f "/var/run/ppp0.pid")
{
# already up - return 1
return 1;
}
# create a diald monitor channel
my $ctlFile = "/etc/diald/diald.ctl";
my $monFile = "/tmp/diald.monitor.$$";
system('/bin/mknod', $monFile, 'p') == 0
or die "Can't mknod $monFile: $!\n";
# open control channel to diald
open (CTL, ">$ctlFile") or die "Can't open $ctlFile: $!\n";
# set up a child process to monitor the channel
my $pid = fork;
die "Can't fork: $!" unless defined $pid;
if ($pid)
{
# parent
# if the pipe reader isn't up first, diald will bail, so we open
# another pipe writer just to wait for the pipe reader
open (MON_W, ">$monFile") or die "can't open $monFile: $!\n";
# begin monitoring diald status via monitor fifo
print CTL "monitor $monFile\n";
close CTL;
# ok, everything is up and ready - send USR1 to diald
open (PID, "</var/run/diald.pid")
or die "can't open diald pidfile: $!\n";
my $dialdPid = <PID>;
close PID;
kill 'USR1', $dialdPid;
# Wait for the child to exit, then check for link again
waitpid($pid, 0);
close MON_W;
}
else
{
# child
open (MON, "<$monFile") or die "Can't open $monFile: $!\n";
# Parse the diald monitor stream for state information
my $state = "";
my $elapsed = 0;
while (<MON>)
{
# lucky us; diald sends a STATUS msg every second
if (/^STATUS/)
{
$elapsed++;
if ($elapsed >= $timeout)
{
# time is up - exit with failure code
exit 1;
}
}
elsif (/^STATE/)
{
$state = $_;
}
elsif ($state eq 'UP')
{
# the link is up - exit with success code
exit 0;
}
next;
}
close MON;
# end child
}
# parent (cont)
unlink $monFile;
if ($? == 0 || -f "/var/run/ppp0.pid")
{
# ok we're up - return 1 (true)
return 1;
}
else
{
# out of time - return 0 (false)
return 0;
}
}
1;

View File

@ -0,0 +1,312 @@
#----------------------------------------------------------------------
# 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::network;
use strict;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(isValidIP cleanIP isValidPort cmpIP);
our %EXPORT_TAGS = (
all => [qw(isValidIP cleanIP isValidPort cmpIP)]
);
use Net::IPv4Addr qw(:all);
use Mail::RFC822::Address;
use esmith::AccountsDB;
use constant TRUE => 1;
use constant FALSE => 0;
=for testing
use_ok('esmith::util::network');
=head1 NAME
esmith::util::network - miscellaneous network utilities
=head1 SYNOPSIS
use esmith::util::network qw(the functions you want);
my $ip = cleanIP($orig_ip);
my $is_valid = isValidIP($ip);
my $is_valid = isValidPort($port);
=head1 DESCRIPTION
This is a collection of generally useful functions for working with IP
addresses.
Functions are exported only on request.
=head2 Functions
=over 4
=item I<cleanIP>
my $ip = cleanIP($orig_ip);
If the $orig_ip is valid it will be cleaned up into a cannonical form,
stripping any padding zeros and such.
=begin testing
use esmith::util::network qw(cleanIP);
my %ips = (
'000.000.000.000' => '0.0.0.0',
'0.0.0.0' => '0.0.0.0',
'001.2.003.4' => '1.2.3.4',
'100.2.3.4' => '100.2.3.4',
'10.13.14.015' => '10.13.14.15',
'10.33.15.109' => '10.33.15.109',
'1.2.3.4.5' => ''
);
while( my($ip, $cleanip) = each %ips ) {
is( cleanIP($ip), $cleanip, "cleanIP($ip)" );
}
=end testing
=cut
sub cleanIP {
my $ip = shift;
return '' unless isValidIP($ip);
$ip =~ s/\b0+(\d+)/$1/g;
return isValidIP($ip) ? $ip : '';
}
=item I<isValidIP>
my $is_valid = isValidIP($ip);
Returns the IP given if $ip is a properly formatted IP address, undef otherwise.
=begin testing
use esmith::util::network qw(isValidIP);
my @goodIPs = qw(1.2.3.4
0.0.0.0
255.255.255.255
001.002.003.004
1.32.123.213
192.168.0.3
02.19.090.19
);
foreach my $ip (@goodIPs) {
ok( isValidIP($ip), "valid $ip");
}
my @badIPs = qw(256.3.2.4
-1.39.9.23
0
1
255.255.255.255.0
239..19.23.12
1.2.3.4.
foo.bar.com
);
foreach my $ip (@badIPs) {
ok( !isValidIP($ip), "invalid $ip");
}
=end testing
=cut
sub isValidIP($)
{
my ($string) = @_;
return unless defined ipv4_chkip($string);
return $string eq ipv4_chkip($string);
}
=item I<isValidPort>
my $is_valid = isValidPort($port);
Returns true if $port is a properly formatted port, false otherwise.
=begin testing
@badports = (98765434, -183, 0, 'bad port', 'a');
@goodports = (67, 23, 1, 54736);
foreach $port (@badports) {
isnt(esmith::util::network::isValidPort($port), 1);
}
foreach $port (@goodports) {
is(esmith::util::network::isValidPort($port), 1);
}
=end testing
=cut
sub isValidPort($)
{
my $port = shift;
return FALSE unless defined $port;
if (($port =~ /^\d+$/) &&
($port > 0) &&
($port < 65536))
{
return TRUE;
}
else {
return FALSE;
}
}
=item I<cmpIP>
Performs a cmp operation on two IP addresses.
=begin testing
$ip1 = '24.123.212.87';
$ip2 = '240.34.216.12';
is(esmith::util::network::cmpIP($ip1, $ip2), -1);
is(esmith::util::network::cmpIP($ip2, $ip1), 1);
is(esmith::util::network::cmpIP($ip1, $ip1), 0);
=end testing
=cut
sub cmpIP($$)
{
my $ip1 = ipv4_chkip(shift);
my $ip2 = ipv4_chkip(shift);
die "The first argument is not a valid IP address.\n" if not $ip1;
die "The second argument is not a valid IP address.\n" if not $ip2;
my @ip1cmps = split /\./, $ip1;
my @ip2cmps = split /\./, $ip2;
while (@ip1cmps)
{
my $cmp1 = shift @ip1cmps;
my $cmp2 = shift @ip2cmps;
my $cmp = $cmp1 <=> $cmp2;
return $cmp if $cmp;
}
return 0;
}
=item I<isValidHostname>
This function returns true if it is passed a valid RFC 921 hostname,
false otherwise.
=cut
sub isValidHostname
{
my $host_or_ip = shift;
unless (isValidIP($host_or_ip))
{
# It's not an IP address. Does it look like a hostname?
# FIXME: We could do a DNS lookup to be sure.
# (See RFC 921, "Domain Name System Implementation Schedule,"
# FIXME: Put this in a library.
unless ($host_or_ip =~ m{
# Must begin with an alphabetical character...
^[a-z]
# optionally followed by zero or more alphabetic characters,
# hyphens, periods and numbers...
[-a-z.0-9]*
(
# followed by one period...
\.
# and a repeat of the first pattern
[a-z]
[-a-z.0-9]*
)+
# which we can repeat one or more times, to the end of the
# string.
$
# Case insensitive.
}ix)
{
return 0;
}
}
return 1;
}
=item I<isValidEmail>
This validation function validates an email address, using the
Mail::RFC822::Address module. Additionally, by default, it permits a local
address instead of a fully-qualified remote address, even checking the
existence of said user in the accounts db.
If you don't wish to permit local addresses, pass the permitlocal option as
false.
ie. esmith::util::isValidEmail($address, { permitlocal => 0 })
=cut
sub isValidEmail
{
my $address = shift;
my $hashref = shift || {};
my %defaults = ( permitlocal => 1 );
my %options = (%defaults, %$hashref);
if (Mail::RFC822::Address::valid($address))
{
return TRUE;
}
# Permit a local address.
if ($address =~ /^[a-zA-Z][a-zA-Z0-9\._\-]*$/)
{
# Exception for 'admin' user. FIXME - I'd rather not hardcode this,
# but we can't permit email to all system users.
return TRUE if $address eq 'admin';
# Make sure the user exists.
my $accountsdb = esmith::AccountsDB->open_ro;
my $user = $accountsdb->get($address) || '';
unless (($user) && ($user->prop('type') eq 'user'))
{
return FALSE;
}
else
{
return TRUE;
}
}
return FALSE;
}
=back
=head1 AUTHOR
Mitel Networks Corp.
=cut
1;

View File

@ -0,0 +1,215 @@
#----------------------------------------------------------------------
# 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::system;
use strict;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(killall rsync rsync_ssh);
=for testing
use_ok('esmith::util::system', 'killall', 'rsync', 'rsync_ssh');
=head1 NAME
esmith::util::system - replacements/wrappers for system() commands
=head1 SYNOPSIS
use esmith::util::system qw(killall rsync rsync_ssh);
killall($signal, @commands);
rsync($src, $dest, @options);
rsync_ssh($src, $dest, $user, $ident, \@rsync_opts, \@ssh_opts);
=head1 DESCRIPTION
This is for common functions that would normally require a system(...)
command. Makes things easier to document, test and upgrade.
If you find yourself writing a system() command, consider putting it
in here.
=head2 Functions
These may be pure Perl functions or they may well just be wrappers
around system() commands.
Each can be imported on request.
=over 4
=item B<killall>
my $killed_something = killall($signal, @commands);
Sends a $signal to all of the named @commands. $signal can be
specified by name or number (so 1 or HUP for example, names are
prefered).
Returns true if something was killed, false otherwise.
=begin testing
open(SCRATCH, ">scratch.exe") || die $!;
# XXX Irritating perl bug ends POD processing if it sees /^#!.*perl/
print SCRATCH sprintf <<'ENDING', '/usr/bin/perl';
#!%s -w
sleep 99;
ENDING
close SCRATCH;
END { unlink 'scratch.exe', 'scratch.out' }
chmod 0755, 'scratch.exe' || die $!;
my $pid = open(SCRATCH, "./scratch.exe |");
ok( $pid, 'scratch program started ok' );
ok( killall('USR1', 'scratch.exe'), 'killall returned properly' );
close SCRATCH; # so scratch.exe responds to the signal and exits
is( kill(9, $pid), 0, 'killall worked' );
# I can't actually think of a way to explicitly check this but it
# will make noise if it doesn't work.
ok( !killall('USR1', 'I_dont_exist_nope'),
'returned properly for killing nothing' );
ok( 1, 'killall is quiet when nothing is killed' );
=end testing
=cut
sub killall {
my($signal, @commands) = @_;
warn "You don't need a - on the signal" if $signal =~ /^-/;
my $killed_something =
system('/usr/bin/killall', '-q', "-$signal", @commands);
return !$killed_something;
}
=back
=item B<rsync>
my $success = rsync($source, $destination, @options);
rsyncs the $source file or directory to the $destination. Any
@options are direct options to the rsync command.
rsync will be run --quiet by default.
Returns true if the rsync succeeds, false otherwise.
=begin testing
use File::Compare;
my $src = '10e-smith-lib/db.t';
my $dest = '10e-smith-lib/db.t.copy';
rsync($src, $dest);
END { unlink $dest }
ok( -e $dest );
ok( compare($src, $dest) == 0, 'basic rsync copy' );
open(DEST, ">$dest" ) || die $!;
print DEST "Fooble\n";
close DEST;
# rsync in update-only mode. $dest is newer than $src and shouldn't
# be updated.
rsync($src, $dest, qw(--update));
ok( compare($src, $dest) == 1, 'rsync, update only' );
open(DEST, "$dest") || die $!;
my $data = join '', <DEST>;
close DEST;
is( $data, "Fooble\n" );
=end testing
=cut
our $RSYNC_CMD = '/usr/bin/rsync';
sub rsync {
my($src, $dest, @options) = @_;
push @options, '--quiet';
return !system($RSYNC_CMD, @options, $src, $dest);
}
=item B<rsync_ssh>
my $success = rsync_ssh($src, $dest, $user, $ident, \@rsync_opts,
\@ssh_opts);
Like rsync() except it uses ssh. A typical call might be:
rsync_ssh('some.host:', 'some/file', 'someuser', 'some/.ssh/identity',
[qw(--archive --delete)]);
=begin testing
use File::Compare;
my $src = '10e-smith-lib/db.t';
my $dest = '10e-smith-lib/db.t.copy';
unlink $dest;
END { unlink $dest }
no warnings 'once';
my @args;
my $real_rsync = \&esmith::util::system::rsync;
local *esmith::util::system::rsync = sub {
@args = @_;
pop @_;
$real_rsync->(@_);
};
rsync_ssh($src, $dest, 'someone', 'some/ident', [qw(--update)], [qw(-C)]);
ok( -e $dest );
ok( compare($src, $dest) == 0 );
is($args[0], $src );
is($args[1], $dest );
is($args[2], '--update' );
is($args[3], "-e $esmith::util::system::SSH_CMD -l someone -i some/ident -C");
=end testing
=cut
our $SSH_CMD = '/usr/bin/ssh';
sub rsync_ssh {
my($src, $dest, $user, $ident, $rsync_opts, $ssh_opts) = @_;
$ssh_opts ||= [];
my $ssh_opt = join ' ', ('-e', $SSH_CMD, '-l', $user, '-i', $ident,
@$ssh_opts);
return rsync($src, $dest, @$rsync_opts, $ssh_opt);
}
=head1 AUTHOR
Mitel Networks Corporation
=cut
1;