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
parent
6d7e97ea37
commit
a527984040
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;
|
||||||
Loading…
Reference in New Issue
Block a user