diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e594810 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +*.rpm +*.log +*spec-20* +*.tar.xz diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..68b7dd1 --- /dev/null +++ b/Makefile @@ -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) diff --git a/README.md b/README.md index 9a36d97..2b2072f 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,17 @@ -# e-smith-lib +# e-smith-lib -SMEServer Koozali developed git repo for e-smith-lib smeserver \ No newline at end of file +SMEServer Koozali developed git repo for e-smith-lib smeserver + +## Wiki +
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 + +
*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* +
+ +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. diff --git a/additional/Artistic b/additional/Artistic new file mode 100644 index 0000000..5f22124 --- /dev/null +++ b/additional/Artistic @@ -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 diff --git a/additional/Copying b/additional/Copying new file mode 100644 index 0000000..eeb586b --- /dev/null +++ b/additional/Copying @@ -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. + + + Copyright (C) 19yy + + 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. + + , 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. diff --git a/additional/LICENSE b/additional/LICENSE new file mode 100644 index 0000000..0941e68 --- /dev/null +++ b/additional/LICENSE @@ -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. + diff --git a/additional/e-smith-lib.spec b/additional/e-smith-lib.spec new file mode 100644 index 0000000..ab41d90 --- /dev/null +++ b/additional/e-smith-lib.spec @@ -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 2.4.0-1.sme +- Bump version in prep for SME9 + +* Mon Oct 11 2010 Shad L. Lords 2.2.0-7.sme +- Serialize configure_peers to prevent errors [SME: 5831] + +* Fri Feb 5 2010 Stephen Noble 2.2.0-6.sme +- adds the hwaddr parameter to probeAdapters() [SME: 4528] + +* Thu Feb 4 2010 Shad L. Lords 2.2.0-5.sme +- Update path for 64-bit compatibility [SME: 5756] + +* Tue Dec 22 2009 Filippo Carletti 2.2.0-4.sme +- Really apply previous patch in the spec file. [SME: 5659] + +* Wed Dec 9 2009 Charlie Brady 2.2.0-3.sme +- Add patch (Federico Simoncelli) to prevent re-use of uids. [SME: 5659] + +* Mon Oct 13 2008 Shad L. Lords 2.2.0-2.sme +- Add patch to support multiple samba roles [SME: 4172] + +* Tue Oct 7 2008 Shad L. Lords 2.2.0-1.sme +- Roll new stream to separate sme7/sme8 trees [SME: 4633] + +* Wed Aug 20 2008 Shad L. Lords 1.19.0-1 +- Roll new dev stream. + +* Sat Aug 9 2008 Shad L. Lords 1.18.0-28 +- Read /dev/urandmon instead of /dev/random [SME: 4492] + +* Sat Aug 9 2008 Shad L. Lords 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 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 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 1.18.0-24 +- Gracefully handle encoding errors in navigation dbs [SME: 4147] + +* Wed Mar 26 2008 Shad L. Lords 1.18.0-23 +- Make PAM conv routine not look for english strings [SME: 4117] + +* Tue Mar 25 2008 Shad L. Lords 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 1.18.0-21 +- Output navigation in UTF-8 [SME: 3858] + +* Sun Jan 20 2008 Gavin Weight 1.18.0-20 +- Call smbpasswd -e - to reset user correctly. [SME: 3755] + +* Tue Jan 08 2008 Stephen Noble 1.18.0-19 +- modify validate password strong match for console [SME: 2173] + +* Thu Nov 01 2007 Gavin Weight 1.18.0-18 +- Fix I18N.pm file descriptor leak. [SME: 3509] + +* Wed Oct 31 2007 Charlie Brady 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 1.18.0-16 +- pam_unix requires passwords >= 6 [SME: 3039] + +* Mon May 21 2007 Shad L. Lords 1.18.0-15 +- Fix ip addr shift to work on 64-bit + +* Sun Apr 29 2007 Shad L. Lords +- Clean up spec so package can be built by koji/plague + +* Thu Apr 05 2007 Shad L. Lords 1.18.0-14 +- Reverse changes for 1.18.0-12 as it is being used. [SME: 2838] + +* Wed Apr 04 2007 Charlie Brady 1.18.0-13 +- Allow gauge console widget to be used without following message_page. + [SME: 2832]. + +* Mon Mar 26 2007 Charlie Brady 1.18.0-12 +- Remove undocumented and unused template metadata handling from + generic_template_expand action. [SME: 2798] + +* Mon Mar 26 2007 Charlie Brady 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 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 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 1.18.0-8 +- Add gauge widget to esmith::console. [SME: 2579] + +* Sun Feb 25 2007 Charlie Brady 1.18.0-7 +- Default infobox height to 8 rows, and allow override via params. + [SME: 2560] + +* Fri Feb 23 2007 Shad L. Lords 1.18.0-6 +- Really fix clear parameter for inputbox dialog screen [SME: 2533] + +* Fri Feb 23 2007 Shad L. Lords 1.18.0-5 +- Fix clear parameter for dialog screens [SME: 2533] + +* Thu Feb 22 2007 Charlie Brady 1.18.0-4 +- switch esmith::console::password_page() to use dialog rather than + whiptail. [SME: 2534] + +* Thu Feb 22 2007 Charlie Brady 1.18.0-3 +- Add infobox widget. [SME: 2533] + +* Sun Jan 28 2007 Shad L. Lords 1.18.0-2 +- Fix backtitle spacing for new dialog menus [SME: 2328] + +* Fri Jan 26 2007 Shad L. Lords 1.18.0-1 +- Roll stable stream. [SME: 2328] + +* Tue Dec 15 2006 Federico Simoncelli 1.17.0-8 +- Added the validatePassword function to esmith::util. [SME: 2100] + +* Thu Dec 07 2006 Shad L. Lords +- Update to new release naming. No functional changes. +- Make Packager generic + +* Fri Nov 24 2006 Gordon Rowell 1.17.0-06 +- Allow optional path to peeers directory in + esmith::tcpsvd::configure_peers() [SME: 2086] + +* Tue Nov 14 2006 Charlie Brady 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 1.17.0-04 +- Allow display of "0" in iesmith::cgi::genSmallCell. [SME: 2038] + +* Mon Oct 23 2006 Charlie Brady 1.17.0-03 +- Make dialog the default console app, with whiptail used only when + required. + +* Wed Oct 11 2006 Charlie Brady 1.17.0-02 +- Allow 'dialog' to be called from esmith::console. [SME: 1958] + +* Wed Oct 11 2006 Charlie Brady 1.17.0-01 +- Roll development branch. + +* Mon Sep 25 2006 Charlie Brady 1.16.0-06 +- Fix problem with greedy RE in template.metadata parsing. [SME: 1906] + +* Fri Sep 08 2006 Charlie Brady 1.16.0-05 +- Fix taint problem in template.metadata handling. [SME: 1906] + +* Thu Apr 13 2006 Charlie Brady 1.16.0-04 +- Use "kudzu --probe --class network" for NIC detection. [SME: 727] + +* Fri Apr 7 2006 Gordon Rowell 1.16.0-03 +- Don't call smbpasswd -e - setting the password is sufficient [SME: 1193] + +* Tue Mar 28 2006 Gordon Rowell 1.16.0-02 +- Log previous contents of db entry in DELETE log [SME: 1066] + +* Tue Mar 14 2006 Charlie Brady 1.16.0-01 +- Roll to stable stream version number. [SME: 1016] + +* Fri Mar 10 2006 Charlie Brady 1.15.4-02 +- Suppress warning from genSmallCell if text is undefined. [SME: 986] + +* Fri Feb 17 2006 Gordon Rowell 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 1.15.3-42 +- Adjust console title bar to 'SME Server' [SME: 726] + +* Tue Feb 14 2006 Gordon Rowell 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 1.15.3-40 +- Update URL in default template-begin fragment. [SME: 773] + +* Sat Feb 11 2006 Charlie Brady 1.15.3-39 +- Remove obsolete e-smith-lib-Tai64n package. [SME: 689] + +* Sat Feb 11 2006 Charlie Brady 1.15.3-38 +- [Null changelog for missing version - we accidentally skipped + this version.] + +* Sat Feb 11 2006 Charlie Brady 1.15.3-37 +- Fix get_all_by_prop in scalar context. [SME: 669,721] + +* Mon Feb 6 2006 Shad L. Lords 1.15.3-37 +- Add ability to pass many props to get_all_by_prop [SME: 669] + +* Mon Jan 23 2006 Charlie Brady 1.15.3-36 +- Fix warning during pseudonym deletion. [SME: 491] + +* Fri Jan 20 2006 Charlie Brady 1.15.3-35 +- Fix up use of Sys::Syslog::syslog. [SME: 526] + +* Thu Jan 19 2006 Charlie Brady 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 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 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 1.15.3-31 +- And update POD for last change [SME: 24] + +* Mon Jan 9 2006 Gordon Rowell 1.15.3-30 +- Allow dot and underscore in account names [SME: 24] + +* Tue Dec 27 2005 Gordon Rowell 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 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 +- [1.15.3-27] +- Moved queueing logic to separate daemon, replaced with FIFO IPC [BZ252 + +* Thu Dec 01 2005 Mark Knox +- [1.15.3-26] +- Added event queueing (open source portion) for clustered systems [BZ250] + +* Wed Nov 30 2005 Gordon Rowell 1.15.3-25 +- Bump release number only + +* Thu Nov 24 2005 Gordon Rowell +- [1.15.3-24] +- Add missing 'use Locale::gettext' to esmith::console.pm [MN00108804] + +* Sun Nov 20 2005 Charlie Brady +- [1.15.3-23] +- Clarify logic for stopped services in adjust-services. [SF: 1357629] + +* Sun Nov 20 2005 Gordon Rowell +- [1.15.3-22] +- Correct adjust-services logic for stopped services [SF: 1357629] + +* Wed Nov 16 2005 Charlie Brady +- [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 +- [1.15.3-20] +- Also don't start services if we just want to "once" them. [SF: 1357629] + +* Wed Nov 16 2005 Charlie Brady +- [1.15.3-19] +- Fix restart of enabled supervised services which we are attempting to stop. + [SF: 1357629] + +* Tue Nov 15 2005 Charlie Brady +- [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 +- [1.15.3-17] +- Pass $EVENT to template expansions in generic_template_expand. + [SF: MN00106104] + +* Tue Nov 15 2005 Gordon Rowell +- [1.15.3-16] +- Redirect esmith::config calls on old db paths to the new + location [SF: 1335865] + +* Thu Oct 27 2005 Charlie Brady +- [1.15.3-15] +- Fix a few minor spec file portability issues. [SF: 1339729] + +* Wed Oct 26 2005 Charlie Brady +- [1.15.3-14] +- Add it and de to the langtag2locale fixups. [SF: 1338236] + +* Tue Oct 11 2005 Charlie Brady +- [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 +- [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 +- [1.15.3-11] +- Untaint db names before attempting to move them. [MN00098405] + +* Thu Sep 22 2005 Charlie Brady +- [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 +- [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 +- [1.15.3-08] +- Remove warning about explicit path in esmith::db::_db_path. + [SF: 1286294] + +* Fri Sep 9 2005 Charlie Brady +- [1.15.3-07] +- Tolerate, but warn about, symlinks in /home/e-smith. [SF: 1216546] + +* Fri Sep 9 2005 Charlie Brady +- [1.15.3-06] +- Reduce the noise from _file_path() in esmith::DB::db. [SF: 1286294] + +* Wed Sep 7 2005 Charlie Brady +- [1.15.3-05] +- Fix operation of expandTemplate when taint check is enabled. + [SF: 1284301] + +* Wed Aug 17 2005 Mark Knox +- [1.15.3-04] +- Added open_local and open_ro_local methods for clustering [markk MN00094831] + +* Tue Aug 16 2005 Charlie Brady +- [1.15.3-03] +- Fix POD error in util.pm. + +* Wed Jul 27 2005 Charlie Brady +- [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 +- [1.15.3-01] +- Roll a new development stream - 1.15.3 + +* Wed Jul 27 2005 Charlie Brady +- [1.15.2-04] +- Remove broken MergeDB stuff. [SF: 1246315] + +* Wed Jul 27 2005 Mark Knox +- [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 +- [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 +- [1.15.2-01] +- Roll new development stream - 1.15.2 + +* Fri Jul 15 2005 Mark Knox +- [1.15.1-44] +- Tweak to allow calling _writeconf from SOAP [markk MN00090738] + +* Tue Jun 21 2005 Charlie Brady +- [1.15.1-43] +- Ensure that esmith::util::LdapPassword returns bare string without + newline terminator. + +* Sun Jun 12 2005 Charlie Brady +- [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 +- [1.15.1-41] +- Provide feedback (via log messages) from services2adjust. [SF: 1218920] + +* Mon May 30 2005 Charlie Brady +- [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 +- [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 +- [1.15.1-38] +- Fix esmith::DB::get_prop_and_delete fail if prop is "false" [From Gordon]. + +* Tue May 3 2005 Charlie Brady +- [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 +- [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 +- [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 +- [1.15.1-34] +- Add missing "use esmith::util" in esmith::tcpsvd. + +* Wed Mar 16 2005 Charlie Brady +- [1.15.1-33] +- Add esmith::tcpsvd library for managing tcpsvd "peers" + directories. + +* Mon Mar 14 2005 Charlie Brady +- [1.15.1-32] +- Make template expansion message more succinct. + +* Thu Mar 10 2005 Charlie Brady +- [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 +- [1.15.1-30] +- Fix incompatibility with CentOS's CGI.pm. + +* Tue Feb 22 2005 Charlie Brady +- [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 +- [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 +- [1.15.1-27] +- Fix typo. [MN00066059] + +* Wed Feb 16 2005 Charlie Brady +- [1.15.1-26] +- Use /sbin/e-smith/whiptail if it is available. [MN00066059] + +* Mon Feb 7 2005 Charlie Brady +- [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 +- [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 +- [1.15.1-23] +- Really move /home/e-smith/* to e-smith-base. [MN00066635] + +* Fri Jan 28 2005 Charlie Brady +- [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 +- [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 +- [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 +- [1.15.1-19] +- Add adjust-services generic action script [MN00065576] + +* Tue Jan 18 2005 Charlie Brady +- [1.15.1-18] +- Fix typo. [MN00064412] +- Improve die() message in esmith::config::STORE. [MN00064394] + +* Mon Jan 17 2005 Charlie Brady +- [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 +- [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 +- [1.15.1-15] +- Change copyright date to 2004 [markk MN00060958] + +* Fri Nov 5 2004 Charlie Brady +- [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 +- [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 +- [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 +- [1.15.1-11] +- Updated esmith::ethernet's search paths for network drivers. + [msoulier MN00052510] + +* Mon Oct 4 2004 Charlie Brady +- [1.15.1-10] +- Remove dependency on perl(Filter::Handle) [charlieb MN00050075] + +* Fri Sep 24 2004 Charlie Brady +- [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 +- [1.15.1-08] +- Added esmith::util::network::isValidEmail function. [msoulier MN00023814] + +* Thu Aug 26 2004 Michael Soulier +- [1.15.1-07] +- Added svdisable to permissible actions in serviceControl. + [msoulier MN00043056] + +* Tue Aug 10 2004 Michael Soulier +- [1.15.1-06] +- Fixed new methods. Bad else case. [msoulier MN00044891] + +* Fri Aug 6 2004 Michael Soulier +- [1.15.1-05] +- Added a keys() method. [msoulier MN00041968] + +* Fri Aug 6 2004 Michael Soulier +- [1.15.1-04] +- Added set_prop and set_value methods in esmith::DB. [msoulier MN00044891] + +* Tue Jul 20 2004 Michael Soulier +- [1.15.1-03] +- Undeprecated esmith::util::serviceControl. [msoulier MN00043056] + +* Fri Jun 25 2004 Tony Clayton +- [1.15.1-02] +- Merge language_tag2locale() function from perl-I18N-LangTags [tonyc + MN00040170] + +* Fri May 28 2004 Michael Soulier +- [1.15.1-01] +- Rolling to collect patches. + +* Fri May 28 2004 Michael Soulier +- [1.15.0-23] +- Reordered the create code slightly to catch more errors. + [msoulier MN00035059] + +* Fri May 28 2004 Michael Soulier +- [1.15.0-22] +- Added yet more error handling and reporting. [msoulier MN00035059] + +* Fri May 28 2004 Michael Soulier +- [1.15.0-21] +- Fixed one $Error reference that I missed in the last rev. + [msoulier MN00035059] + +* Fri May 28 2004 Michael Soulier +- [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 +- [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 +- [1.15.0-18] +- Changed print statements to calls to the logger. [msoulier MN00035059] + +* Thu May 27 2004 Michael Soulier +- [1.15.0-17] +- Added print statements to initialize-default-databases for post-install + debugging. [msoulier MN00035059] + +* Fri May 7 2004 Michael Soulier +- [1.15.0-16] +- Fixed migrate to report the caught error message. [msoulier MN00032503] + +* Thu May 6 2004 Michael Soulier +- [1.15.0-15] +- Added isValidHostname function to esmith::util::network. + [msoulier MN00024212] + +* Fri Feb 13 2004 Michael Soulier +- [1.15.0-14] +- Greatly simplified the _mysystem function by ripping out open3. + [msoulier dpar-20385] + +* Fri Feb 13 2004 Michael Soulier +- [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 +- [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 +- [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 +- [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 +- [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 +- [1.15.0-08] +- Fixed POD around merge_props. [msoulier 9482] + +* Fri Nov 7 2003 Tony Clayton +- [1.15.0-07] +- And again [tonyc 10569] + +* Fri Nov 7 2003 Tony Clayton +- [1.15.0-06] +- Change Merge API a bit, fix pod [tonyc 10569] + +* Fri Nov 7 2003 Tony Clayton +- [1.15.0-05] +- Add esmith::DB::Merge library [tonyc 10569] + +* Fri Oct 10 2003 Michael Soulier +- [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 +- [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 +- [1.15.0-02] +- Add generic_template_expand action. [charlieb 10035] + +* Thu Sep 18 2003 Charlie Brady +- [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) diff --git a/contriborbase b/contriborbase new file mode 100644 index 0000000..ef36a67 --- /dev/null +++ b/contriborbase @@ -0,0 +1 @@ +sme10 diff --git a/createlinks b/createlinks new file mode 100644 index 0000000..88e26d8 --- /dev/null +++ b/createlinks @@ -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"); +} diff --git a/e-smith-lib.spec b/e-smith-lib.spec new file mode 100644 index 0000000..7c6b2bd --- /dev/null +++ b/e-smith-lib.spec @@ -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 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 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 2.6.0-15.sme +- add support for service with instances [SME: 11723] + +* Mon Apr 19 2021 Jean-Philippe Pialasse 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 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 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 2.6.0-11.sme +- remove error when sending sighup event [SME: 11177] + +* Tue Nov 17 2020 Jean-Philipe Pialasse 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 2.6.0-9.sme +- add support for systemctl reload-or-restart, try-restart, enable -now [SME: 10848] + +* Wed Oct 25 2017 Daniel Berteaud 2.6.0-8.sme +- Revert prev change regarding tap_soft, as it's not needed [SME: 10445] + +* Mon Oct 23 2017 Daniel Berteaud 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 2.6.0-6.sme +- remove reference to smtpd in configuration.conf [SME: 9478] + +* Thu Aug 04 2016 Jean-Philipe Pialasse 2.6.0-5.sme +- fix console startup display [SME: 9352] + +* Sat Jul 23 2016 Jean-Philipe Pialasse 2.6.0-4.sme +- fix service name syslog to rsyslog [SME: 9691] + +* Mon Jul 18 2016 Jean-Philipe Pialasse 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 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 2.6.0-1.sme +- Initial release to sme10 + +* Tue Jan 12 2016 Daniel Berteaud 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 2.4.0-15.sme +- Added a password creation (set_secret) [SME: 8943] +- code from Charlie Brady + +* Sat Apr 5 2014 Ian Wells 2.4.0-14.sme +- Untaint the license filename [SME: 8305] +- Non-functional perl::Critic changes. + +* Sun Mar 16 2014 Ian Wells 2.4.0-13.sme +- Add textbox() to console.pm, getLicenseFile to util.pm [SME: 8264] + +* Sun Feb 2 2014 Ian Wells 2.4.0-12.sme +- Update frame header and footer [SME: 8183] + +* Sat Nov 30 2013 Daniel Berteaud 2.4.0-11.sme +- Remove the "swap interface" feature [SME: 7993] + +* Sat Nov 30 2013 Daniel Berteaud 2.4.0-10.sme +- Return nic names in probeAdapters so we can drop HWAddress [SME: 7991] + +* Sat May 25 2013 Ian Wells 2.4.0-9.sme +- Correctly display accented letters in the console [SME: 7591] + by Filippo Carletti + +* Sun May 05 2013 Ian Wells 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 2.4.0-7.sme +- Ensure group www exists before user [SME: 7319] + +* Wed Mar 6 2013 Shad L. Lords 2.4.0-6.sme +- Fix pre script to make www and apache the same [SME: 7319] + +* Tue Mar 5 2013 Daniel Berteaud 2.4.0-5.sme +- Untaint variable in probeAdapters() [SME: 7416] + +* Thu Feb 28 2013 Ian Wells 2.4.0-4.sme +- Improve error checking in isValidIP [SME: 7410] + +* Sun Feb 24 2013 Daniel Berteaud 2.4.0-3.sme +- Fix MAC detection for bond slaves [SME: 3596] + +* Thu Jan 31 2013 Daniel Berteaud 2.4.0-2.sme +- Stop using kudzu for NIC detection [SME: 3596] + +* Fri Jan 25 2013 Shad L. Lords 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 2.2.0-7.sme +- Serialize configure_peers to prevent errors [SME: 5831] + +* Fri Feb 5 2010 Stephen Noble 2.2.0-6.sme +- adds the hwaddr parameter to probeAdapters() [SME: 4528] + +* Thu Feb 4 2010 Shad L. Lords 2.2.0-5.sme +- Update path for 64-bit compatibility [SME: 5756] + +* Tue Dec 22 2009 Filippo Carletti 2.2.0-4.sme +- Really apply previous patch in the spec file. [SME: 5659] + +* Wed Dec 9 2009 Charlie Brady 2.2.0-3.sme +- Add patch (Federico Simoncelli) to prevent re-use of uids. [SME: 5659] + +* Mon Oct 13 2008 Shad L. Lords 2.2.0-2.sme +- Add patch to support multiple samba roles [SME: 4172] + +* Tue Oct 7 2008 Shad L. Lords 2.2.0-1.sme +- Roll new stream to separate sme7/sme8 trees [SME: 4633] + +* Wed Aug 20 2008 Shad L. Lords 1.19.0-1 +- Roll new dev stream. + +* Sat Aug 9 2008 Shad L. Lords 1.18.0-28 +- Read /dev/urandmon instead of /dev/random [SME: 4492] + +* Sat Aug 9 2008 Shad L. Lords 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 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 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 1.18.0-24 +- Gracefully handle encoding errors in navigation dbs [SME: 4147] + +* Wed Mar 26 2008 Shad L. Lords 1.18.0-23 +- Make PAM conv routine not look for english strings [SME: 4117] + +* Tue Mar 25 2008 Shad L. Lords 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 1.18.0-21 +- Output navigation in UTF-8 [SME: 3858] + +* Sun Jan 20 2008 Gavin Weight 1.18.0-20 +- Call smbpasswd -e - to reset user correctly. [SME: 3755] + +* Tue Jan 08 2008 Stephen Noble 1.18.0-19 +- modify validate password strong match for console [SME: 2173] + +* Thu Nov 01 2007 Gavin Weight 1.18.0-18 +- Fix I18N.pm file descriptor leak. [SME: 3509] + +* Wed Oct 31 2007 Charlie Brady 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 1.18.0-16 +- pam_unix requires passwords >= 6 [SME: 3039] + +* Mon May 21 2007 Shad L. Lords 1.18.0-15 +- Fix ip addr shift to work on 64-bit + +* Sun Apr 29 2007 Shad L. Lords +- Clean up spec so package can be built by koji/plague + +* Thu Apr 05 2007 Shad L. Lords 1.18.0-14 +- Reverse changes for 1.18.0-12 as it is being used. [SME: 2838] + +* Wed Apr 04 2007 Charlie Brady 1.18.0-13 +- Allow gauge console widget to be used without following message_page. + [SME: 2832]. + +* Mon Mar 26 2007 Charlie Brady 1.18.0-12 +- Remove undocumented and unused template metadata handling from + generic_template_expand action. [SME: 2798] + +* Mon Mar 26 2007 Charlie Brady 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 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 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 1.18.0-8 +- Add gauge widget to esmith::console. [SME: 2579] + +* Sun Feb 25 2007 Charlie Brady 1.18.0-7 +- Default infobox height to 8 rows, and allow override via params. + [SME: 2560] + +* Fri Feb 23 2007 Shad L. Lords 1.18.0-6 +- Really fix clear parameter for inputbox dialog screen [SME: 2533] + +* Fri Feb 23 2007 Shad L. Lords 1.18.0-5 +- Fix clear parameter for dialog screens [SME: 2533] + +* Thu Feb 22 2007 Charlie Brady 1.18.0-4 +- switch esmith::console::password_page() to use dialog rather than + whiptail. [SME: 2534] + +* Thu Feb 22 2007 Charlie Brady 1.18.0-3 +- Add infobox widget. [SME: 2533] + +* Sun Jan 28 2007 Shad L. Lords 1.18.0-2 +- Fix backtitle spacing for new dialog menus [SME: 2328] + +* Fri Jan 26 2007 Shad L. Lords 1.18.0-1 +- Roll stable stream. [SME: 2328] + +* Fri Dec 15 2006 Federico Simoncelli 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 +- Update to new release naming. No functional changes. +- Make Packager generic + +* Fri Nov 24 2006 Gordon Rowell 1.17.0-06 +- Allow optional path to peeers directory in + esmith::tcpsvd::configure_peers() [SME: 2086] + +* Tue Nov 14 2006 Charlie Brady 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 1.17.0-04 +- Allow display of "0" in iesmith::cgi::genSmallCell. [SME: 2038] + +* Mon Oct 23 2006 Charlie Brady 1.17.0-03 +- Make dialog the default console app, with whiptail used only when + required. + +* Wed Oct 11 2006 Charlie Brady 1.17.0-02 +- Allow 'dialog' to be called from esmith::console. [SME: 1958] + +* Wed Oct 11 2006 Charlie Brady 1.17.0-01 +- Roll development branch. + +* Mon Sep 25 2006 Charlie Brady 1.16.0-06 +- Fix problem with greedy RE in template.metadata parsing. [SME: 1906] + +* Fri Sep 08 2006 Charlie Brady 1.16.0-05 +- Fix taint problem in template.metadata handling. [SME: 1906] + +* Thu Apr 13 2006 Charlie Brady 1.16.0-04 +- Use "kudzu --probe --class network" for NIC detection. [SME: 727] + +* Fri Apr 7 2006 Gordon Rowell 1.16.0-03 +- Don't call smbpasswd -e - setting the password is sufficient [SME: 1193] + +* Tue Mar 28 2006 Gordon Rowell 1.16.0-02 +- Log previous contents of db entry in DELETE log [SME: 1066] + +* Tue Mar 14 2006 Charlie Brady 1.16.0-01 +- Roll to stable stream version number. [SME: 1016] + +* Fri Mar 10 2006 Charlie Brady 1.15.4-02 +- Suppress warning from genSmallCell if text is undefined. [SME: 986] + +* Fri Feb 17 2006 Gordon Rowell 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 1.15.3-42 +- Adjust console title bar to 'SME Server' [SME: 726] + +* Tue Feb 14 2006 Gordon Rowell 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 1.15.3-40 +- Update URL in default template-begin fragment. [SME: 773] + +* Sat Feb 11 2006 Charlie Brady 1.15.3-39 +- Remove obsolete e-smith-lib-Tai64n package. [SME: 689] + +* Sat Feb 11 2006 Charlie Brady 1.15.3-38 +- [Null changelog for missing version - we accidentally skipped + this version.] + +* Sat Feb 11 2006 Charlie Brady 1.15.3-37 +- Fix get_all_by_prop in scalar context. [SME: 669,721] + +* Mon Feb 6 2006 Shad L. Lords 1.15.3-37 +- Add ability to pass many props to get_all_by_prop [SME: 669] + +* Mon Jan 23 2006 Charlie Brady 1.15.3-36 +- Fix warning during pseudonym deletion. [SME: 491] + +* Fri Jan 20 2006 Charlie Brady 1.15.3-35 +- Fix up use of Sys::Syslog::syslog. [SME: 526] + +* Thu Jan 19 2006 Charlie Brady 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 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 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 1.15.3-31 +- And update POD for last change [SME: 24] + +* Mon Jan 9 2006 Gordon Rowell 1.15.3-30 +- Allow dot and underscore in account names [SME: 24] + +* Tue Dec 27 2005 Gordon Rowell 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 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 +- [1.15.3-27] +- Moved queueing logic to separate daemon, replaced with FIFO IPC [BZ252 + +* Thu Dec 01 2005 Mark Knox +- [1.15.3-26] +- Added event queueing (open source portion) for clustered systems [BZ250] + +* Wed Nov 30 2005 Gordon Rowell 1.15.3-25 +- Bump release number only + +* Thu Nov 24 2005 Gordon Rowell +- [1.15.3-24] +- Add missing 'use Locale::gettext' to esmith::console.pm [MN00108804] + +* Sun Nov 20 2005 Charlie Brady +- [1.15.3-23] +- Clarify logic for stopped services in adjust-services. [SF: 1357629] + +* Sun Nov 20 2005 Gordon Rowell +- [1.15.3-22] +- Correct adjust-services logic for stopped services [SF: 1357629] + +* Wed Nov 16 2005 Charlie Brady +- [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 +- [1.15.3-20] +- Also don't start services if we just want to "once" them. [SF: 1357629] + +* Wed Nov 16 2005 Charlie Brady +- [1.15.3-19] +- Fix restart of enabled supervised services which we are attempting to stop. + [SF: 1357629] + +* Tue Nov 15 2005 Charlie Brady +- [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 +- [1.15.3-17] +- Pass $EVENT to template expansions in generic_template_expand. + [SF: MN00106104] + +* Tue Nov 15 2005 Gordon Rowell +- [1.15.3-16] +- Redirect esmith::config calls on old db paths to the new + location [SF: 1335865] + +* Thu Oct 27 2005 Charlie Brady +- [1.15.3-15] +- Fix a few minor spec file portability issues. [SF: 1339729] + +* Wed Oct 26 2005 Charlie Brady +- [1.15.3-14] +- Add it and de to the langtag2locale fixups. [SF: 1338236] + +* Tue Oct 11 2005 Charlie Brady +- [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 +- [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 +- [1.15.3-11] +- Untaint db names before attempting to move them. [MN00098405] + +* Thu Sep 22 2005 Charlie Brady +- [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 +- [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 +- [1.15.3-08] +- Remove warning about explicit path in esmith::db::_db_path. + [SF: 1286294] + +* Fri Sep 9 2005 Charlie Brady +- [1.15.3-07] +- Tolerate, but warn about, symlinks in /home/e-smith. [SF: 1216546] + +* Fri Sep 9 2005 Charlie Brady +- [1.15.3-06] +- Reduce the noise from _file_path() in esmith::DB::db. [SF: 1286294] + +* Wed Sep 7 2005 Charlie Brady +- [1.15.3-05] +- Fix operation of expandTemplate when taint check is enabled. + [SF: 1284301] + +* Wed Aug 17 2005 Mark Knox +- [1.15.3-04] +- Added open_local and open_ro_local methods for clustering [markk MN00094831] + +* Tue Aug 16 2005 Charlie Brady +- [1.15.3-03] +- Fix POD error in util.pm. + +* Wed Jul 27 2005 Charlie Brady +- [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 +- [1.15.3-01] +- Roll a new development stream - 1.15.3 + +* Wed Jul 27 2005 Charlie Brady +- [1.15.2-04] +- Remove broken MergeDB stuff. [SF: 1246315] + +* Wed Jul 27 2005 Mark Knox +- [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 +- [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 +- [1.15.2-01] +- Roll new development stream - 1.15.2 + +* Fri Jul 15 2005 Mark Knox +- [1.15.1-44] +- Tweak to allow calling _writeconf from SOAP [markk MN00090738] + +* Tue Jun 21 2005 Charlie Brady +- [1.15.1-43] +- Ensure that esmith::util::LdapPassword returns bare string without + newline terminator. + +* Sun Jun 12 2005 Charlie Brady +- [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 +- [1.15.1-41] +- Provide feedback (via log messages) from services2adjust. [SF: 1218920] + +* Mon May 30 2005 Charlie Brady +- [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 +- [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 +- [1.15.1-38] +- Fix esmith::DB::get_prop_and_delete fail if prop is "false" [From Gordon]. + +* Tue May 3 2005 Charlie Brady +- [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 +- [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 +- [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 +- [1.15.1-34] +- Add missing "use esmith::util" in esmith::tcpsvd. + +* Wed Mar 16 2005 Charlie Brady +- [1.15.1-33] +- Add esmith::tcpsvd library for managing tcpsvd "peers" + directories. + +* Mon Mar 14 2005 Charlie Brady +- [1.15.1-32] +- Make template expansion message more succinct. + +* Thu Mar 10 2005 Charlie Brady +- [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 +- [1.15.1-30] +- Fix incompatibility with CentOS's CGI.pm. + +* Tue Feb 22 2005 Charlie Brady +- [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 +- [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 +- [1.15.1-27] +- Fix typo. [MN00066059] + +* Wed Feb 16 2005 Charlie Brady +- [1.15.1-26] +- Use /sbin/e-smith/whiptail if it is available. [MN00066059] + +* Mon Feb 7 2005 Charlie Brady +- [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 +- [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 +- [1.15.1-23] +- Really move /home/e-smith/* to e-smith-base. [MN00066635] + +* Fri Jan 28 2005 Charlie Brady +- [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 +- [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 +- [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 +- [1.15.1-19] +- Add adjust-services generic action script [MN00065576] + +* Tue Jan 18 2005 Charlie Brady +- [1.15.1-18] +- Fix typo. [MN00064412] +- Improve die() message in esmith::config::STORE. [MN00064394] + +* Mon Jan 17 2005 Charlie Brady +- [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 +- [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 +- [1.15.1-15] +- Change copyright date to 2004 [markk MN00060958] + +* Fri Nov 5 2004 Charlie Brady +- [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 +- [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 +- [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 +- [1.15.1-11] +- Updated esmith::ethernet's search paths for network drivers. + [msoulier MN00052510] + +* Mon Oct 4 2004 Charlie Brady +- [1.15.1-10] +- Remove dependency on perl(Filter::Handle) [charlieb MN00050075] + +* Fri Sep 24 2004 Charlie Brady +- [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 +- [1.15.1-08] +- Added esmith::util::network::isValidEmail function. [msoulier MN00023814] + +* Thu Aug 26 2004 Michael Soulier +- [1.15.1-07] +- Added svdisable to permissible actions in serviceControl. + [msoulier MN00043056] + +* Tue Aug 10 2004 Michael Soulier +- [1.15.1-06] +- Fixed new methods. Bad else case. [msoulier MN00044891] + +* Fri Aug 6 2004 Michael Soulier +- [1.15.1-05] +- Added a keys() method. [msoulier MN00041968] + +* Fri Aug 6 2004 Michael Soulier +- [1.15.1-04] +- Added set_prop and set_value methods in esmith::DB. [msoulier MN00044891] + +* Tue Jul 20 2004 Michael Soulier +- [1.15.1-03] +- Undeprecated esmith::util::serviceControl. [msoulier MN00043056] + +* Fri Jun 25 2004 Tony Clayton +- [1.15.1-02] +- Merge language_tag2locale() function from perl-I18N-LangTags [tonyc + MN00040170] + +* Fri May 28 2004 Michael Soulier +- [1.15.1-01] +- Rolling to collect patches. + +* Fri May 28 2004 Michael Soulier +- [1.15.0-23] +- Reordered the create code slightly to catch more errors. + [msoulier MN00035059] + +* Fri May 28 2004 Michael Soulier +- [1.15.0-22] +- Added yet more error handling and reporting. [msoulier MN00035059] + +* Fri May 28 2004 Michael Soulier +- [1.15.0-21] +- Fixed one $Error reference that I missed in the last rev. + [msoulier MN00035059] + +* Fri May 28 2004 Michael Soulier +- [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 +- [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 +- [1.15.0-18] +- Changed print statements to calls to the logger. [msoulier MN00035059] + +* Thu May 27 2004 Michael Soulier +- [1.15.0-17] +- Added print statements to initialize-default-databases for post-install + debugging. [msoulier MN00035059] + +* Fri May 7 2004 Michael Soulier +- [1.15.0-16] +- Fixed migrate to report the caught error message. [msoulier MN00032503] + +* Thu May 6 2004 Michael Soulier +- [1.15.0-15] +- Added isValidHostname function to esmith::util::network. + [msoulier MN00024212] + +* Fri Feb 13 2004 Michael Soulier +- [1.15.0-14] +- Greatly simplified the _mysystem function by ripping out open3. + [msoulier dpar-20385] + +* Fri Feb 13 2004 Michael Soulier +- [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 +- [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 +- [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 +- [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 +- [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 +- [1.15.0-08] +- Fixed POD around merge_props. [msoulier 9482] + +* Fri Nov 7 2003 Tony Clayton +- [1.15.0-07] +- And again [tonyc 10569] + +* Fri Nov 7 2003 Tony Clayton +- [1.15.0-06] +- Change Merge API a bit, fix pod [tonyc 10569] + +* Fri Nov 7 2003 Tony Clayton +- [1.15.0-05] +- Add esmith::DB::Merge library [tonyc 10569] + +* Fri Oct 10 2003 Michael Soulier +- [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 +- [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 +- [1.15.0-02] +- Add generic_template_expand action. [charlieb 10035] + +* Thu Sep 18 2003 Charlie Brady +- [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) diff --git a/root/etc/e-smith/db/configuration/migrate/00openRW b/root/etc/e-smith/db/configuration/migrate/00openRW new file mode 100644 index 0000000..2c2b16c --- /dev/null +++ b/root/etc/e-smith/db/configuration/migrate/00openRW @@ -0,0 +1,3 @@ +{ + $DB = esmith::ConfigDB->open(${DB_FILENAME}); +} diff --git a/root/etc/e-smith/events/actions/adjust-services b/root/etc/e-smith/events/actions/adjust-services new file mode 100755 index 0000000..74d3a5b --- /dev/null +++ b/root/etc/e-smith/events/actions/adjust-services @@ -0,0 +1,146 @@ +#!/usr/bin/perl -w +#---------------------------------------------------------------------- +# copyright (C) 2005 Mitel Networks Corporation +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +#---------------------------------------------------------------------- +package esmith; + +use strict; +use Errno; +use DirHandle; + +my $event = shift || die "must give event name parameter"; +chdir "/etc/e-smith/events/$event" or die "Couldn't chdir to event directory /etc/e-smith/events/$event: $!"; +my $dh = DirHandle->new("services2adjust"); + +exit(0) unless $dh; # Nothing to do + +use esmith::ConfigDB; +use esmith::util; + +my %param2char = ( + down => 'd', + stop => 'd', + up => 'u', + start => 'u', + restart => 't', + sigterm => 't', + adjust => 'h', + reload => 'h', + sighup => 'h', + sigusr1 => '1', + sigusr2 => '2', + once => 'o', + pause => 'p', + alarm => 'a', + interrupt => 'i', + quit => 'q', + kill => 'k', + exit => 'x', + ); + +sub adjust_supervised_service +{ + my ($s, @actions) = @_; + my $m = "control fifo for service $s: "; + unless (open(C, ">/service/$s/supervise/control")) + { + warn "Couldn't open $m$!"; + return; + } + foreach my $p (@actions) + { + my $c = $param2char{$p}; + unless ($c) + { + warn "Unrecognised param $p for service $s\n"; + next; + } + warn "adjusting supervised $s ($p)\n"; + unless (print C $c) + { + warn "Couldn't write to $m$!"; + return; + } + } + warn "Couldn't close $m$!" unless close(C); +} + +my $conf = esmith::ConfigDB->open_ro || die "Couldn't open config db"; + +foreach my $service (grep { !/^\./ } $dh->read()) +{ + my $s = $conf->get($service); + unless ($s) + { + warn "No conf db entry for service $service\n"; + next; + } + my $f = "services2adjust/$service"; + + my @actions; + if (-l "$f") + { + @actions = ( readlink "$f" ); + } + else + { + if (open(F, $f)) + { + # Read list of actions from the file, and untaint + @actions = map { chomp; /([a-z]+[12]?)/ ; $1 } ; + close(F); + } + else + { + warn "Could not open $f: $!"; + } + } + + # if service is supervised and not handled by systemd + if (-d "/service/$service" && glob("/etc/rc7.d/S??$service")) + { + my $enabled = ($s->prop('status') || 'disabled') eq 'enabled'; + adjust_supervised_service($service, + # stop the service if it is now disabled + $enabled ? () : 'down', + # Send the specified signal(s) to the running daemon + @actions, + # bring the service up if it is enabled (and we're not + # stopping it or running it once) + ($enabled && !grep { /^(down|stop|d|once|o)$/ } @actions) ? 'up' : (), + ); + } + # for service handled by former sysvinit or directly with systemd + else + { + my $enabled = ($s->prop('status') || 'disabled') eq 'enabled'; + # 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 => $_, + ); + } + } +} + diff --git a/root/etc/e-smith/events/actions/generic_template_expand b/root/etc/e-smith/events/actions/generic_template_expand new file mode 100644 index 0000000..c26cb94 --- /dev/null +++ b/root/etc/e-smith/events/actions/generic_template_expand @@ -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, + }); +} diff --git a/root/etc/e-smith/events/actions/initialize-default-databases b/root/etc/e-smith/events/actions/initialize-default-databases new file mode 100644 index 0000000..bac217d --- /dev/null +++ b/root/etc/e-smith/events/actions/initialize-default-databases @@ -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; +} diff --git a/root/etc/e-smith/events/e-smith-lib-update/.gitignore b/root/etc/e-smith/events/e-smith-lib-update/.gitignore new file mode 100644 index 0000000..e69de29 diff --git a/root/etc/e-smith/templates-default/template-begin b/root/etc/e-smith/templates-default/template-begin new file mode 100644 index 0000000..de41aee --- /dev/null +++ b/root/etc/e-smith/templates-default/template-begin @@ -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 +#------------------------------------------------------------ diff --git a/root/etc/e-smith/templates-default/template-begin-html b/root/etc/e-smith/templates-default/template-begin-html new file mode 100644 index 0000000..95a593c --- /dev/null +++ b/root/etc/e-smith/templates-default/template-begin-html @@ -0,0 +1,13 @@ +{ + $OUT = < +HERE + +} diff --git a/root/etc/e-smith/templates-default/template-begin-pam b/root/etc/e-smith/templates-default/template-begin-pam new file mode 100644 index 0000000..9d5a11a --- /dev/null +++ b/root/etc/e-smith/templates-default/template-begin-pam @@ -0,0 +1,8 @@ +{ + $OUT = < diff --git a/root/etc/e-smith/tests/10e-smith-lib/accounts.conf b/root/etc/e-smith/tests/10e-smith-lib/accounts.conf new file mode 100644 index 0000000..cb1f098 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/accounts.conf @@ -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 diff --git a/root/etc/e-smith/tests/10e-smith-lib/config.t b/root/etc/e-smith/tests/10e-smith-lib/config.t new file mode 100644 index 0000000..f176a4f --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/config.t @@ -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' ); +}; diff --git a/root/etc/e-smith/tests/10e-smith-lib/config_taint.t b/root/etc/e-smith/tests/10e-smith-lib/config_taint.t new file mode 100644 index 0000000..517df57 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/config_taint.t @@ -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' ); diff --git a/root/etc/e-smith/tests/10e-smith-lib/configuration.conf b/root/etc/e-smith/tests/10e-smith-lib/configuration.conf new file mode 100644 index 0000000..f19f7cb --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/configuration.conf @@ -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 diff --git a/root/etc/e-smith/tests/10e-smith-lib/db.t b/root/etc/e-smith/tests/10e-smith-lib/db.t new file mode 100644 index 0000000..7ecefdf --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/db.t @@ -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, <read, <read, <read, <read, <read, <read, <read, < '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') ); diff --git a/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/defaults/AccessType/type b/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/defaults/AccessType/type new file mode 100644 index 0000000..9977a28 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/defaults/AccessType/type @@ -0,0 +1 @@ +invalid diff --git a/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/defaults/bazbar/status b/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/defaults/bazbar/status new file mode 100644 index 0000000..86981e6 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/defaults/bazbar/status @@ -0,0 +1 @@ +enabled diff --git a/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/defaults/bazbar/type b/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/defaults/bazbar/type new file mode 100644 index 0000000..24e1098 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/defaults/bazbar/type @@ -0,0 +1 @@ +service diff --git a/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/force/foobar/status b/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/force/foobar/status new file mode 100644 index 0000000..86981e6 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/force/foobar/status @@ -0,0 +1 @@ +enabled diff --git a/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/migrate/10quux b/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/migrate/10quux new file mode 100644 index 0000000..1ab9bfd --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/migrate/10quux @@ -0,0 +1,4 @@ +{ + $DB = esmith::ConfigDB->open("${DB_FILENAME}"); +} + diff --git a/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/migrate/20quux b/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/migrate/20quux new file mode 100644 index 0000000..ae00823 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/db/configuration.conf.scratch/migrate/20quux @@ -0,0 +1,3 @@ +{ + $DB->new_record("quux", {type=>'service', status=>'enabled'}); +} diff --git a/root/etc/e-smith/tests/10e-smith-lib/db_dummy.conf b/root/etc/e-smith/tests/10e-smith-lib/db_dummy.conf new file mode 100644 index 0000000..d260848 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/db_dummy.conf @@ -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| diff --git a/root/etc/e-smith/tests/10e-smith-lib/default_migrate_force.t b/root/etc/e-smith/tests/10e-smith-lib/default_migrate_force.t new file mode 100644 index 0000000..fdb9a53 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/default_migrate_force.t @@ -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 = ); + 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); + } + } +} diff --git a/root/etc/e-smith/tests/10e-smith-lib/domains.conf b/root/etc/e-smith/tests/10e-smith-lib/domains.conf new file mode 100644 index 0000000..56203ef --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/domains.conf @@ -0,0 +1,3 @@ +test=domain|foo|bar +foo=domain|baz|quux +wombat=notadomain diff --git a/root/etc/e-smith/tests/10e-smith-lib/dummy.conf b/root/etc/e-smith/tests/10e-smith-lib/dummy.conf new file mode 100644 index 0000000..855edb0 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/dummy.conf @@ -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. diff --git a/root/etc/e-smith/tests/10e-smith-lib/etc/e-smith/locale/en-us/DUMMY b/root/etc/e-smith/tests/10e-smith-lib/etc/e-smith/locale/en-us/DUMMY new file mode 100644 index 0000000..e69de29 diff --git a/root/etc/e-smith/tests/10e-smith-lib/etc/e-smith/locale/es/DUMMY b/root/etc/e-smith/tests/10e-smith-lib/etc/e-smith/locale/es/DUMMY new file mode 100644 index 0000000..e69de29 diff --git a/root/etc/e-smith/tests/10e-smith-lib/etc/e-smith/locale/fr-ca/DUMMY b/root/etc/e-smith/tests/10e-smith-lib/etc/e-smith/locale/fr-ca/DUMMY new file mode 100644 index 0000000..e69de29 diff --git a/root/etc/e-smith/tests/10e-smith-lib/etc/e-smith/locale/jk/DUMMY b/root/etc/e-smith/tests/10e-smith-lib/etc/e-smith/locale/jk/DUMMY new file mode 100644 index 0000000..e69de29 diff --git a/root/etc/e-smith/tests/10e-smith-lib/etc/e-smith/locale/wx-yz/DUMMY b/root/etc/e-smith/tests/10e-smith-lib/etc/e-smith/locale/wx-yz/DUMMY new file mode 100644 index 0000000..e69de29 diff --git a/root/etc/e-smith/tests/10e-smith-lib/hosts.conf b/root/etc/e-smith/tests/10e-smith-lib/hosts.conf new file mode 100644 index 0000000..226f47d --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/hosts.conf @@ -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 diff --git a/root/etc/e-smith/tests/10e-smith-lib/licenses/en_US/00Supported b/root/etc/e-smith/tests/10e-smith-lib/licenses/en_US/00Supported new file mode 100644 index 0000000..e45be7a --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/licenses/en_US/00Supported @@ -0,0 +1 @@ +I am an English license. diff --git a/root/etc/e-smith/tests/10e-smith-lib/licenses/fr_CA/00Supported b/root/etc/e-smith/tests/10e-smith-lib/licenses/fr_CA/00Supported new file mode 100644 index 0000000..f77ae3f --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/licenses/fr_CA/00Supported @@ -0,0 +1 @@ +Je suis une license francais. Or something like that. diff --git a/root/etc/e-smith/tests/10e-smith-lib/networks.conf b/root/etc/e-smith/tests/10e-smith-lib/networks.conf new file mode 100644 index 0000000..1fec3f1 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/networks.conf @@ -0,0 +1 @@ +10.0.0.0=network|Mask|255.255.255.0|Router|default diff --git a/root/etc/e-smith/tests/10e-smith-lib/sysconfig-en_US.conf b/root/etc/e-smith/tests/10e-smith-lib/sysconfig-en_US.conf new file mode 100644 index 0000000..20506be --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/sysconfig-en_US.conf @@ -0,0 +1 @@ +sysconfig=configuration|KeyboardType|pc|Keytable|us|Language|en_US|ReleaseVersion|6.0alpha2 diff --git a/root/etc/e-smith/tests/10e-smith-lib/sysconfig-fr_CA.conf b/root/etc/e-smith/tests/10e-smith-lib/sysconfig-fr_CA.conf new file mode 100644 index 0000000..4105dc3 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/sysconfig-fr_CA.conf @@ -0,0 +1 @@ +sysconfig=configuration|KeyboardType|pc|Keytable|us|Language|fr_CA|ReleaseVersion|6.0alpha2 diff --git a/root/etc/e-smith/tests/10e-smith-lib/templates.t b/root/etc/e-smith/tests/10e-smith-lib/templates.t new file mode 100644 index 0000000..a2681cc --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/templates.t @@ -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 = ; } +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 + diff --git a/root/etc/e-smith/tests/10e-smith-lib/templates/10moof b/root/etc/e-smith/tests/10e-smith-lib/templates/10moof new file mode 100644 index 0000000..c9182fa --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/templates/10moof @@ -0,0 +1,20 @@ +{ + my $ksez = $Koala_Say; + my $line = '-' x length $ksez; + + $OUT = < + $line +KOALA_SEZ +} + \ + \ . + ___ // + \{~._.~\}// + ( Y )K/ + ()~*~() + (_)-(_) + Luke + Skywalker + koala diff --git a/root/etc/e-smith/tests/10e-smith-lib/templates/template-begin b/root/etc/e-smith/tests/10e-smith-lib/templates/template-begin new file mode 100644 index 0000000..dc8794c --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/templates/template-begin @@ -0,0 +1,3 @@ +# This is the beginning of the beginning +# { keys %$confref == 1 && exists $confref->{Koala_Say} + ? "confref ok" : "confref not ok" } diff --git a/root/etc/e-smith/tests/10e-smith-lib/templates/template-end b/root/etc/e-smith/tests/10e-smith-lib/templates/template-end new file mode 100644 index 0000000..74b2e47 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/templates/template-end @@ -0,0 +1 @@ +# This is the end, My only friend, the end of our elaborate templates, the end diff --git a/root/etc/e-smith/tests/10e-smith-lib/templates2/10moof b/root/etc/e-smith/tests/10e-smith-lib/templates2/10moof new file mode 100644 index 0000000..c9182fa --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/templates2/10moof @@ -0,0 +1,20 @@ +{ + my $ksez = $Koala_Say; + my $line = '-' x length $ksez; + + $OUT = < + $line +KOALA_SEZ +} + \ + \ . + ___ // + \{~._.~\}// + ( Y )K/ + ()~*~() + (_)-(_) + Luke + Skywalker + koala diff --git a/root/etc/e-smith/tests/10e-smith-lib/templates2/template-end b/root/etc/e-smith/tests/10e-smith-lib/templates2/template-end new file mode 100644 index 0000000..74b2e47 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/templates2/template-end @@ -0,0 +1 @@ +# This is the end, My only friend, the end of our elaborate templates, the end diff --git a/root/etc/e-smith/tests/10e-smith-lib/templates_DB/10DB b/root/etc/e-smith/tests/10e-smith-lib/templates_DB/10DB new file mode 100644 index 0000000..fd4c388 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/templates_DB/10DB @@ -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; +} diff --git a/root/etc/e-smith/tests/10e-smith-lib/templates_DB/20confref b/root/etc/e-smith/tests/10e-smith-lib/templates_DB/20confref new file mode 100644 index 0000000..9fd84d9 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/templates_DB/20confref @@ -0,0 +1,7 @@ + +{ if( *{confref}{SCALAR} ) { + "confref not defined"; + } else { + "confref defined" + } +} diff --git a/root/etc/e-smith/tests/10e-smith-lib/templates_DB/template-begin b/root/etc/e-smith/tests/10e-smith-lib/templates_DB/template-begin new file mode 100644 index 0000000..7d99969 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/templates_DB/template-begin @@ -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 + } + diff --git a/root/etc/e-smith/tests/10e-smith-lib/templates_DB/template-end b/root/etc/e-smith/tests/10e-smith-lib/templates_DB/template-end new file mode 100644 index 0000000..a248dbb --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/templates_DB/template-end @@ -0,0 +1,2 @@ + +The end of labor is to gain leisure. diff --git a/root/etc/e-smith/tests/10e-smith-lib/uidgid.conf b/root/etc/e-smith/tests/10e-smith-lib/uidgid.conf new file mode 100644 index 0000000..ace02b5 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/uidgid.conf @@ -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 diff --git a/root/etc/e-smith/tests/10e-smith-lib/uidgid.t b/root/etc/e-smith/tests/10e-smith-lib/uidgid.t new file mode 100644 index 0000000..5296849 --- /dev/null +++ b/root/etc/e-smith/tests/10e-smith-lib/uidgid.t @@ -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() +{ + 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; diff --git a/root/etc/e-smith/tests/10e-smith-lib/usr/share/locale/de/LC_MESSAGES/DUMMY b/root/etc/e-smith/tests/10e-smith-lib/usr/share/locale/de/LC_MESSAGES/DUMMY new file mode 100644 index 0000000..e69de29 diff --git a/root/etc/e-smith/tests/10e-smith-lib/usr/share/locale/en_US/LC_MESSAGES/server-console.po b/root/etc/e-smith/tests/10e-smith-lib/usr/share/locale/en_US/LC_MESSAGES/server-console.po new file mode 100644 index 0000000..e69de29 diff --git a/root/etc/e-smith/tests/10e-smith-lib/usr/share/locale/fr_CA/LC_MESSAGES/server-console.mo b/root/etc/e-smith/tests/10e-smith-lib/usr/share/locale/fr_CA/LC_MESSAGES/server-console.mo new file mode 100644 index 0000000..e69de29 diff --git a/root/etc/e-smith/tests/10e-smith-lib/usr/share/locale/wx_YZ/LC_MESSAGES/server-console.mo b/root/etc/e-smith/tests/10e-smith-lib/usr/share/locale/wx_YZ/LC_MESSAGES/server-console.mo new file mode 100644 index 0000000..e69de29 diff --git a/root/sbin/e-smith/config b/root/sbin/e-smith/config new file mode 100755 index 0000000..69dcd8d --- /dev/null +++ b/root/sbin/e-smith/config @@ -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"; diff --git a/root/sbin/e-smith/create-system-user b/root/sbin/e-smith/create-system-user new file mode 100644 index 0000000..3188951 --- /dev/null +++ b/root/sbin/e-smith/create-system-user @@ -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; diff --git a/root/sbin/e-smith/db b/root/sbin/e-smith/db new file mode 100644 index 0000000..dd2a628 --- /dev/null +++ b/root/sbin/e-smith/db @@ -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, $_); + } +} diff --git a/root/sbin/e-smith/expand-template b/root/sbin/e-smith/expand-template new file mode 100644 index 0000000..94d56ea --- /dev/null +++ b/root/sbin/e-smith/expand-template @@ -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); + diff --git a/root/sbin/e-smith/signal-event b/root/sbin/e-smith/signal-event new file mode 100644 index 0000000..84a3f50 --- /dev/null +++ b/root/sbin/e-smith/signal-event @@ -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); + diff --git a/root/usr/share/perl5/vendor_perl/esmith/AccountsDB.pm b/root/usr/share/perl5/vendor_perl/esmith/AccountsDB.pm new file mode 100644 index 0000000..55d4944 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/AccountsDB.pm @@ -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 + +See http://www.e-smith.org/ for more information + + + diff --git a/root/usr/share/perl5/vendor_perl/esmith/ConfigDB.pm b/root/usr/share/perl5/vendor_perl/esmith/ConfigDB.pm new file mode 100644 index 0000000..352c5ba --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/ConfigDB.pm @@ -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 + +=head1 SEE ALSO + +L, L, L, L, +L, L, L + +=cut + +1; diff --git a/root/usr/share/perl5/vendor_perl/esmith/ConfigDB/Record.pm b/root/usr/share/perl5/vendor_perl/esmith/ConfigDB/Record.pm new file mode 100644 index 0000000..bb98633 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/ConfigDB/Record.pm @@ -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 + +=item B + + 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, L + +=cut + +1; diff --git a/root/usr/share/perl5/vendor_perl/esmith/ConfigDB/UTF8.pm b/root/usr/share/perl5/vendor_perl/esmith/ConfigDB/UTF8.pm new file mode 100644 index 0000000..5d450af --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/ConfigDB/UTF8.pm @@ -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; + diff --git a/root/usr/share/perl5/vendor_perl/esmith/DB.pm b/root/usr/share/perl5/vendor_perl/esmith/DB.pm new file mode 100644 index 0000000..996c3a2 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/DB.pm @@ -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 + + 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 + + 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 + + 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 + + my $error = esmith::DB->error; + +Returns a string describing the error from the last failing method. + +=item I + + $db->reload; + +Flushes out the $db's cache (if there is one) and reloads all +configuration data from disk. + +=item I + + my $file = $db->file; + +File which this $db represents. + +=item I + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + $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 + + $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 + + 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//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 + +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//defaults + /etc/e-smith/db//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 "", (); + 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 + +=cut + +1; diff --git a/root/usr/share/perl5/vendor_perl/esmith/DB/Record.pm b/root/usr/share/perl5/vendor_perl/esmith/DB/Record.pm new file mode 100644 index 0000000..78ba065 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/DB/Record.pm @@ -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 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 + + my $key = $record->key; + +Returns the $key for this $record; + +=item B + + 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 + +=item B + + 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 + + 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 + + $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 + + $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 + + $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 + + 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 + +=cut + +1; diff --git a/root/usr/share/perl5/vendor_perl/esmith/DB/db.pm b/root/usr/share/perl5/vendor_perl/esmith/DB/db.pm new file mode 100644 index 0000000..634f5be --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/DB/db.pm @@ -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 + +=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 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 + +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 + +=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 + +=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 + +=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 + +=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 + +=for testing +is( $db->file, $Scratch_Conf, 'file()' ); + +=cut + +sub file +{ + my ($self) = shift; + return $self->{file}; +} + +=item B + +=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 + +=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 + +=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 + +=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 + +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 + +=head1 SEE ALSO + +L, L, L + +=cut + +1; diff --git a/root/usr/share/perl5/vendor_perl/esmith/DB/db/Record.pm b/root/usr/share/perl5/vendor_perl/esmith/DB/db/Record.pm new file mode 100644 index 0000000..a41b0e3 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/DB/db/Record.pm @@ -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 + +=for testing +is( $Squid->key, 'Squid', 'key()' ); + +=cut + +sub key { + my($self) = shift; + return $self->{key}; +} + +=item B + +=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 + +=item B + +=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 + +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 + +=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 + +=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 + +=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 + +=begin testing + +is( $Squid->show, < + +=cut + +1; diff --git a/root/usr/share/perl5/vendor_perl/esmith/DomainsDB.pm b/root/usr/share/perl5/vendor_perl/esmith/DomainsDB.pm new file mode 100644 index 0000000..4757ca0 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/DomainsDB.pm @@ -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 + +=head1 SEE ALSO + +L + +=cut + +1; diff --git a/root/usr/share/perl5/vendor_perl/esmith/HostsDB.pm b/root/usr/share/perl5/vendor_perl/esmith/HostsDB.pm new file mode 100644 index 0000000..b2a5ca2 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/HostsDB.pm @@ -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 + +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 + + 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 + + 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 + +=head1 SEE ALSO + +L + +=cut + +1; diff --git a/root/usr/share/perl5/vendor_perl/esmith/I18N.pm b/root/usr/share/perl5/vendor_perl/esmith/I18N.pm new file mode 100644 index 0000000..6f50b80 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/I18N.pm @@ -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 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; diff --git a/root/usr/share/perl5/vendor_perl/esmith/Logger.pm b/root/usr/share/perl5/vendor_perl/esmith/Logger.pm new file mode 100644 index 0000000..10144b6 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/Logger.pm @@ -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; diff --git a/root/usr/share/perl5/vendor_perl/esmith/NavigationDB.pm b/root/usr/share/perl5/vendor_perl/esmith/NavigationDB.pm new file mode 100644 index 0000000..baaaeaf --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/NavigationDB.pm @@ -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; + diff --git a/root/usr/share/perl5/vendor_perl/esmith/NetworksDB.pm b/root/usr/share/perl5/vendor_perl/esmith/NetworksDB.pm new file mode 100644 index 0000000..a509428 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/NetworksDB.pm @@ -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 is C, 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 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 + +=head1 SEE ALSO + +L + +L + +=cut + +1; diff --git a/root/usr/share/perl5/vendor_perl/esmith/cgi.pm b/root/usr/share/perl5/vendor_perl/esmith/cgi.pm new file mode 100644 index 0000000..79c0d33 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/cgi.pm @@ -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 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;istart_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}
" . + "Copyright 1999-2006 Mitel Networks Corporation, Copyright (C) ____COPYYEARS____ Koozali Foundation, Inc..
" . + "All rights reserved.") + ); + + print ''; + 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 cell +"header" : creates 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 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 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 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 + diff --git a/root/usr/share/perl5/vendor_perl/esmith/config.pm b/root/usr/share/perl5/vendor_perl/esmith/config.pm new file mode 100644 index 0000000..42aa647 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/config.pm @@ -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 + +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 = ) + { + 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 <{$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 as it will change in the future. + +=head1 AUTHOR + +SME Server Developers + +For more information, see http://www.e-smith.org/ + +=head1 SEE ALSO + +esmith::db + +=cut + +1; diff --git a/root/usr/share/perl5/vendor_perl/esmith/config/utf8.pm b/root/usr/share/perl5/vendor_perl/esmith/config/utf8.pm new file mode 100644 index 0000000..8eeec6a --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/config/utf8.pm @@ -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; + diff --git a/root/usr/share/perl5/vendor_perl/esmith/console.pm b/root/usr/share/perl5/vendor_perl/esmith/console.pm new file mode 100755 index 0000000..ad39919 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/console.pm @@ -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 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 = ; + 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 + +=cut + +1; diff --git a/root/usr/share/perl5/vendor_perl/esmith/db.pm b/root/usr/share/perl5/vendor_perl/esmith/db.pm new file mode 100644 index 0000000..f9a737e --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/db.pm @@ -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 + + 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. Please use a subclass of +esmith::DB::db instead, such as esmith::AccountsDB or esmith::ConfigDB. + +I. 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 + + 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 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 + + 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 the +type! But it unescapes newlines. I. + +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(\%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 + + 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 + + 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 + + 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 + + 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(\%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(\%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(\%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(\%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(\%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 + + 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 + + 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 + + $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 + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +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(/(? + + 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; diff --git a/root/usr/share/perl5/vendor_perl/esmith/ethernet.pm b/root/usr/share/perl5/vendor_perl/esmith/ethernet.pm new file mode 100644 index 0000000..00a0ee3 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/ethernet.pm @@ -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 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("", ); + 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 = ; + 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 + +For more information see http://www.e-smith.org/ + +=cut + diff --git a/root/usr/share/perl5/vendor_perl/esmith/event.pm b/root/usr/share/perl5/vendor_perl/esmith/event.pm new file mode 100644 index 0000000..adf3b50 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/event.pm @@ -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 = ; + 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 = ) + { + 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 = ; + 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; diff --git a/root/usr/share/perl5/vendor_perl/esmith/lockfile.pm b/root/usr/share/perl5/vendor_perl/esmith/lockfile.pm new file mode 100644 index 0000000..d73617c --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/lockfile.pm @@ -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; diff --git a/root/usr/share/perl5/vendor_perl/esmith/logrotate.pm b/root/usr/share/perl5/vendor_perl/esmith/logrotate.pm new file mode 100644 index 0000000..017d082 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/logrotate.pm @@ -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; diff --git a/root/usr/share/perl5/vendor_perl/esmith/tcpsvd.pm b/root/usr/share/perl5/vendor_perl/esmith/tcpsvd.pm new file mode 100644 index 0000000..47b2244 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/tcpsvd.pm @@ -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; diff --git a/root/usr/share/perl5/vendor_perl/esmith/templates.pm b/root/usr/share/perl5/vendor_perl/esmith/templates.pm new file mode 100644 index 0000000..5784745 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/templates.pm @@ -0,0 +1,1091 @@ +#---------------------------------------------------------------------- +# Copyright 1999-2007 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::templates; + +use strict; +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(processTemplate); +our @EXPORT_OK = qw(removeBlankLines); + +use Text::Template 'fill_in_file'; +use Errno; +use esmith::config; +use esmith::db; +use vars '$TEMPLATE_COUNT'; + +use Carp; +use File::Basename; +use File::stat; +use FileHandle; +use DirHandle; + +$TEMPLATE_COUNT = 0; + +=for testing +use_ok('esmith::templates'); + + +=head1 NAME + +esmith::template - Utilities for e-smith server and gateway development + +=head1 VERSION + +This file documents C version B<1.7.0> + +=head1 SYNOPSIS + + use esmith::template; + processTemplate(...); + +=head1 DESCRIPTION + +This is the interface to the E-Smith templating system. For an +overview of how the system works, see section "3.4 Templated +Configuration System" of the Dev Guide. + +esmith::template exports a single function, processTemplate, which, as +you might guess, processes sets of templates into a single output +file. + +=head2 Template Variables + +The following variables are available to all templates. + +=over 4 + +=item B<$confref> + +B. Contains a reference to the hash passed in via +CONFREF. If none was given it defaults to a tied esmith::config hash. + +=item B<$DB> + +Contains a reference to an esmith::ConfigDB object pointing at the +default configurations. This is to be used to call methods like +C<$DB->services> and *not* for alterting the database. + +=back + +In addition, each record in the default esmith configuration database +(configuration) is available as a hash if it has +multiple properties (where each key/value is a property of the record) +or if it has a single property (type) then it given as a scalar. + +So you can say: + + { $DomainName } # $configdb->get('DomainName')->value; + { $sshd{status} } # $configdb->get('sshd')->prop('status') + +Finally, variables from additional databases are usually gotten +via the esmith::DB->as_hash feature. + + { require esmith::HostsDB; + my %Hosts = esmith::HostsDB->as_hash; + ... + } + + +=head2 Functions + +=over 4 + +=item B + + processTemplate({ CONFREF => \%config, + TEMPLATE_PATH => $output_file + }); + + $filled_in_template = processTemplate({ CONFREF => \%config, + TEMPLATE_PATH => $output_file + OUTPUT_TYPE => 'string' + }); + +processTemplate() expands a set of templates based on the keys/values +in %config. + +The options to processTemplate are as follows... + +=over 4 + +=begin deprecated + +=item ALL_RECORDS_AS_SCALARS + +For backwards compatibility purposes, the expand-template script needs +I keys to be scalars, whether they have multiple properties or +not. If this variable is true all the variables pulled in from +esmith::ConfigDB->open will be scalars in addition to hashes. + +This is B to be used by expand-template. + +=end deprecated + +=item MORE_DATA + +A hash ref containing additional variables you'd like to put into the +template. Key is the name of the variable, value is it's value. + + # $Foo = 'bar' + MORE_DATA => { Foo => "bar" } + +Any keys in MORE_DATA will override those from the default +esmith::ConfigDB. + +This replaces I. + +=item CONFREF + +B. A reference to the hash which will become the +variables in the template. So $config{Foo} becomes $Foo. In +addition, there is the $confref variable which contains a reference +back to the original CONFREF. + +This is usually a tied esmith::config hash. + +This has been replaced by MORE_DATA and cannot be used in conjunction. + +=begin testing + +use esmith::HostsDB; +eval { + processTemplate({ CONFREF => { foo => "bar" }, + MORE_DATA => { something => 'other' }, + }); +}; +like( $@, qr/^ERROR: Can't use CONFREF with MORE_DATA/ ); + +=end testing + +=item TEMPLATE_PATH + +Full path to the file which fill result from this template. For +example, '/etc/hosts'. + +=item TEMPLATE_EXPAND_QUEUE + +List of directories to scan for templates. If not specified it +defaults to: + + /etc/e-smith/templates-custom + /etc/e-smith/templates + +it then appends the TEMPLATE_PATH to this, so the resulting search +might be: + + /etc/e-smith/templates-custom/etc/host + /etc/e-smith/templates/etc/host + +All templates found are combined in ASCIIbetical order to produce the +final file. The exception to this is template-begin, which always +comes first, and template-end, which always comes last. + +If no template-begin is found the one in +/etc/e-smith/templates-default/ will be used. + +If two directories contain the same template those eariler in the +queue will override those later. So /etc/e-smith/templates-custom/foo +will be used instead of /etc/e-smith/templates/foo. + +=item OUTPUT_PREFIX + +Directory which contains the OUTPUT_FILENAME. + +=item OUTPUT_FILENAME + +The file which results from this template. + +Defaults to the TEMPLATE_PATH. + +=item FILTER + +A code ref through which each line of the resulting text is fed, for +example: + + FILTER => sub { "# $_[0]" } + +would put a # in front of each line of the template. + + FILTER => sub { $_[0] =~ /^\s*$/ ? '' : $_[0] } + +will remove all lines that contain only whitespace. + +=item UID + +=item GID + +The user and group ID by which the resulting file should be owned. +This obviously means you have to run procTemplate as root. + +Defaults to UID 0 and GID 0. + +=item PERMS + +File permissions which the resulting file should be set to have. + +Defaults to 0644. + +=item OUTPUT_TYPE + +Determines if the filled in template should go straight to a file or +be returned by processTemplate(). The values can be: + + string return the filled in template + file write it to disk + +Defaults to 'file' + +=back + +For example we have a template F +that we want to expand to F using the normal +configuration. + + # Records from esmith::ConfigDB->open will be available by default + processTemplate({ + TEMPLATE_PATH => '/etc/hosts', + }); + +Example 2: we have a template F +that we want to expand to F + +Solution: + + processTemplate({ + TEMPLATE_PATH => '/qmail', + TEMPLATE_EXPAND_QUEUE => [ + '/etc/e-smith/templates-user-custom', + '/etc/e-smith/templates-user', + ], + OUTPUT_PREFIX => '/home/e-smith/files/users/$username', + OUTPUT_FILENAME => '.qmail', + FILTER => sub { $_[0] =~ /^\s*$/ ? '' : $_[0] }, + UID => $username, + GID => $username, + PERMS => 0644, + }); + +Example 3: we have a template fragment +F +that needs to iterate through the given list of VirtualHosts, +process each template and return the results in a string until all the +VirtualHosts have been completed. The results will be expanded +into the F file. + +Solution: In the 80VirtualHosts fragment, we use the OUTPUT_TYPE='string' +option to return the output of processTemplate for each VirtualHost as a +string, and then we add the results to the $OUT variable for inclusion in the +httpd.conf template expansion. We store the VirtualHosts template in +F for clarity and namespace +separation. + + foreach my $ipAddress (keys %ipAddresses) + { + # the $OUT variable stores the output of this template fragment + use esmith::templates; + $OUT .= processTemplate ( + { + MORE_DATA => { ipAddress => $ipAddress, port => $port, + virtualHosts => \@virtualHosts, + virtualHostContent => \%virtualHostContent }, + TEMPLATE_PATH => "/etc/httpd/conf/httpd.conf/VirtualHosts", + OUTPUT_TYPE => 'string', + }); + } + + +=cut + +sub processTemplate { + + ###################################### + # set the default values to use if not + # specified in parameters + # every valid parameter should have a default + ###################################### + + my %defaults = ( + MORE_DATA => {}, + ALL_RECORDS_AS_SCALARS => 1, + CONFREF => undef, + TEMPLATE_PATH => '', # replaces FILE_PATH + OUTPUT_FILENAME => '', # replaces FILE_PATH_LIST + TEMPLATE_EXPAND_QUEUE => + [ '/etc/e-smith/templates-custom', '/etc/e-smith/templates', ], + OUTPUT_PREFIX => '', # replaces TARGET + FILTER => undef, + UID => 0, + GID => 0, + PERMS => 0644, + OUTPUT_TYPE => 'file', # [file|string] + DELETE => 0, + ); + + # store the valid output types so we can do a quick sanity check + my @valid_output_types = ( 'file', 'string' ); + + my $conf_or_params_ref = shift; + my $path = shift; + my %params_hash; + if ( defined $path ) { + + # This is the old syntax, so we just grab the the two or maybe + # three parameters ... + %params_hash = ( + CONFREF => $conf_or_params_ref, + TEMPLATE_PATH => $path, + ); + if ( my $source = shift ) { + $params_hash{'TEMPLATE_EXPAND_QUEUE'} = [$source]; + } + } + else { + %params_hash = %$conf_or_params_ref; + } + + # Read additional metadata assocated with the templated file + my $metadata_path = "/etc/e-smith/templates.metadata/$params_hash{TEMPLATE_PATH}"; + if (open(FILE, $metadata_path)) + { + while () + { + /^([^=]+)=(.*)$/; + $params_hash{$1} = eval $2; + } + close(FILE); + } + if (my $d = DirHandle->new($metadata_path)) + { + while ($_ = $d->read) + { + # skip any directories, including . and .. + next if -d "$metadata_path/$_"; + # Untaint filename + /(\w+)/; my $file = $1; + unless (open(FILE, "$metadata_path/$file")) + { + warn("Could not open metadata file $metadata_path/$file: $!"); + next; + } + # Read and untaint content of file + $params_hash{$file} = eval do { local $/; $_ = ; /(.*)/s ; "{ $1 }" }; + close(FILE); + } + } + + # warn on deprecated or unknown parameters + foreach my $key ( keys %params_hash ) { + unless ( exists $defaults{$key} ) { + carp "WARNING: Unknown parameter '$key' " + . "passed to processTemplate\n"; + } + } + + # Check for illegal combinations of variables. + if ( exists $params_hash{CONFREF} && exists $params_hash{MORE_DATA}) { + carp "ERROR: Can't use CONFREF with MORE_DATA in processTemplate\n"; + return; + } + + ### merge incoming parameters with the defaults + # -this is backwards compatible with the old positional + # parameters $confref, $filename, and $source + my %p = ( %defaults, %params_hash ); + + # set OUTPUT_FILENAME to TEMPLATE_PATH if it wasn't explicitly set + unless ( $p{'OUTPUT_FILENAME'} ) { + + # if OUTPUT_FILENAME exists, it holds an array of target filenames + $p{'OUTPUT_FILENAME'} = $p{'TEMPLATE_PATH'}; + } + + unless ( exists $p{'TEMPLATE_PATH'} ) { + carp "ERROR: TEMPLATE_PATH parameter missing in processTemplate\n"; + return; + } + + my $template_path = $p{'TEMPLATE_PATH'}; + my $outputfile = $p{'OUTPUT_PREFIX'} . '/' . $p{'OUTPUT_FILENAME'}; + my $tempfile = "$outputfile.$$"; + + # sanity check on OUTPUT_TYPE + unless ( grep( $p{'OUTPUT_TYPE'}, @valid_output_types ) ) { + carp + "ERROR: Invalid OUTPUT_TYPE parameter passed to processTemplate\n"; + return; + } + + # If OUTPUT_TYPE=file and FILTER is off, then $fh is the output filehandle. + # If OUTPUT_TYPE=file and FILTER is on, then $ofh is the real output + # filehandle, and $fh is a temporary file for the pre-filtered output. + my $fh; + my $ofh; + + # if OUTPUT_TYPE=string, then $text is the output string + my $text; + + if ( $p{'OUTPUT_TYPE'} eq 'file' ) { + ########################################################## + # open the target file before servicing the template queue + ########################################################## + + if ( -d "$outputfile" ) { + carp "ERROR: Could not expand $outputfile template " + . "- it is a directory\n"; + return; + } + + # delete the file and do no more if we're told to by metadata + if ($p{'DELETE'}) + { + unlink "$outputfile"; + return; + } + + # use POSIX::open to set permissions on create + require POSIX; + my $fd = + POSIX::open( $tempfile, + &POSIX::O_CREAT | &POSIX::O_WRONLY | &POSIX::O_TRUNC, 0600); + unless ($fd) + { + carp "ERROR: Cannot create output file " . "$tempfile $!\n"; + return; + } + + # create a filehandle reference to the newly opened file + $fh = new FileHandle; + unless ($fh->fdopen( $fd, "w" )) + { + carp "ERROR: Cannot open output file " . "$tempfile: $!\n"; + return; + } + + if ( defined $p{FILTER} ) { + + # We have a filter to apply to the output. So we write the output + # into an anonymous file, to prepare it for postprocessing + require IO::File; + + $ofh = $fh; + $fh = IO::File->new_tmpfile; + } + + } + + # Construct a hash containing mapping each template fragment + # to its path. Subsequent mappings of the same fragment + # override the previous fragment (ie: merge new fragments + # and override existing fragments) + # use queue to store template source directories in order + my @template_queue = @{ $p{'TEMPLATE_EXPAND_QUEUE'} }; + + # use a hash to store template fragments + my %template_hash = _merge_templates( $template_path, @template_queue ); + + # if template hash is empty produce an error + unless ( keys %template_hash ) { + unlink $tempfile; + carp "ERROR: No templates were found for $template_path.\n"; + return; + } + + ##################################################### + # Process the template fragments and build the target + ##################################################### + + # create unique package namespace for this template + # namespace is used by all template fragments + $TEMPLATE_COUNT++; + my $pkg = "esmith::__TEMPLATE__::${TEMPLATE_COUNT}"; + + # Setup the template variables. + my $tmpl_vars = _init_tmpl_vars( \%p ); + + my $errorCount = 0; + my $warningCount = 0; + my $debug_template_expansion = + ( $$tmpl_vars[0]{processTemplate}{Debug} || 'no' ) eq 'yes'; + + # expand the template fragments into the target file + foreach my $key ( sort _template_order keys %template_hash ) { + my $filepath = $template_hash{$key}; + + # Text::Template doesn't like zero length files so skip them + unless ( -s $filepath ) { next } + + $debug_template_expansion + && print "DEBUG: Expanding template fragment $filepath\n"; + + local $SIG{__WARN__} = sub { + $warningCount++; + print STDERR "WARNING in $filepath: $_[0]"; + }; + + { + + # prime the package namespace + # use statements will only be run once per template + # XXX DEPRECATED! + eval " + package $pkg; + use esmith::db; + use esmith::util; + "; + + # Arcane Text::Template error passing. Don't ask. + my $broken = sub { + my %args = @_; + ( my $error = $args{error} ) =~ s/\n+\z//; + my $text = $args{text}; + my $lineno = $args{lineno}; + $errorCount++; + print STDERR "ERROR in $filepath: " + . "Program fragment delivered error <<$error>>" + . " at template line $lineno\n"; + return ""; + }; + + # process the templates + if ( $p{'OUTPUT_TYPE'} eq 'file' ) { + unless (fill_in_file( + "$filepath", + HASH => $tmpl_vars, + PACKAGE => $pkg, + BROKEN => $broken, + UNTAINT => 1, + OUTPUT => \*$fh + )) + { + carp "ERROR: Cannot process template $filepath: $Text::Template::ERROR\n"; + return; + } + } + elsif ( $p{'OUTPUT_TYPE'} eq 'string' ) { + my $ltext; + unless ($ltext = fill_in_file( + "$filepath", + HASH => $tmpl_vars, + BROKEN => $broken, + UNTAINT => 1, + PACKAGE => $pkg + )) + { + carp "ERROR: Cannot process template $filepath: $Text::Template::ERROR\n"; + return; + } + $text .= $ltext; + } + } + } + + ################################################################# + # Check for errors, and abort template processing if any occurred + ################################################################# + if ($errorCount) { + if ( $p{'OUTPUT_TYPE'} eq 'file' ) { + close $fh; + unlink $tempfile; + } + + my $msg = "Template processing failed for $outputfile:"; + + if ($warningCount) { + $msg .= " $warningCount fragment"; + $msg .= "s" if $warningCount != 1; + $msg .= " generated warnings,"; + } + + $msg .= " $errorCount fragment"; + $msg .= "s" if $errorCount != 1; + $msg .= " generated errors"; + carp "ERROR: $msg\n"; + return; + } + elsif ($warningCount) { + my $msg = "Template processing succeeded for $outputfile:"; + $msg .= " $warningCount fragment"; + $msg .= "s" if $warningCount != 1; + $msg .= " generated warnings"; + carp "WARNING: $msg\n"; + } + + ############################################################## + # Apply filters to the output, and do any necessary clean-up. + ############################################################## + + if ( $p{'OUTPUT_TYPE'} eq 'file' ) { + if ( defined $p{FILTER} ) { + _filter_fh( $fh, $ofh, $p{FILTER} ); + } + + # This should close the file descripter AND file handle + close $fh; + + # make filename point to new inode + # NOTE: this is not an atomic operation, so on a non-journaling + # filesystem it is possible that the template could become corrupt + + my $perms = $p{'PERMS'}; + $perms = oct($perms) if $perms =~ /^0/; + + # error checking and conversions for uid + my $uid = $p{'UID'}; + if ( $uid =~ /^\d+$/ ) { + unless ( defined getpwuid $uid ) { + carp "WARNING: Invalid user: ${uid}, " + . "defaulting to 'root' user (0).\n"; + $uid = 0; + } + } + else { + my $uname = $uid; + $uid = getpwnam $uid; + unless ( defined $uid ) { + carp "WARNING: Invalid user: ${uname}, " + . "defaulting to 'root' user (0).\n"; + $uid = 0; + } + } + + # error checking and conversions for gid + my $gid = $p{'GID'}; + if ( $gid =~ /^\d+$/ ) { + unless ( defined getgrgid $gid ) { + carp "WARNING: Invalid group: ${gid}, " + . "defaulting to 'root' group (0).\n"; + $gid = 0; + } + } + else { + my $gname = $gid; + $gid = getgrnam $gid; + unless ( defined $gid ) { + carp "WARNING: Invalid group: ${gname}, " + . "defaulting to 'root' group (0).\n"; + $gid = 0; + } + } + + # now do chown on our new target + chown( $uid, $gid, $tempfile ) + || carp "ERROR: Can't chown file $tempfile: $!\n"; + + # Now do chmod as well - POSIX::open does not change permissions + # of a preexisting file + chmod( $perms, $tempfile ) + || carp "ERROR: Can't chmod file $tempfile: $!\n"; + + unless ( -f $outputfile ) { + rename( "$tempfile", "$outputfile" ) + or carp( + "ERROR: Could not rename $tempfile " . "to $outputfile: $!\n" ); + return; + } + + use Digest::MD5; + + open( NEW, "$tempfile" ); + my $newMD5sum = Digest::MD5->new->addfile(*NEW)->hexdigest; + close NEW; + + open( OLD, "$outputfile" ); + my $oldMD5sum = Digest::MD5->new->addfile(*OLD)->hexdigest; + close OLD; + + if ( $oldMD5sum eq $newMD5sum ) { + $debug_template_expansion + && warn("Not updating $outputfile - unchanged\n"); + unlink "$tempfile"; + + # now do chown and chmod the file, to ensure permissions are correct + chown( $uid, $gid, $outputfile ) + || carp "ERROR: Can't chown file $tempfile: $!\n"; + chmod( $perms, $outputfile ) + || carp "ERROR: Can't chmod file $tempfile: $!\n"; + } + else { + $debug_template_expansion + && warn( + "Updating $outputfile - MD5 was $oldMD5sum, now $newMD5sum\n"); + + rename( "$tempfile", "$outputfile" ) + or carp( + "ERROR: Could not rename $tempfile " . "to $outputfile: $!\n" ); + } + + # copy any additional files + + # A side effect of this routine is that it removes any old copies or + # proposed new copies that RPM leaves lying around. (i.e. F<.rpmsave> + # and F<.rpmnew> files. + -e "$outputfile.rpmsave" and unlink "$outputfile.rpmsave"; + -e "$outputfile.rpmnew" and unlink "$outputfile.rpmnew"; + } + elsif ( $p{'OUTPUT_TYPE'} eq 'string' ) { + if ( defined $p{FILTER} ) { + $text = _filter_text( $text, $p{FILTER} ); + } + return $text; + } +} + +=begin _private + +=item _init_tmpl_vars + + my $template_vars = _init_tmpl_vars(\%params); + +Given the %params to processTemplate (after being adjusted for +defaults) it will generate a ref suitable for passing into +Text::Template->fill_in(HASH) to generate variables in the template. + +=end _private + +=begin testing + +use esmith::TestUtils qw(scratch_copy); + +my $scratch = scratch_copy('10e-smith-lib/configuration.conf'); +$ENV{ESMITH_CONFIG_DB} = $scratch; +use esmith::ConfigDB; +my $db = esmith::ConfigDB->open; +my @recs = $db->get_all; + +my $vars = esmith::templates::_init_tmpl_vars({}); +is( keys %{$vars->[0]}, grep($_->props > 1, @recs), + ' multi-prop ConfigDBs are hashes'); +is( keys %{$vars->[1]}, grep($_->props <= 1, @recs), + ' single-prop are scalars'); +is( keys %{$vars->[2]}, 2, ' confref' ); +isa_ok( $vars->[2]{DB}, 'REF', ' objects must be scalar refs for T::T' ); +isa_ok( ${$vars->[2]{DB}}, 'esmith::ConfigDB' ); +is( keys %{$vars->[3]}, 0, ' no MORE_DATA' ); + + +$vars = esmith::templates::_init_tmpl_vars({ CONFREF => { foo => 42, + bar => 23, + } }); +is( keys %{$vars->[0]}, grep($_->props > 1, @recs), + ' multi-prop ConfigDBs are hashes'); +is( keys %{$vars->[1]}, grep($_->props <= 1, @recs), + ' single-prop are scalars'); +is( keys %{$vars->[2]}, 2, ' confref' ); +is_deeply( ${$vars->[2]{confref}}, { foo => 42, bar => 23 } ); +is( keys %{$vars->[3]}, 2, ' MORE_DATA' ); +is( $vars->[3]{foo}, 42 ); +is( $vars->[3]{bar}, 23 ); + + +$vars = esmith::templates::_init_tmpl_vars({ MORE_DATA => { foo => 42, + bar => 23, + } }); +is( keys %{$vars->[0]}, grep($_->props > 1, @recs), + ' multi-prop ConfigDBs are hashes'); +is( keys %{$vars->[1]}, grep($_->props <= 1, @recs), + ' single-prop are scalars'); +is( keys %{$vars->[2]}, 2, ' confref' ); +is( keys %{$vars->[3]}, 2, ' MORE_DATA' ); +is( $vars->[3]{foo}, 42 ); +is( $vars->[3]{bar}, 23 ); + +my $h_scratch = scratch_copy('10e-smith-lib/hosts.conf'); +my $a_scratch = scratch_copy('10e-smith-lib/accounts.conf'); +my $c_scratch = scratch_copy('10e-smith-lib/configuration.conf'); +$ENV{ESMITH_CONFIG_DB} = $c_scratch; + +$vars = esmith::templates::_init_tmpl_vars(); + +ok( ref ${ $vars->[2]{confref} } eq 'HASH', 'confref is HASH ref' ); + + +=end testing + +=cut + +sub _init_tmpl_vars { + my ($p) = shift; + + my @tmpl_vars = (); + + # Start with the default set of ConfigDB vars + require esmith::ConfigDB; + my $conf_db = esmith::ConfigDB->open; + + foreach my $rec ( $conf_db->get_all ) { + my $key = $rec->key; + my %props = $rec->props; + + # Setup the hash + $tmpl_vars[0]{$key} = \%props if keys %props > 1; + + # Setup the scalar + if ( + $p->{ALL_RECORDS_AS_SCALARS} + || ( keys %props <= 1 + && exists $props{type} ) + ) + { + $tmpl_vars[1]{$key} = $conf_db->{config}{$key}; + } + } + + # Add $confref and $DB + $tmpl_vars[2]{confref} = + $p->{CONFREF} + ? \$p->{CONFREF} + : \$conf_db->{config}; + $tmpl_vars[2]{DB} = \$conf_db; + + # And any additional data + my $more_data = $p->{CONFREF} || $p->{MORE_DATA}; + while ( my ( $var, $val ) = each %{$more_data} ) { + $tmpl_vars[3]{$var} = $val; + } + + return \@tmpl_vars; +} + +# for applying filters to an output filehandle +sub _filter_fh { + my ( $ifh, $ofh, $filter ) = @_; + + # OK, we have a filter function to apply to the output + # So we rewind the anonymous output file, and read its contents + # then squirt it out into the named output file + $ifh->flush; + seek $ifh, 0, 0; + + while (<$ifh>) { + print $ofh + join '', map { $filter->("$_\n") } split ( /\n/, $_ ); + } + close $ifh; + $ofh->flush; +} + +# for applying filters to a text string returns the filtered text +# string +sub _filter_text { + my ( $text, $filter ) = @_; + + # We have a filter function to apply to the output text + return join '', map { $filter->("$_\n") } split ( /\n/, $text ); +} + +=begin testing + +my %expect = ( + 'templates/template-begin' => + '10e-smith-lib/templates/template-begin', + 'templates/10moof' => + '10e-smith-lib/templates/10moof', + 'templates/template-end' => + '10e-smith-lib/templates/template-end', + ); + +my %templates = esmith::templates::_merge_templates('templates', + '10e-smith-lib'); +is_deeply( \%templates, \%expect, '_merge_templates' ); + +%expect = ( + 'templates2/template-begin' => + '/etc/e-smith/templates-default/template-begin', + 'templates2/10moof' => + '10e-smith-lib/templates2/10moof', + 'templates2/template-end' => + '10e-smith-lib/templates2/template-end', + ); + +%templates = esmith::templates::_merge_templates('templates2', + '10e-smith-lib'); +is_deeply( \%templates, \%expect, '_merge_templates() + template-begin' ); + +%templates = esmith::templates::_merge_templates('templates3', + '10e-smith-lib'); +is( keys %templates, 0 ); + +# Bug 3110. +%templates = esmith::templates::_merge_templates('templates.t', + '10e-smith-lib'); + +%expect = ( + 'templates.t' => '10e-smith-lib/templates.t' +); +is_deeply( \%templates, \%expect, 'single file TEMPLATE_PATH' ); + + +%templates = esmith::templates::_merge_templates('10moof', + '10e-smith-lib/templates2', + '10e-smith-lib/templates', + ); + +%expect = ( + '10moof' => '10e-smith-lib/templates2/10moof' +); +is_deeply( \%templates, \%expect, 'single file TEMPLATE_PATH' ); + +=end testing + +=cut + +# the subroutine that does all the template merging +sub _merge_templates { + my %templates = (); + my $filename = shift; + my @template_queue = @_; + my $saw_dir = 0; + + foreach my $source ( reverse @template_queue ) { + my $tmpl_path = "$source/$filename"; + + # if template is a flat template file overwrite the hash + if ( -f $tmpl_path ) { + %templates = ( $filename => $tmpl_path ); + } + + # otherwise, merge new fragments with the hash + elsif ( -d $tmpl_path ) { + $saw_dir = 1; + + delete $templates{"$filename"}; + + # if dir exists but can't be opened then we have a problem + opendir( DIR, $tmpl_path ) + || carp "Can't open template source directory:" + . " $tmpl_path - skipping." && next; + + # fill the hash with template fragments + while ( defined( my $file = readdir(DIR) ) ) { + next if ( $file =~ /^\.{1,2}$/ ); + + # Skip over files left over by rpm from upgrade + # and other temp files etc. + if ( $file =~ /(~|\.(swp|orig|rpmsave|rpmnew|rpmorig))$/o ) { + carp "Skipping $tmpl_path/$file"; + next; + } + + if ( -f "$tmpl_path/$file" ) { + # Untaint filename, else Text::Template will complain + $file =~ /(.*)/; + $templates{"$filename/$file"} = "$tmpl_path/$1"; + } + elsif ( -d "$tmpl_path/$file" ) { + + # silently ignore sub-directories + next; + } + } + closedir(DIR); + } + else { + next; + } + } + + # If a directory template is active, and there is no + # template-default file, add a default one + if ( $saw_dir && keys %templates ) { + $templates{"${filename}/template-begin"} ||= + '/etc/e-smith/templates-default/template-begin'; + } + + return %templates; +} + +=begin _private + +=item I<_template_order> + + my $cmp = _template_order; + +Compares $a and $b returns -1, 0 or 1 if $template_file1 is less than, +equalto or greater than $template_file2. + +Intended to be used as a sort function. +C + +Templates are ordered in ASCIIbetical order excepting that +template-begin always goes at the front and template-end at the end. + +=end _private + +=begin testing + +use POSIX ':locale_h'; +use locale; +setlocale(LC_ALL, "en_US"); +$esmith::templates::a = '10Ahhh'; +$esmith::templates::b = '10ahhh'; +is( esmith::templates::_template_order(), -1 ); + +=end testing + +=cut + +# sort subroutine for use by 'sort' function to order template fragments +sub _template_order { + + # so templates are always sorted ASCIIbetically, strictly speaking + # this is unnecessary as "use locale" is lexical. + no locale; + + my $file_a = basename($a); + my $file_b = basename($b); + + return -1 if $file_a eq "template-begin" || $file_b eq "template-end"; + return 1 if $file_a eq "template-end" || $file_b eq "template-begin"; + return $file_a cmp $file_b; +} + +=head2 Filters + +Filters are an experimental feature which allow you to filter the output +of a template in various ways. + +Filtering functions take a single line at a time and return the +filtered version. + +=over 4 + +=item removeBlankLines + +Removes empty lines or those containing only whitespace from a +template. + +=begin testing + +use esmith::templates qw(removeBlankLines); +is( removeBlankLines(" "), '', 'removeBlankLines whitespace' ); +is( removeBlankLines("\t"), '', ' tabs' ); +is( removeBlankLines("\n"), '', ' newlines' ); +is( removeBlankLines(""), '', ' empty' ); +is( removeBlankLines(" a "), ' a ', ' not empty' ); + +=end testing + +=cut + +sub removeBlankLines { + $_[0] =~ /^\s*$/ ? '' : $_[0]; +} + +=head1 SEE ALSO + +Section 3.4 "Templated Configuration System" of the E-Smith Dev Guide + +=head1 AUTHOR + +Mitel Networks Corporation + +For more information, see http://www.e-smith.org/ + +=cut + +1; diff --git a/root/usr/share/perl5/vendor_perl/esmith/util.pm b/root/usr/share/perl5/vendor_perl/esmith/util.pm new file mode 100644 index 0000000..4032906 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/util.pm @@ -0,0 +1,1413 @@ +#---------------------------------------------------------------------- +# Copyright 1999-2003 Mitel Networks Corporation +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +#---------------------------------------------------------------------- + +package esmith::util; + +use strict; + +use Text::Template 'fill_in_file'; +use POSIX qw (setsid); +use Errno; +use Carp; +use esmith::config; +use esmith::db; +use esmith::DB; +use esmith::ConfigDB; +use Net::IPv4Addr qw(:all); +use Taint::Util; +use File::Basename; +use File::stat; +use FileHandle; +use Data::UUID; +=pod + +=head1 NAME + +esmith::util - Utilities for e-smith server and gateway development + +=head1 VERSION + +This file documents C version B<1.4.0> + +=head1 SYNOPSIS + + use esmith::util; + +=head1 DESCRIPTION + +This module provides general utilities of use to developers of the +e-smith server and gateway. + +=head1 GENERAL UTILITIES + +=head2 setRealToEffective() + +Sets the real UID to the effective UID and the real GID to the effective +GID. + +=begin testing + +use_ok('esmith::util'); + +=end testing + +=cut + +sub setRealToEffective () +{ + $< = $>; + $( = $); +} + +=pod + +=head2 processTemplate({ CONFREF => $conf, TEMPLATE_PATH => $path }) + +B interface to esmith::templates::processTemplate(). + +=cut + +sub processTemplate +{ + require esmith::templates; + goto &esmith::templates::processTemplate; +} + +#------------------------------------------------------------ + +=pod + +=head2 chownfile($user, $group, $file) + +This routine changes the ownership of a file, automatically converting +usernames and groupnames to UIDs and GIDs respectively. + +=cut + +sub chownFile ($$$) +{ + my ( $user, $group, $file ) = @_; + + unless ( -e $file ) + { + warn("can't chownFile $file: $!\n"); + return; + } + my $uid = defined $user ? getpwnam($user) : stat($file)->uid; + my $gid = defined $group ? getgrnam($group) : stat($file)->gid; + + chown( $uid, $gid, $file ); +} + +=pod + +=head2 determineRelease() + +Returns the current release version of the software. + +=cut + +sub determineRelease() +{ + my $unknown = "(unknown version)"; + + my $db = esmith::ConfigDB->open() or return $unknown; + + my $sysconfig = $db->get("sysconfig") or return $unknown; + + my $release = $sysconfig->prop("ReleaseVersion") || $unknown; + + return $release; +} + +=pod + +=head1 NETWORK ADDRESS TRANSLATION UTILITIES + +=head2 IPquadToAddr($ip) + +Convert IP address from "xxx.xxx.xxx.xxx" notation to a 32-bit +integer. + +=cut + +sub IPquadToAddr ($) +{ + my ($quad) = @_; + return 0 unless defined $quad; + if ( $quad =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ ) + { + return ( $1 << 24 ) + ( $2 << 16 ) + ( $3 << 8 ) + $4; + } + return 0; +} + +=pod + +=head2 IPaddrToQuad($address) + +Convert IP address from a 32-bit integer to "xxx.xxx.xxx.xxx" +notation. + +=cut + +sub IPaddrToQuad ($) +{ + my ($addrBits) = @_; + return sprintf( "%d.%d.%d.%d", + ( $addrBits >> 24 ) & 0xff, + ( $addrBits >> 16 ) & 0xff, + ( $addrBits >> 8 ) & 0xff, + $addrBits & 0xff ); +} + +=pod + +=head2 IPaddrToBackwardQuad($address) + +Convert IP address from a 32-bit integer to reversed +"xxx.xxx.xxx.xxx.in-addr.arpa" notation for BIND files. + +=cut + +sub IPaddrToBackwardQuad ($) +{ + my ($addrBits) = @_; + return sprintf( + "%d.%d.%d.%d.in-addr.arpa.", + $addrBits & 0xff, + ( $addrBits >> 8 ) & 0xff, + ( $addrBits >> 16 ) & 0xff, + ( $addrBits >> 24 ) & 0xff + ); +} + +=pod + +=head2 computeNetworkAndBroadcast($ipaddr, $netmask) + +Given an IP address and netmask (both in "xxx.xxx.xxx.xxx" format) +compute the network and broadcast addresses and output them in the +same format. + +=cut + +sub computeNetworkAndBroadcast ($$) +{ + my ( $ipaddr, $netmask ) = @_; + + my ( $network, $msk ) = ipv4_network( $ipaddr, $netmask ); + my $broadcast = ipv4_broadcast( $ipaddr, $netmask ); + + return ( $network, $broadcast ); +} + +=pod + +=head2 computeLocalNetworkPrefix($ipaddr, $netmask) + +Given an IP address and netmask, the computeLocalNetworkPrefix +function computes the network prefix for local machines. + +i.e. for an IP address of 192.168.8.4 and netmask of 255.255.255.0, +this function will return "192.168.8.". + +This string is suitable for use in configuration files (such as +/etc/proftpd.conf) when the more precise notation + + xxx.xxx.xxx.xxx/yyy.yyy.yyy.yyy + +is not supported. + +=cut + +sub computeLocalNetworkPrefix ($$) +{ + my ( $ipaddr, $netmask ) = @_; + + my ( $net, $msk ) = ipv4_network( $ipaddr, $netmask ); + $net =~ s/(\d{1,3}\.\d{1,3}\.\d{1,3}\.)(\d{1,3})/$1/; + + return $net; +} + +=pod + +=head2 computeAllLocalNetworkPrefixes ($ipaddress, $netmask) + + Given an IP address and netmask, the computeAllLocalNetworkPrefixes + function computes the network prefix or list of prefixes that + fully describe the network to which the IP address belongs. + + examples: + + - for an IP address of 192.168.8.4 and netmask of 255.255.255.0, + will return an array with a first (and only) element of "192.168.8". + + - for an IP address of 192.168.8.4 and netmask of 255.255.254.0, + will return the array [ '192.168.8', '192.168.9' ]. + + This array is suitable for use in configuration of tools such as + djbdns where other network notations are not supported. + +=begin testing + +is_deeply( + [esmith::util::computeAllLocalNetworkPrefixes("192.168.8.4", + "255.255.254.0")], + ['192.168.8', '192.168.9' ], + "/23 network" + ); + +is_deeply( + [esmith::util::computeAllLocalNetworkPrefixes("192.168.8.4", + "255.255.255.255")], + ['192.168.8.4'], + "/32 network" + ); + +is_deeply( + [esmith::util::computeAllLocalNetworkPrefixes("192.168.8.4", + "255.255.255.0")], + ['192.168.8'], + "/24 network" + ); + +=end testing + +=cut + +sub computeAllLocalNetworkPrefixes +{ + my ( $ipaddr, $netmask ) = @_; + + my $ipaddrBits = IPquadToAddr($ipaddr); + my $netmaskBits = IPquadToAddr($netmask); + my $networkBits = $ipaddrBits & $netmaskBits; + + # first, calculate the prefix (/??) given the netmask + my $len = 0; + for ( my $bits = $netmaskBits ; $bits & 0xFFFFFFFF ; $bits <<= 1 ) + { + $len++; + } + + # Here's where the magic starts... + # + # next, calculate the number of networks we expect to generate and + # the incrementing value for each network. + my $number_of_nets = 1 << ( ( 32 - $len ) % 8 ); + my $one_net = 1 << ( 3 - ( int $len / 8 ) ) * 8; + my @networks; + while ( $number_of_nets-- ) + { + my $network = IPaddrToQuad($networkBits); + + # we want to strip off the trailing ``.0'' for /24 or larger networks + if ( $len <= 24 ) + { + $network =~ s/\.0$//; + } + + # we want to continue to strip off trailing ``.0'', one more for + # /9 to /16, two more for /1 to /8 + $network =~ s/\.0$// if ( $len <= 16 ); + $network =~ s/\.0$// if ( $len <= 8 ); + + # push the resulting network into an array that we'll return; + push @networks, $network; + + # increment the network by ``one'', relative to the size of networks + # we're dealing with + $networkBits += $one_net; + } + return (@networks); +} + +=pod + +=head2 computeLocalNetworkShortSpec($ipaddr, $netmask) + +Given an IP address and netmask, the computeLocalNetworkShortSpec +function computes a valid xxx.xxx.xxx.xxx/yyy specifier where yyy +is the number of bits specifying the network. + +i.e. for an IP address of 192.168.8.4 and netmask of 255.255.255.0, +this function will return "192.168.8.0/24". + +This string is suitable for use in configuration files (such as +/etc/proftpd.conf) when the more precise notation + + xxx.xxx.xxx.xxx/yyy.yyy.yyy.yyy + +is not supported. + +=cut + +sub computeLocalNetworkShortSpec ($$) +{ + my ( $ipaddr, $netmask ) = @_; + my ( $net, $mask ) = ipv4_network( $ipaddr, $netmask ); + return "$net/$mask"; +} + +=pod + +=head2 computeLocalNetworkSpec($ipaddr, $netmask) + +Given an IP address and netmask, the computeLocalNetworkSpec function +computes a valid xxx.xxx.xxx.xxx/yyy.yyy.yyy.yyy specifier. + +=cut + +sub computeLocalNetworkSpec ($$) +{ + my ( $ipaddr, $netmask ) = @_; + my ( $net, $mask ) = ipv4_network( $ipaddr, $netmask ); + $mask = ipv4_cidr2msk($mask); + return "$net/$mask"; +} + +=pod + +=head2 computeNetmaskFromBits ($bits) + +Given a number of bits of network address, calculate the appropriate +netmask. + +=cut + +sub computeNetmaskFromBits ($) +{ + my ($ones) = @_; + + return ipv4_cidr2msk($ones); +} + +=pod + +=head2 computeLocalNetworkReversed($ipaddr, $netmask) + +Given an IP address and netmask, the computeLocalNetworkReversed +function computes the appropriate DNS domain field. + +NOTE: The return value is aligned to the next available byte boundary, i.e. + + 192.168.8.4/255.255.255.0 returns "8.168.192.in-addr.arpa." + 192.168.8.4/255.255.252.0 returns "168.192.in-addr.arpa." + 192.168.8.4/255.255.0.0 returns "168.192.in-addr.arpa." + 192.168.8.4/255.252.0.0 returns "192.in-addr.arpa." + 192.168.8.4/255.0.0.0 returns "192.in-addr.arpa." + +This string is suitable for use in BIND configuration files. + +=cut + +sub computeLocalNetworkReversed ($$) +{ + my ( $ipaddr, $netmask ) = @_; + + my @addressBytes = split ( /\./, $ipaddr ); + my @maskBytes = split ( /\./, $netmask ); + + my @result; + + push ( @result, "in-addr.arpa." ); + + foreach (@maskBytes) + { + last unless ( $_ eq "255" ); + + unshift ( @result, shift (@addressBytes) ); + } + + return join ( '.', @result ); +} + +=pod + +=head2 computeHostRange($ipaddr, $netmask) + +Given a network specification (IP address and netmask), compute +the total number of hosts in that network, as well as the first +and last IP addresses in the range. + +=cut + +sub computeHostRange ($$) +{ + my ( $ipaddr, $netmask ) = @_; + + my $ipaddrBits = IPquadToAddr($ipaddr); + my $netmaskBits = IPquadToAddr($netmask); + my $hostmaskBits = ( ( ~$netmaskBits ) & 0xffffffff ); + + my $firstAddrBits = $ipaddrBits & $netmaskBits; + my $lastAddrBits = $ipaddrBits | $hostmaskBits; + + my $totalHosts = 1; + + for ( ; $hostmaskBits ; $hostmaskBits /= 2 ) + { + if ( ( $hostmaskBits & 0x1 ) == 0x1 ) + { + $totalHosts *= 2; + } + } + + return ( $totalHosts, IPaddrToQuad($firstAddrBits), + IPaddrToQuad($lastAddrBits) ); +} + +=pod + +=head2 ldapBase($domain) + +Given a domain name such as foo.bar.com, generate the +LDAP base name "dc=foo,dc=bar,dc=com". + +=cut + +sub ldapBase ($) +{ + my ($domainName) = @_; + $domainName =~ s/\./,dc=/g; + return "dc=" . $domainName; +} + +=pod + +=head2 backgroundCommand($delaySec, @command) + +Run command in background after a specified delay. + +=cut + +sub backgroundCommand ($@) +{ + my ( $delaySec, @command ) = @_; + + # now would be a good time to flush output buffers, so the partial + # buffers don't get copied + + $| = 1; + print ""; + + # create child process + my $pid = fork; + + # if fork failed, bail out + die "Cannot fork: $!" unless defined($pid); + + # If fork succeeded, make parent process return immediately. + # We are not waiting on the child, so it will become a zombie + # process when it completes. However, this subroutine is only + # intended for use by the e-smith signal-event program, which + # doesn't run very long. Once the parent terminates, the zombie + # will become owned by "init" and will be reaped automatically. + + return if ($pid); + + # detach ourselves from the terminal + setsid || die "Cannot start a new session: $!"; + + # change working directory + chdir "/"; + + # clear file creation mask + umask 0; + + # close STDIN, STDOUT, and STDERR + close STDIN; + close STDOUT; + close STDERR; + + # reopen stderr, stdout, stdin + open( STDIN, '/dev/null' ); + + my $loggerPid = open( STDOUT, "|-" ); + die "Can't fork: $!\n" unless defined $loggerPid; + + unless ($loggerPid) + { + exec qw(/usr/bin/logger -p local1.info -t e-smith-bg); + } + + open( STDERR, '>&STDOUT' ); + + # make child wait for specified delay. + sleep $delaySec; + + # execute command + exec { $command[0] } @command or warn "Can't @command : $!\n"; +} + +=pod + +=head1 PASSWORD UTILITIES + +Low-level password-changing utilities. These utilities each +change passwords for a single underlying password database, +for example /etc/passwd, /etc/samba/smbpasswd, etc. + +=head2 validatePassword($password, $strength) + +Validate Unix password. + +=cut + +sub validatePassword($$) +{ + my ( $password, $strength ) = @_; + use Crypt::Cracklib; + + $strength ||= 'normal'; + + my $reason = 'ok'; + $reason = 'it is too short' unless (length($password) > 6); + return $reason if ($reason ne 'ok' || $strength eq 'none'); + + $reason = 'it does not contain numbers' if (not $password =~ /\d/); + $reason = 'it does not contain uppercase characters' if (not $password =~ /[A-Z]/); + $reason = 'it does not contain lowercase characters' if (not $password =~ /[a-z]/); + $reason = 'it does not contain special characters' if (not $password =~ /\W|_/); + return $reason if ($reason ne 'ok' && $strength eq 'strong'); + + if ( -f '/usr/lib64/cracklib_dict.pwd' ) { + $reason = fascist_check($password, '/usr/lib64/cracklib_dict'); + } else { + $reason = fascist_check($password, '/usr/lib/cracklib_dict'); + } + $reason ||= 'the password check failed'; + + return 'ok' if (lc($reason) eq 'ok'); + return $reason; +} + +=pod + +=head2 setUnixPassword($username, $password) + +Set Unix password + +=cut + +sub setUnixPassword($$) +{ + my ( $username, $password ) = @_; + setUnixPasswordRequirePrevious( $username, undef, $password ); +} + +=pod + +=head2 authenticateUnixPassword ($username, $password) + +Check if the given username/password pair is correct. +Return 1 if they are correct, return 0 otherwise. + +=cut + +sub authenticateUnixPassword ($$) +{ + my ( $username, $password ) = @_; + + my $pam_auth_func = sub { + return ( PAM_SUCCESS(), $password, PAM_SUCCESS() ); + }; + my $pamh = new Authen::PAM( 'passwd', $username, $pam_auth_func ); + + unless ( ref($pamh) ) + { + warn "WARN: Couldn't open Authen::PAM handle for user $username"; + return 0; + } + my $res = $pamh->pam_authenticate(); + return ( $res == PAM_SUCCESS() ) || 0; +} + +=pod + +=head2 setUnixPasswordRequirePrevious($username, $oldpassword, $newpassword) + +Set Unix password but require previous password for authentication. + +=cut + +# setUnixPasswordRequirePrevious is left as an exercise for the reader :-) +sub setUnixPasswordRequirePrevious ($$$) +{ + my ( $username, $oldpassword, $newpassword ) = @_; + use Authen::PAM; + my $state; + + my $my_conv_func = sub { + my @res; + while (@_) + { + my $code = shift; + my $msg = shift; + my $ans = ""; + + $ans = $username if ( $code == PAM_PROMPT_ECHO_ON() ); + if ( $code == PAM_PROMPT_ECHO_OFF() ) + { + if ( $< == 0 || $state >= 1 ) + { + # are we asked for a new password + $ans = $newpassword; + } + else + { + # asked for old password before we can set a new one. + $ans = $oldpassword; + } + $state++; + } + + #print("code is $code, ans is $ans, msg is $msg, state is $state\n"); + push @res, ( PAM_SUCCESS(), $ans ); + } + push @res, PAM_SUCCESS(); + return @res; + }; + + my $pamh = new Authen::PAM( "passwd", $username, $my_conv_func ); + unless ( ref($pamh) ) + { + warn "Autopasswd: error code $pamh during PAM init!"; + warn "Failed to set Unix password for account $username.\n"; + return 0; + } + + # Require the old password to be correct before proceeding to set a new + # one. + # This does that, except if you're already root, such as from the + # bootstrap-console + $state = 0; + unless ( $< == 0 or $pamh->pam_authenticate == 0 ) + { + warn +"PAM authentication failed for user \"$username\", old password invalid!\n"; + return 0; + } + + $state = 0; + my $res = $pamh->pam_chauthtok; + unless ( $res == PAM_SUCCESS() ) + { + my $err = $pamh->pam_strerror($res); + warn "Failed to set Unix password for account $username: $err\n"; + return 0; + } + return 1; # success +} + +=pod + +=head2 setSambaPassword($username, $password) + +Set Samba password + +=cut + +sub setSambaPassword ($$) +{ + my ( $username, $password ) = @_; + + #---------------------------------------- + # then set the password + #---------------------------------------- + + my $smbPasswdProg = '/usr/bin/smbpasswd'; + + # see perldoc perlipc (search for 'Safe Pipe Opens') + my $pid = open( DISCARD, "|-" ); + + if ($pid) # parent + { + print DISCARD "$password\n$password\n"; + close(DISCARD) || die "Child exited early."; + } + else # child + { + my $retval = system("$smbPasswdProg -a -s $username >/dev/null"); + ( $retval / 256 ) + && die "Failed to set Samba password for account $username.\n"; + exit 0; + } + # Now we enable the account + return system("$smbPasswdProg -e $username >/dev/null") ? 0 : 1; +} + +=pod + +=head2 cancelSambaPassword($username) + +Cancel Samba password + +=cut + +sub cancelSambaPassword ($) +{ + my ($username) = @_; + + #---------------------------------------- + # Gordon Rowell June 7, 2000 + # We really should maintain old users, which would mean we can just use + # smbpasswd -d, but the current policy is to remove them. If we are + # doing that (see below), there is no need to disable them first. + #---------------------------------------- + # my $discard = `/usr/bin/smbpasswd -d -s $username`; + # if ($? != 0) + # { + # die "Failed to disable Samba account $username.\n"; + # } + + #---------------------------------------- + # Delete the smbpasswd entry. If we don't, re-adding the same + # username will result in a mismatch of UIDs between /etc/passwd + # and /etc/smbpasswd + #---------------------------------------- + # Michael Brader June 2, 2000 + # We have a locking problem here. + # If two copies of this are run at once you could see your entry reappear + # Proposed solution (file locking): + + # If we do a 'use Fcntl, we'll probably get the locking constants + # defined, but for now: + + # NB. hard to test + + my $LOCK_EX = 2; + my $LOCK_UN = 8; + + my $smbPasswdFile = '/etc/samba/smbpasswd'; + + open( RDWR, "+<$smbPasswdFile" ) || # +< == fopen(path, "r+",... + die "Cannot open file $smbPasswdFile: $!\n"; + + my $nolock = 1; + my $attempts; + for ( $attempts = 1 ; ( $attempts <= 5 && $nolock ) ; $attempts++ ) + { + if ( flock( RDWR, $LOCK_EX ) ) + { + $nolock = 0; + } + else + { + sleep $attempts; + } + } + + $nolock && die "Could not get exclusive lock on $smbPasswdFile\n"; + + my $outputString = ''; + while () + { + (/^$username:/) || ( $outputString .= $_ ); + } + + # clear file and go to beginning + truncate( RDWR, 0 ) || die "truncate failed"; # not 'strict' safe why??? + seek( RDWR, 0, 0 ) || die "seek failed"; + print RDWR $outputString; + flock( RDWR, $LOCK_UN ) + || warn "Couldn't remove exclusive lock on $smbPasswdFile\n"; + close RDWR || die "close failed"; + + chmod 0600, $smbPasswdFile; + + return 1; # success +} + +=pod + +=head2 LdapPassword() + +Returns the LDAP password from the file C. +If the file does not exist, a suitable password is created, stored +in the file, then returned to the caller. + +Returns undef if the password could not be generated/retrieved. + +=cut + +sub genLdapPassword () +{ + + # Otherwise generate a suitable new password, store it in the + # correct file, and return it to the caller. + + use MIME::Base64 qw(encode_base64); + + unless ( open( RANDOM, "/dev/urandom" ) ) + { + warn "Could not open /dev/urandom: $!"; + return undef; + } + + my $buf = "not set"; + + # 57 bytes is a full line of Base64 coding, and contains + # 456 bits of randomness - given a perfectly random /dev/urandom + if ( read( RANDOM, $buf, 57 ) != 57 ) + { + warn("Short read from /dev/urandom: $!"); + return undef; + } + close RANDOM; + + my $umask = umask 0077; + my $password = encode_base64($buf, ""); + + unless ( open( WR, ">/etc/openldap/ldap.pw" ) ) + { + warn "Could not write LDAP password file.\n"; + return undef; + } + + print WR "$password\n"; + close WR; + umask $umask; + + chmod 0600, "/etc/openldap/ldap.pw"; + + return $password; +} + +sub LdapPassword () +{ + + # Read the password from the file /etc/openldap/ldap.pw if it + # exists. + if ( -f "/etc/openldap/ldap.pw" ) + { + open( LDAPPW, "; + chomp $password; + close LDAPPW; + return $password; + } + else + { + return genLdapPassword(); + } +} + +=pod + +=head2 set_secret() + +Shortcut method to create and set a password property on a record without having to extract the record first. + +The password creation is based on an UID of 64 bits (Data::UUID). If the optional type option is passed, +it will be used to create the record if it does not already exist. Otherwise, a default 'service' type +will be used to create the record. + +The $DB is expected to be an already open esmith::DB object, so that an open DB in the caller can be re-used. +Therefore in a migrate fragment you could just use $DB. + + esmith::util::set_secret($DB, '$key','$property'[,type=>'$type']); + +For example in /etc/e-smith/db/configuration/migrate/90roundcube + { + esmith::util::set_secret($DB, 'foo','DbPassword',type=>'service'); + } + +The password will be generated to the property 'DbPassword' in the 'foo' key. + +If you want to change the database then you must open another esmith::DB objet + { + my $database = esmith::ConfigDB->open('accounts') or + die esmith::DB->error; + esmith::util::set_secret($database, 'foo','DbPassword',type=>'user'); + } + +=cut + +sub set_secret + +{ + my ($db, $key, $prop, %options) = @_; + %options = (type => 'service', %options); + + my $record = $db->get($key) || + $db->new_record($key, \%options) or + die "Error creating new record"; + + return if $db->get_prop($key,$prop); + + $record->merge_props(%options, $prop => + Data::UUID->new->create_b64()); +} + + + +=pod + +=head1 HIGH LEVEL PASSWORD UTILITIES + +High-level password-changing utilities. These utilities +each change passwords for a single e-smith entity (system, +user or ibay). Each one works by calling the appropriate +low-level password changing utilities. + +=head2 setUnixSystemPassword($password) + +Set the e-smith system password + +=cut + +sub setUnixSystemPassword ($) +{ + my ($password) = @_; + + setUnixPassword( "root", $password ); + setUnixPassword( "admin", $password ); +} + +=pod + +=head2 setServerSystemPassword($password) + +Set the samba administrator password. + +=cut + +sub setServerSystemPassword ($) +{ + my ($password) = @_; + + setSambaPassword( "admin", $password ); +} + +=pod + +=head2 setUserPassword($username, $password) + +Set e-smith user password + +=cut + +sub setUserPassword ($$) +{ + my ( $username, $password ) = @_; + + setUnixPassword( $username, $password ); + setSambaPassword( $username, $password ); +} + +=pod + +=head2 setUserPasswordRequirePrevious($username, $oldpassword, $newpassword) + +Set e-smith user password - require previous password + +=cut + +sub setUserPasswordRequirePrevious ($$$) +{ + my ( $username, $oldpassword, $newpassword ) = @_; + + # We need to suid to the user, instead of root, so that PAM will + # prompt us for the old password. + my @pwent = getpwnam($username); + return 0 unless ( $pwent[2] > 0 ); # uid must be non-zero + my $uid = $<; + $< = $pwent[2]; + + # Return if this function call fails, we didn't change passwords + # successfully. + my $ret = + setUnixPasswordRequirePrevious( $username, $oldpassword, $newpassword ); + $< = $uid; + return 0 unless $ret; + + # if we get this far, the old password must have been valid + setSambaPassword( $username, $newpassword ); +} + +=pod + +=head2 cancelUserPassword + +Cancel user password. This is called when a user is deleted from the +system. We assume that the Unix "useradd/userdel" programs are +called separately. Since "userdel" automatically removes the +/etc/passwd entry, we only need to worry about the /etc/samba/smbpasswd +entry. + +=cut + +sub cancelUserPassword ($) +{ + my ($username) = @_; + + cancelSambaPassword($username); +} + +=pod + +=head2 setIbayPassword($ibayname, $password) + +Set ibay password + +=cut + +sub setIbayPassword ($$) +{ + my ( $ibayname, $password ) = @_; + + setUnixPassword( $ibayname, $password ); +} + +=pod + +=head1 SERVICE MANAGEMENT UTILITIES + +=head2 serviceControl() + +Manage services - stop/start/restart/reload/graceful + +Returns 1 for success, 0 if something went wrong, fatal exception on bad +arguments. + + serviceControl( + NAME=>serviceName, + ACTION=>start|stop|restart|reload|graceful + [ BACKGROUND=>true|false (default is false) ] + ); + +EXAMPLE: + + serviceControl( NAME=>'httpd-e-smith', ACTION=>'reload' ); + +NOTES: + +The BACKGROUND parameter is optional and can be set to true if +start/stop/restart/etc. is to be done in the background (with +backgroundCommand()) rather than synchronously. + +CONVENTIONS: + +This command is the supported method for action scripts, blade handlers, etc., +to start/stop/restart their services. Currently this is done via the rc7 +symlinks, but this may change one day. Using this function gives us one +location to change this behaviour if desired, instead of hunting all over +every scrap of code. Please use it. + +=cut + +sub serviceControl +{ + my %params = @_; + + my $serviceName = $params{NAME}; + unless ( defined $serviceName ) + { + die "serviceControl: NAME must be specified"; + } + + my $serviceAction = $params{ACTION}; + unless (defined $serviceAction) + { + die "serviceControl: ACTION must be specified"; + } + + if ( $serviceAction =~ /^(start|stop|restart|reload|graceful|adjust|svdisable|reload-or-restart|try-restart|reload-or-try-restart|enable -now|enable|disable|sig[A-Za-z12]+)$/ ) + { + my ($startScript) = glob("/etc/rc.d/rc7.d/S*$serviceName") ||'' ; + my ($systemdScript) = "/usr/lib/systemd/system/$serviceName.service" ||''; + my ($systemdAlias) = "/etc/systemd/system/$serviceName.service" ||''; + my $multiple = "$serviceName.service"; + ($multiple = $serviceName ) =~ s/([a-zA-Z0-9\-_.]+@)(.*)/$1.service/ if ( $serviceName =~ /@/ ); + + unless ( -e $startScript or -e $systemdScript or -e "/usr/lib/systemd/system/$multiple" or -e $systemdAlias) + { + warn "serviceControl: startScript not found " + . "for service $serviceName\n"; + return 0; + } + + if ( (-e $systemdScript or -e "/usr/lib/systemd/system/$multiple" or -e $systemdAlias) and ! -e $startScript){ + # systemd is not aware of adjust, sigusr1, sigusr2, sigterm, sighup + $serviceAction = ( $serviceAction =~/^(adjust|graceful|sighup|sigusr1|sigusr2)$/ ) ? "reload-or-restart" : $serviceAction; + $serviceAction = ( $serviceAction eq "sigterm" ) ? "restart" : $serviceAction; + if ($serviceAction =~/^(sig[A-Za-z12]+)$/) { + $serviceAction=uc($serviceAction); + system('/usr/bin/systemctl',"kill","--signal=$serviceAction","$serviceName.service") == '0' + || warn "serviceControl: Couldn't " . + "system( /usr/bin/systemctl kill --signal=$serviceAction $serviceName.service): $!\n"; + } + elsif ($serviceAction =~/^(start|stop|restart|reload|reload-or-restart|try-restart|reload-or-try-restart|enable -now|enable|disable)$/) { + system('/usr/bin/systemctl',"$serviceAction","$serviceName.service") == '0' + || warn "serviceControl: Couldn't " . + "system( /usr/bin/systemctl $serviceAction $serviceName.service): $!\n"; + } + else { + die "serviceControl: systemd doesn't know : systemctl $serviceAction $serviceName.service"; + } + } + + elsif (-e $startScript) { + my $background = $params{'BACKGROUND'} || 'false'; + + die "serviceControl: Unknown serviceAction $serviceAction" if ($serviceAction =~/^(reload-or-restart|try-restart|reload-or-try-restart|enable -now|enable|disable)$/); + if ( $background eq 'true' ) + { + backgroundCommand( 0, $startScript, $serviceAction ); + } + elsif ( $background eq 'false' ) + { + unless ( system( $startScript, $serviceAction ) == 0 ) + { + warn "serviceControl: " + . "Couldn't system($startScript, $serviceAction): $!\n"; + return 0; + } + } + else + { + die "serviceControl: Unsupported BACKGROUND=>$background"; + } + } + } + else + { + die "serviceControl: Unknown serviceAction $serviceAction"; + } + return 1; +} + +=head2 getLicenses() + +Return all available licenses + +In scalar context, returns one string combining all licenses +In array context, returns an array of individual licenses + +Optionally takes a language tag to be used for retrieving the licenses, +defaulting to the locale of the server. + +=for testing +$ENV{ESMITH_LICENSE_DIR} = "10e-smith-lib/licenses"; +ok(-d $ENV{ESMITH_LICENSE_DIR}, "License dir for testing exists"); +like($l = esmith::util::getLicenses("fr_CA"), qr/Je suis/, "Found french license"); +like($l = esmith::util::getLicenses("en_US"), qr/I am/, "Found english license"); + +=cut + +sub getLicenses +{ + my ($locale) = @_; + + if ($locale) + { + $locale =~ s/-(\S\S)/_\U$1/; + } + else + { + my $db = esmith::ConfigDB->open(); + + my ( $lang, @rest ) = $db->getLocale(); + + $lang = $lang || "en_US"; + + $locale = $lang; + } + + my $base_dir = $ENV{ESMITH_LICENSE_DIR} || "/etc/e-smith/licenses"; + + $locale = "en_US" unless ( -d "${base_dir}/${locale}" ); + + my $dir = "${base_dir}/${locale}"; + + my @licenses; + + opendir( DIR, $dir ) || die "Couldn't open licenses directory\n"; + + foreach my $license ( readdir(DIR) ) + { + my $file = "${dir}/${license}"; + + next unless ( -f $file ); + + open( LICENSE, $file ) || die "Couldn't open license $file\n"; + + push @licenses, ; + + close LICENSE; + } + + return wantarray ? @licenses : "@licenses"; +} + +=head2 getLicenseFile() + +Return the license filename. + +Optionally takes a language tag to be used for retrieving the license, +defaulting to the locale of the server. + +If more than one license file than return the first alphabetically. + +=cut + +sub getLicenseFile +{ + my ($locale) = @_; + + if ($locale) + { + $locale =~ s/-(\S\S)/_\U$1/s; + } + else + { + my $db = esmith::ConfigDB->open(); + + my ( $lang, @rest ) = $db->getLocale(); + + $lang = $lang || 'en_US'; + + $locale = $lang; + } + + my $base_dir = $ENV{ESMITH_LICENSE_DIR} || '/etc/e-smith/licenses'; + + $locale = 'en_US' unless ( -d "${base_dir}/${locale}" ); + + my $dir = "${base_dir}/${locale}"; + + opendir( DIR, $dir ) || die "Couldn't open licenses directory\n"; + + my @licenses; + foreach my $license ( readdir DIR ) + { + untaint ($license); + my $file = "${dir}/${license}"; + next unless ( -f $file ); + push @licenses, $file; + } + + @licenses = sort @licenses; + + return shift @licenses; +} + + +=item B + +Initialize all databases located at /etc/e-smith/db. + +=cut + +sub initialize_default_databases +{ + + # Optionally take an argument to the db root, for testing purposes. + my %defaults = ( + dbroot => '/etc/e-smith/db', + dbhome => '/home/e-smith/db', + old_dbhome => '/home/e-smith', + ); + my %args = ( %defaults, @_ ); + my $dbroot = $args{dbroot}; + my $dbhome = $args{dbhome}; + my $old_dbhome = $args{old_dbhome}; + + local *DH; + opendir DH, $dbroot + or die "Could not open $dbroot: $!"; + + my @dirs = readdir(DH); + + # Move all databases to new home first them migrate data + # Untaint db names while we are at it. + foreach my $file ( map { /(.+)/ ; $1 } grep !/^\./, @dirs ) + { + if (-f "${old_dbhome}/$file") + { + if (-l "${old_dbhome}/$file") + { + warn "symlink called ${old_dbhome}/$file exists\n"; + next; + } + + if (-s "${dbhome}/$file") + { + warn "${old_dbhome}/$file and ${dbhome}/$file exist\n"; + rename "${dbhome}/$file", "${dbhome}/$file." . time; + } + + warn "Rename ${old_dbhome}/$file => ${dbhome}/$file\n"; + rename "${old_dbhome}/$file", "${dbhome}/$file"; + } + } + + foreach my $file ( grep !/^\./, @dirs ) + { + # Untaint the result of readdir. As we're expecting filenames like + # 'configuration' and 'ipphones', lets restrict input to those. + if ($file =~ /(^[A-Za-z0-9_\.-]+$)/) + { + $file = $1; + } + else + { + warn "Not processing unexpected file $file\n"; + next; + } + + eval + { + my $h = esmith::ConfigDB->open($file); + if ($h) + { + warn "Migrating existing database $file\n"; + + # Convert old data to new format, and add any new defaults. Note + # that migrate returns FALSE on fatal errors. Report those to + # syslog. The error should still be in $@. + unless ( $h->migrate() ) + { + warn "Migration of db $file failed: " . esmith::DB->error; + } + } + else + { + warn "Creating database $file and setting defaults\n"; + + # create() and load defaults + unless ( $h = esmith::ConfigDB->create($file) ) + { + warn "Could not create $file db: " . esmith::DB->error; + } + } + + $h->close; + + esmith::util::chownFile( "root", "admin", "$dbhome/$file" ); + }; + if ($@) + { + warn "Fatal error while processing db $file: $@\n"; + } + } + return 1; +} + + +=head1 AUTHOR + +Mitel Networks Corp. + +For more information, see http://www.e-smith.org/ + +=cut + +1; diff --git a/root/usr/share/perl5/vendor_perl/esmith/util/link.pm b/root/usr/share/perl5/vendor_perl/esmith/util/link.pm new file mode 100644 index 0000000..c806de8 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/util/link.pm @@ -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 + +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 + +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, "; + 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 () + { + # 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; diff --git a/root/usr/share/perl5/vendor_perl/esmith/util/network.pm b/root/usr/share/perl5/vendor_perl/esmith/util/network.pm new file mode 100644 index 0000000..e4fd611 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/util/network.pm @@ -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 + +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 + +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 + +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 + +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 + +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 + +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; diff --git a/root/usr/share/perl5/vendor_perl/esmith/util/system.pm b/root/usr/share/perl5/vendor_perl/esmith/util/system.pm new file mode 100644 index 0000000..8be0438 --- /dev/null +++ b/root/usr/share/perl5/vendor_perl/esmith/util/system.pm @@ -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 + + 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 + + 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 '', ; +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 + + 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;