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
4
.gitignore
vendored
Normal file
4
.gitignore
vendored
Normal file
@@ -0,0 +1,4 @@
|
||||
*.rpm
|
||||
*.log
|
||||
*spec-20*
|
||||
*.tar.xz
|
||||
21
Makefile
Normal file
21
Makefile
Normal 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)
|
||||
18
README.md
18
README.md
@@ -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
|
||||
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
131
additional/Artistic
Normal 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
340
additional/Copying
Normal 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
33
additional/LICENSE
Normal 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
790
additional/e-smith-lib.spec
Normal 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
1
contriborbase
Normal file
@@ -0,0 +1 @@
|
||||
sme10
|
||||
38
createlinks
Normal file
38
createlinks
Normal 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
902
e-smith-lib.spec
Normal 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)
|
||||
3
root/etc/e-smith/db/configuration/migrate/00openRW
Normal file
3
root/etc/e-smith/db/configuration/migrate/00openRW
Normal file
@@ -0,0 +1,3 @@
|
||||
{
|
||||
$DB = esmith::ConfigDB->open(${DB_FILENAME});
|
||||
}
|
||||
146
root/etc/e-smith/events/actions/adjust-services
Executable file
146
root/etc/e-smith/events/actions/adjust-services
Executable 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 => $_,
|
||||
);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
61
root/etc/e-smith/events/actions/generic_template_expand
Normal file
61
root/etc/e-smith/events/actions/generic_template_expand
Normal 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,
|
||||
});
|
||||
}
|
||||
35
root/etc/e-smith/events/actions/initialize-default-databases
Normal file
35
root/etc/e-smith/events/actions/initialize-default-databases
Normal 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;
|
||||
}
|
||||
0
root/etc/e-smith/events/e-smith-lib-update/.gitignore
vendored
Normal file
0
root/etc/e-smith/events/e-smith-lib-update/.gitignore
vendored
Normal file
10
root/etc/e-smith/templates-default/template-begin
Normal file
10
root/etc/e-smith/templates-default/template-begin
Normal 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
|
||||
#------------------------------------------------------------
|
||||
13
root/etc/e-smith/templates-default/template-begin-html
Normal file
13
root/etc/e-smith/templates-default/template-begin-html
Normal file
@@ -0,0 +1,13 @@
|
||||
{
|
||||
$OUT = <<HERE;
|
||||
<!--
|
||||
HERE
|
||||
|
||||
$OUT .=
|
||||
Text::Template::_load_text("/etc/e-smith/templates-default/template-begin");
|
||||
|
||||
$OUT .= <<HERE;
|
||||
-->
|
||||
HERE
|
||||
|
||||
}
|
||||
8
root/etc/e-smith/templates-default/template-begin-pam
Normal file
8
root/etc/e-smith/templates-default/template-begin-pam
Normal file
@@ -0,0 +1,8 @@
|
||||
{
|
||||
$OUT = <<HERE;
|
||||
#%PAM-1.0
|
||||
HERE
|
||||
|
||||
$OUT .=
|
||||
Text::Template::_load_text("/etc/e-smith/templates-default/template-begin");
|
||||
}
|
||||
8
root/etc/e-smith/templates-default/template-begin-perl
Normal file
8
root/etc/e-smith/templates-default/template-begin-perl
Normal file
@@ -0,0 +1,8 @@
|
||||
{
|
||||
$OUT = <<HERE;
|
||||
#!/usr/bin/perl -w
|
||||
HERE
|
||||
|
||||
$OUT .=
|
||||
Text::Template::_load_text("/etc/e-smith/templates-default/template-begin");
|
||||
}
|
||||
14
root/etc/e-smith/templates-default/template-begin-php
Normal file
14
root/etc/e-smith/templates-default/template-begin-php
Normal file
@@ -0,0 +1,14 @@
|
||||
{
|
||||
$OUT = <<HERE;
|
||||
<?php
|
||||
/*
|
||||
HERE
|
||||
|
||||
$OUT .=
|
||||
Text::Template::_load_text("/etc/e-smith/templates-default/template-begin");
|
||||
|
||||
$OUT .= <<HERE;
|
||||
*/
|
||||
HERE
|
||||
|
||||
}
|
||||
8
root/etc/e-smith/templates-default/template-begin-shell
Normal file
8
root/etc/e-smith/templates-default/template-begin-shell
Normal file
@@ -0,0 +1,8 @@
|
||||
{
|
||||
$OUT = <<HERE;
|
||||
#!/bin/sh
|
||||
HERE
|
||||
|
||||
$OUT .=
|
||||
Text::Template::_load_text("/etc/e-smith/templates-default/template-begin");
|
||||
}
|
||||
1
root/etc/e-smith/templates-default/template-end-php
Normal file
1
root/etc/e-smith/templates-default/template-end-php
Normal file
@@ -0,0 +1 @@
|
||||
?>
|
||||
81
root/etc/e-smith/tests/10e-smith-lib/accounts.conf
Normal file
81
root/etc/e-smith/tests/10e-smith-lib/accounts.conf
Normal 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
|
||||
95
root/etc/e-smith/tests/10e-smith-lib/config.t
Normal file
95
root/etc/e-smith/tests/10e-smith-lib/config.t
Normal 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' );
|
||||
};
|
||||
13
root/etc/e-smith/tests/10e-smith-lib/config_taint.t
Normal file
13
root/etc/e-smith/tests/10e-smith-lib/config_taint.t
Normal 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' );
|
||||
103
root/etc/e-smith/tests/10e-smith-lib/configuration.conf
Normal file
103
root/etc/e-smith/tests/10e-smith-lib/configuration.conf
Normal 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
|
||||
215
root/etc/e-smith/tests/10e-smith-lib/db.t
Normal file
215
root/etc/e-smith/tests/10e-smith-lib/db.t
Normal 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') );
|
||||
@@ -0,0 +1 @@
|
||||
invalid
|
||||
@@ -0,0 +1 @@
|
||||
enabled
|
||||
@@ -0,0 +1 @@
|
||||
service
|
||||
@@ -0,0 +1 @@
|
||||
enabled
|
||||
@@ -0,0 +1,4 @@
|
||||
{
|
||||
$DB = esmith::ConfigDB->open("${DB_FILENAME}");
|
||||
}
|
||||
|
||||
@@ -0,0 +1,3 @@
|
||||
{
|
||||
$DB->new_record("quux", {type=>'service', status=>'enabled'});
|
||||
}
|
||||
7
root/etc/e-smith/tests/10e-smith-lib/db_dummy.conf
Normal file
7
root/etc/e-smith/tests/10e-smith-lib/db_dummy.conf
Normal 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|
|
||||
141
root/etc/e-smith/tests/10e-smith-lib/default_migrate_force.t
Normal file
141
root/etc/e-smith/tests/10e-smith-lib/default_migrate_force.t
Normal 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);
|
||||
}
|
||||
}
|
||||
}
|
||||
3
root/etc/e-smith/tests/10e-smith-lib/domains.conf
Normal file
3
root/etc/e-smith/tests/10e-smith-lib/domains.conf
Normal file
@@ -0,0 +1,3 @@
|
||||
test=domain|foo|bar
|
||||
foo=domain|baz|quux
|
||||
wombat=notadomain
|
||||
11
root/etc/e-smith/tests/10e-smith-lib/dummy.conf
Normal file
11
root/etc/e-smith/tests/10e-smith-lib/dummy.conf
Normal 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.
|
||||
13
root/etc/e-smith/tests/10e-smith-lib/hosts.conf
Normal file
13
root/etc/e-smith/tests/10e-smith-lib/hosts.conf
Normal 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
|
||||
@@ -0,0 +1 @@
|
||||
I am an English license.
|
||||
@@ -0,0 +1 @@
|
||||
Je suis une license francais. Or something like that.
|
||||
1
root/etc/e-smith/tests/10e-smith-lib/networks.conf
Normal file
1
root/etc/e-smith/tests/10e-smith-lib/networks.conf
Normal file
@@ -0,0 +1 @@
|
||||
10.0.0.0=network|Mask|255.255.255.0|Router|default
|
||||
@@ -0,0 +1 @@
|
||||
sysconfig=configuration|KeyboardType|pc|Keytable|us|Language|en_US|ReleaseVersion|6.0alpha2
|
||||
@@ -0,0 +1 @@
|
||||
sysconfig=configuration|KeyboardType|pc|Keytable|us|Language|fr_CA|ReleaseVersion|6.0alpha2
|
||||
111
root/etc/e-smith/tests/10e-smith-lib/templates.t
Normal file
111
root/etc/e-smith/tests/10e-smith-lib/templates.t
Normal 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
|
||||
|
||||
20
root/etc/e-smith/tests/10e-smith-lib/templates/10moof
Normal file
20
root/etc/e-smith/tests/10e-smith-lib/templates/10moof
Normal 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
|
||||
@@ -0,0 +1,3 @@
|
||||
# This is the beginning of the beginning
|
||||
# { keys %$confref == 1 && exists $confref->{Koala_Say}
|
||||
? "confref ok" : "confref not ok" }
|
||||
@@ -0,0 +1 @@
|
||||
# This is the end, My only friend, the end of our elaborate templates, the end
|
||||
20
root/etc/e-smith/tests/10e-smith-lib/templates2/10moof
Normal file
20
root/etc/e-smith/tests/10e-smith-lib/templates2/10moof
Normal 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
|
||||
@@ -0,0 +1 @@
|
||||
# This is the end, My only friend, the end of our elaborate templates, the end
|
||||
9
root/etc/e-smith/tests/10e-smith-lib/templates_DB/10DB
Normal file
9
root/etc/e-smith/tests/10e-smith-lib/templates_DB/10DB
Normal 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;
|
||||
}
|
||||
@@ -0,0 +1,7 @@
|
||||
|
||||
{ if( *{confref}{SCALAR} ) {
|
||||
"confref not defined";
|
||||
} else {
|
||||
"confref defined"
|
||||
}
|
||||
}
|
||||
@@ -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
|
||||
}
|
||||
|
||||
@@ -0,0 +1,2 @@
|
||||
|
||||
The end of labor is to gain leisure.
|
||||
112
root/etc/e-smith/tests/10e-smith-lib/uidgid.conf
Normal file
112
root/etc/e-smith/tests/10e-smith-lib/uidgid.conf
Normal 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
|
||||
78
root/etc/e-smith/tests/10e-smith-lib/uidgid.t
Normal file
78
root/etc/e-smith/tests/10e-smith-lib/uidgid.t
Normal 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
10
root/sbin/e-smith/config
Executable 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";
|
||||
84
root/sbin/e-smith/create-system-user
Normal file
84
root/sbin/e-smith/create-system-user
Normal 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
344
root/sbin/e-smith/db
Normal 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, $_);
|
||||
}
|
||||
}
|
||||
46
root/sbin/e-smith/expand-template
Normal file
46
root/sbin/e-smith/expand-template
Normal 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);
|
||||
|
||||
24
root/sbin/e-smith/signal-event
Normal file
24
root/sbin/e-smith/signal-event
Normal 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);
|
||||
|
||||
540
root/usr/share/perl5/vendor_perl/esmith/AccountsDB.pm
Normal file
540
root/usr/share/perl5/vendor_perl/esmith/AccountsDB.pm
Normal 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
|
||||
|
||||
|
||||
|
||||
398
root/usr/share/perl5/vendor_perl/esmith/ConfigDB.pm
Normal file
398
root/usr/share/perl5/vendor_perl/esmith/ConfigDB.pm
Normal 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;
|
||||
108
root/usr/share/perl5/vendor_perl/esmith/ConfigDB/Record.pm
Normal file
108
root/usr/share/perl5/vendor_perl/esmith/ConfigDB/Record.pm
Normal 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;
|
||||
22
root/usr/share/perl5/vendor_perl/esmith/ConfigDB/UTF8.pm
Normal file
22
root/usr/share/perl5/vendor_perl/esmith/ConfigDB/UTF8.pm
Normal 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;
|
||||
|
||||
705
root/usr/share/perl5/vendor_perl/esmith/DB.pm
Normal file
705
root/usr/share/perl5/vendor_perl/esmith/DB.pm
Normal 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;
|
||||
157
root/usr/share/perl5/vendor_perl/esmith/DB/Record.pm
Normal file
157
root/usr/share/perl5/vendor_perl/esmith/DB/Record.pm
Normal 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;
|
||||
660
root/usr/share/perl5/vendor_perl/esmith/DB/db.pm
Normal file
660
root/usr/share/perl5/vendor_perl/esmith/DB/db.pm
Normal 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;
|
||||
353
root/usr/share/perl5/vendor_perl/esmith/DB/db/Record.pm
Normal file
353
root/usr/share/perl5/vendor_perl/esmith/DB/db/Record.pm
Normal 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;
|
||||
99
root/usr/share/perl5/vendor_perl/esmith/DomainsDB.pm
Normal file
99
root/usr/share/perl5/vendor_perl/esmith/DomainsDB.pm
Normal 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;
|
||||
230
root/usr/share/perl5/vendor_perl/esmith/HostsDB.pm
Normal file
230
root/usr/share/perl5/vendor_perl/esmith/HostsDB.pm
Normal 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;
|
||||
331
root/usr/share/perl5/vendor_perl/esmith/I18N.pm
Normal file
331
root/usr/share/perl5/vendor_perl/esmith/I18N.pm
Normal 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;
|
||||
77
root/usr/share/perl5/vendor_perl/esmith/Logger.pm
Normal file
77
root/usr/share/perl5/vendor_perl/esmith/Logger.pm
Normal 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;
|
||||
16
root/usr/share/perl5/vendor_perl/esmith/NavigationDB.pm
Normal file
16
root/usr/share/perl5/vendor_perl/esmith/NavigationDB.pm
Normal 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;
|
||||
|
||||
157
root/usr/share/perl5/vendor_perl/esmith/NetworksDB.pm
Normal file
157
root/usr/share/perl5/vendor_perl/esmith/NetworksDB.pm
Normal 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;
|
||||
480
root/usr/share/perl5/vendor_perl/esmith/cgi.pm
Normal file
480
root/usr/share/perl5/vendor_perl/esmith/cgi.pm
Normal 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 = " "}
|
||||
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 = " " }
|
||||
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 = " " }
|
||||
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 = " " }
|
||||
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 = " " }
|
||||
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 = " " }
|
||||
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 = " " }
|
||||
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 (' '),
|
||||
# $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
|
||||
|
||||
640
root/usr/share/perl5/vendor_perl/esmith/config.pm
Normal file
640
root/usr/share/perl5/vendor_perl/esmith/config.pm
Normal 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;
|
||||
25
root/usr/share/perl5/vendor_perl/esmith/config/utf8.pm
Normal file
25
root/usr/share/perl5/vendor_perl/esmith/config/utf8.pm
Normal 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;
|
||||
|
||||
603
root/usr/share/perl5/vendor_perl/esmith/console.pm
Executable file
603
root/usr/share/perl5/vendor_perl/esmith/console.pm
Executable 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;
|
||||
743
root/usr/share/perl5/vendor_perl/esmith/db.pm
Normal file
743
root/usr/share/perl5/vendor_perl/esmith/db.pm
Normal 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;
|
||||
133
root/usr/share/perl5/vendor_perl/esmith/ethernet.pm
Normal file
133
root/usr/share/perl5/vendor_perl/esmith/ethernet.pm
Normal 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
|
||||
|
||||
220
root/usr/share/perl5/vendor_perl/esmith/event.pm
Normal file
220
root/usr/share/perl5/vendor_perl/esmith/event.pm
Normal 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;
|
||||
61
root/usr/share/perl5/vendor_perl/esmith/lockfile.pm
Normal file
61
root/usr/share/perl5/vendor_perl/esmith/lockfile.pm
Normal 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;
|
||||
76
root/usr/share/perl5/vendor_perl/esmith/logrotate.pm
Normal file
76
root/usr/share/perl5/vendor_perl/esmith/logrotate.pm
Normal 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;
|
||||
140
root/usr/share/perl5/vendor_perl/esmith/tcpsvd.pm
Normal file
140
root/usr/share/perl5/vendor_perl/esmith/tcpsvd.pm
Normal 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;
|
||||
1091
root/usr/share/perl5/vendor_perl/esmith/templates.pm
Normal file
1091
root/usr/share/perl5/vendor_perl/esmith/templates.pm
Normal file
File diff suppressed because it is too large
Load Diff
1413
root/usr/share/perl5/vendor_perl/esmith/util.pm
Normal file
1413
root/usr/share/perl5/vendor_perl/esmith/util.pm
Normal file
File diff suppressed because it is too large
Load Diff
201
root/usr/share/perl5/vendor_perl/esmith/util/link.pm
Normal file
201
root/usr/share/perl5/vendor_perl/esmith/util/link.pm
Normal 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;
|
||||
312
root/usr/share/perl5/vendor_perl/esmith/util/network.pm
Normal file
312
root/usr/share/perl5/vendor_perl/esmith/util/network.pm
Normal 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;
|
||||
215
root/usr/share/perl5/vendor_perl/esmith/util/system.pm
Normal file
215
root/usr/share/perl5/vendor_perl/esmith/util/system.pm
Normal 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;
|
||||
Reference in New Issue
Block a user