source: /cluster/svnroot/bccd-ng/branches/skylar/bccd-3.4.0-build_ng/src/usr/local/lib/site_perl/Bccd.pm @ 6097

Last change on this file since 6097 was 6097, checked in by skylar, 2 years ago

improving logging re #1001

  • Property Copyright set to Copyright (C) 2010 Andrew Fitz Gibbon, Paul Gray, Kevin Hunter, Dave Joiner, Sam Leeman-Munk, Tom Murphy, Charlie Peck, Skylar Thompson, & Aaron Weeden
  • Property License set to
    GNU GENERAL PUBLIC LICENSE
    Version 3, 29 June 2007

    Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
    Everyone is permitted to copy and distribute verbatim copies
    of this license document, but changing it is not allowed.

    Preamble

    The GNU General Public License is a free, copyleft license for
    software and other kinds of works.

    The licenses for most software and other practical works are designed
    to take away your freedom to share and change the works. By contrast,
    the GNU General Public License is intended to guarantee your freedom to
    share and change all versions of a program--to make sure it remains free
    software for all its users. We, the Free Software Foundation, use the
    GNU General Public License for most of our software; it applies also to
    any other work released this way by its authors. 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
    them 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 prevent others from denying you
    these rights or asking you to surrender the rights. Therefore, you have
    certain responsibilities if you distribute copies of the software, or if
    you modify it: responsibilities to respect the freedom of others.

    For example, if you distribute copies of such a program, whether
    gratis or for a fee, you must pass on to the recipients the same
    freedoms that you received. 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.

    Developers that use the GNU GPL protect your rights with two steps:
    (1) assert copyright on the software, and (2) offer you this License
    giving you legal permission to copy, distribute and/or modify it.

    For the developers' and authors' protection, the GPL clearly explains
    that there is no warranty for this free software. For both users' and
    authors' sake, the GPL requires that modified versions be marked as
    changed, so that their problems will not be attributed erroneously to
    authors of previous versions.

    Some devices are designed to deny users access to install or run
    modified versions of the software inside them, although the manufacturer
    can do so. This is fundamentally incompatible with the aim of
    protecting users' freedom to change the software. The systematic
    pattern of such abuse occurs in the area of products for individuals to
    use, which is precisely where it is most unacceptable. Therefore, we
    have designed this version of the GPL to prohibit the practice for those
    products. If such problems arise substantially in other domains, we
    stand ready to extend this provision to those domains in future versions
    of the GPL, as needed to protect the freedom of users.

    Finally, every program is threatened constantly by software patents.
    States should not allow patents to restrict development and use of
    software on general-purpose computers, but in those that do, we wish to
    avoid the special danger that patents applied to a free program could
    make it effectively proprietary. To prevent this, the GPL assures that
    patents cannot be used to render the program non-free.

    The precise terms and conditions for copying, distribution and
    modification follow.

    TERMS AND CONDITIONS

    0. Definitions.

    "This License" refers to version 3 of the GNU General Public License.

    "Copyright" also means copyright-like laws that apply to other kinds of
    works, such as semiconductor masks.

    "The Program" refers to any copyrightable work licensed under this
    License. Each licensee is addressed as "you". "Licensees" and
    "recipients" may be individuals or organizations.

    To "modify" a work means to copy from or adapt all or part of the work
    in a fashion requiring copyright permission, other than the making of an
    exact copy. The resulting work is called a "modified version" of the
    earlier work or a work "based on" the earlier work.

    A "covered work" means either the unmodified Program or a work based
    on the Program.

    To "propagate" a work means to do anything with it that, without
    permission, would make you directly or secondarily liable for
    infringement under applicable copyright law, except executing it on a
    computer or modifying a private copy. Propagation includes copying,
    distribution (with or without modification), making available to the
    public, and in some countries other activities as well.

    To "convey" a work means any kind of propagation that enables other
    parties to make or receive copies. Mere interaction with a user through
    a computer network, with no transfer of a copy, is not conveying.

    An interactive user interface displays "Appropriate Legal Notices"
    to the extent that it includes a convenient and prominently visible
    feature that (1) displays an appropriate copyright notice, and (2)
    tells the user that there is no warranty for the work (except to the
    extent that warranties are provided), that licensees may convey the
    work under this License, and how to view a copy of this License. If
    the interface presents a list of user commands or options, such as a
    menu, a prominent item in the list meets this criterion.

    1. Source Code.

    The "source code" for a work means the preferred form of the work
    for making modifications to it. "Object code" means any non-source
    form of a work.

    A "Standard Interface" means an interface that either is an official
    standard defined by a recognized standards body, or, in the case of
    interfaces specified for a particular programming language, one that
    is widely used among developers working in that language.

    The "System Libraries" of an executable work include anything, other
    than the work as a whole, that (a) is included in the normal form of
    packaging a Major Component, but which is not part of that Major
    Component, and (b) serves only to enable use of the work with that
    Major Component, or to implement a Standard Interface for which an
    implementation is available to the public in source code form. A
    "Major Component", in this context, means a major essential component
    (kernel, window system, and so on) of the specific operating system
    (if any) on which the executable work runs, or a compiler used to
    produce the work, or an object code interpreter used to run it.

    The "Corresponding Source" for a work in object code form means all
    the source code needed to generate, install, and (for an executable
    work) run the object code and to modify the work, including scripts to
    control those activities. However, it does not include the work's
    System Libraries, or general-purpose tools or generally available free
    programs which are used unmodified in performing those activities but
    which are not part of the work. For example, Corresponding Source
    includes interface definition files associated with source files for
    the work, and the source code for shared libraries and dynamically
    linked subprograms that the work is specifically designed to require,
    such as by intimate data communication or control flow between those
    subprograms and other parts of the work.

    The Corresponding Source need not include anything that users
    can regenerate automatically from other parts of the Corresponding
    Source.

    The Corresponding Source for a work in source code form is that
    same work.

    2. Basic Permissions.

    All rights granted under this License are granted for the term of
    copyright on the Program, and are irrevocable provided the stated
    conditions are met. This License explicitly affirms your unlimited
    permission to run the unmodified Program. The output from running a
    covered work is covered by this License only if the output, given its
    content, constitutes a covered work. This License acknowledges your
    rights of fair use or other equivalent, as provided by copyright law.

    You may make, run and propagate covered works that you do not
    convey, without conditions so long as your license otherwise remains
    in force. You may convey covered works to others for the sole purpose
    of having them make modifications exclusively for you, or provide you
    with facilities for running those works, provided that you comply with
    the terms of this License in conveying all material for which you do
    not control copyright. Those thus making or running the covered works
    for you must do so exclusively on your behalf, under your direction
    and control, on terms that prohibit them from making any copies of
    your copyrighted material outside their relationship with you.

    Conveying under any other circumstances is permitted solely under
    the conditions stated below. Sublicensing is not allowed; section 10
    makes it unnecessary.

    3. Protecting Users' Legal Rights From Anti-Circumvention Law.

    No covered work shall be deemed part of an effective technological
    measure under any applicable law fulfilling obligations under article
    11 of the WIPO copyright treaty adopted on 20 December 1996, or
    similar laws prohibiting or restricting circumvention of such
    measures.

    When you convey a covered work, you waive any legal power to forbid
    circumvention of technological measures to the extent such circumvention
    is effected by exercising rights under this License with respect to
    the covered work, and you disclaim any intention to limit operation or
    modification of the work as a means of enforcing, against the work's
    users, your or third parties' legal rights to forbid circumvention of
    technological measures.

    4. Conveying Verbatim Copies.

    You may convey 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;
    keep intact all notices stating that this License and any
    non-permissive terms added in accord with section 7 apply to the code;
    keep intact all notices of the absence of any warranty; and give all
    recipients a copy of this License along with the Program.

    You may charge any price or no price for each copy that you convey,
    and you may offer support or warranty protection for a fee.

    5. Conveying Modified Source Versions.

    You may convey a work based on the Program, or the modifications to
    produce it from the Program, in the form of source code under the
    terms of section 4, provided that you also meet all of these conditions:

    a) The work must carry prominent notices stating that you modified
    it, and giving a relevant date.

    b) The work must carry prominent notices stating that it is
    released under this License and any conditions added under section
    7. This requirement modifies the requirement in section 4 to
    "keep intact all notices".

    c) You must license the entire work, as a whole, under this
    License to anyone who comes into possession of a copy. This
    License will therefore apply, along with any applicable section 7
    additional terms, to the whole of the work, and all its parts,
    regardless of how they are packaged. This License gives no
    permission to license the work in any other way, but it does not
    invalidate such permission if you have separately received it.

    d) If the work has interactive user interfaces, each must display
    Appropriate Legal Notices; however, if the Program has interactive
    interfaces that do not display Appropriate Legal Notices, your
    work need not make them do so.

    A compilation of a covered work with other separate and independent
    works, which are not by their nature extensions of the covered work,
    and which are not combined with it such as to form a larger program,
    in or on a volume of a storage or distribution medium, is called an
    "aggregate" if the compilation and its resulting copyright are not
    used to limit the access or legal rights of the compilation's users
    beyond what the individual works permit. Inclusion of a covered work
    in an aggregate does not cause this License to apply to the other
    parts of the aggregate.

    6. Conveying Non-Source Forms.

    You may convey a covered work in object code form under the terms
    of sections 4 and 5, provided that you also convey the
    machine-readable Corresponding Source under the terms of this License,
    in one of these ways:

    a) Convey the object code in, or embodied in, a physical product
    (including a physical distribution medium), accompanied by the
    Corresponding Source fixed on a durable physical medium
    customarily used for software interchange.

    b) Convey the object code in, or embodied in, a physical product
    (including a physical distribution medium), accompanied by a
    written offer, valid for at least three years and valid for as
    long as you offer spare parts or customer support for that product
    model, to give anyone who possesses the object code either (1) a
    copy of the Corresponding Source for all the software in the
    product that is covered by this License, on a durable physical
    medium customarily used for software interchange, for a price no
    more than your reasonable cost of physically performing this
    conveying of source, or (2) access to copy the
    Corresponding Source from a network server at no charge.

    c) Convey individual copies of the object code with a copy of the
    written offer to provide the Corresponding Source. This
    alternative is allowed only occasionally and noncommercially, and
    only if you received the object code with such an offer, in accord
    with subsection 6b.

    d) Convey the object code by offering access from a designated
    place (gratis or for a charge), and offer equivalent access to the
    Corresponding Source in the same way through the same place at no
    further charge. You need not require recipients to copy the
    Corresponding Source along with the object code. If the place to
    copy the object code is a network server, the Corresponding Source
    may be on a different server (operated by you or a third party)
    that supports equivalent copying facilities, provided you maintain
    clear directions next to the object code saying where to find the
    Corresponding Source. Regardless of what server hosts the
    Corresponding Source, you remain obligated to ensure that it is
    available for as long as needed to satisfy these requirements.

    e) Convey the object code using peer-to-peer transmission, provided
    you inform other peers where the object code and Corresponding
    Source of the work are being offered to the general public at no
    charge under subsection 6d.

    A separable portion of the object code, whose source code is excluded
    from the Corresponding Source as a System Library, need not be
    included in conveying the object code work.

    A "User Product" is either (1) a "consumer product", which means any
    tangible personal property which is normally used for personal, family,
    or household purposes, or (2) anything designed or sold for incorporation
    into a dwelling. In determining whether a product is a consumer product,
    doubtful cases shall be resolved in favor of coverage. For a particular
    product received by a particular user, "normally used" refers to a
    typical or common use of that class of product, regardless of the status
    of the particular user or of the way in which the particular user
    actually uses, or expects or is expected to use, the product. A product
    is a consumer product regardless of whether the product has substantial
    commercial, industrial or non-consumer uses, unless such uses represent
    the only significant mode of use of the product.

    "Installation Information" for a User Product means any methods,
    procedures, authorization keys, or other information required to install
    and execute modified versions of a covered work in that User Product from
    a modified version of its Corresponding Source. The information must
    suffice to ensure that the continued functioning of the modified object
    code is in no case prevented or interfered with solely because
    modification has been made.

    If you convey an object code work under this section in, or with, or
    specifically for use in, a User Product, and the conveying occurs as
    part of a transaction in which the right of possession and use of the
    User Product is transferred to the recipient in perpetuity or for a
    fixed term (regardless of how the transaction is characterized), the
    Corresponding Source conveyed under this section must be accompanied
    by the Installation Information. But this requirement does not apply
    if neither you nor any third party retains the ability to install
    modified object code on the User Product (for example, the work has
    been installed in ROM).

    The requirement to provide Installation Information does not include a
    requirement to continue to provide support service, warranty, or updates
    for a work that has been modified or installed by the recipient, or for
    the User Product in which it has been modified or installed. Access to a
    network may be denied when the modification itself materially and
    adversely affects the operation of the network or violates the rules and
    protocols for communication across the network.

    Corresponding Source conveyed, and Installation Information provided,
    in accord with this section must be in a format that is publicly
    documented (and with an implementation available to the public in
    source code form), and must require no special password or key for
    unpacking, reading or copying.

    7. Additional Terms.

    "Additional permissions" are terms that supplement the terms of this
    License by making exceptions from one or more of its conditions.
    Additional permissions that are applicable to the entire Program shall
    be treated as though they were included in this License, to the extent
    that they are valid under applicable law. If additional permissions
    apply only to part of the Program, that part may be used separately
    under those permissions, but the entire Program remains governed by
    this License without regard to the additional permissions.

    When you convey a copy of a covered work, you may at your option
    remove any additional permissions from that copy, or from any part of
    it. (Additional permissions may be written to require their own
    removal in certain cases when you modify the work.) You may place
    additional permissions on material, added by you to a covered work,
    for which you have or can give appropriate copyright permission.

    Notwithstanding any other provision of this License, for material you
    add to a covered work, you may (if authorized by the copyright holders of
    that material) supplement the terms of this License with terms:

    a) Disclaiming warranty or limiting liability differently from the
    terms of sections 15 and 16 of this License; or

    b) Requiring preservation of specified reasonable legal notices or
    author attributions in that material or in the Appropriate Legal
    Notices displayed by works containing it; or

    c) Prohibiting misrepresentation of the origin of that material, or
    requiring that modified versions of such material be marked in
    reasonable ways as different from the original version; or

    d) Limiting the use for publicity purposes of names of licensors or
    authors of the material; or

    e) Declining to grant rights under trademark law for use of some
    trade names, trademarks, or service marks; or

    f) Requiring indemnification of licensors and authors of that
    material by anyone who conveys the material (or modified versions of
    it) with contractual assumptions of liability to the recipient, for
    any liability that these contractual assumptions directly impose on
    those licensors and authors.

    All other non-permissive additional terms are considered "further
    restrictions" within the meaning of section 10. If the Program as you
    received it, or any part of it, contains a notice stating that it is
    governed by this License along with a term that is a further
    restriction, you may remove that term. If a license document contains
    a further restriction but permits relicensing or conveying under this
    License, you may add to a covered work material governed by the terms
    of that license document, provided that the further restriction does
    not survive such relicensing or conveying.

    If you add terms to a covered work in accord with this section, you
    must place, in the relevant source files, a statement of the
    additional terms that apply to those files, or a notice indicating
    where to find the applicable terms.

    Additional terms, permissive or non-permissive, may be stated in the
    form of a separately written license, or stated as exceptions;
    the above requirements apply either way.

    8. Termination.

    You may not propagate or modify a covered work except as expressly
    provided under this License. Any attempt otherwise to propagate or
    modify it is void, and will automatically terminate your rights under
    this License (including any patent licenses granted under the third
    paragraph of section 11).

    However, if you cease all violation of this License, then your
    license from a particular copyright holder is reinstated (a)
    provisionally, unless and until the copyright holder explicitly and
    finally terminates your license, and (b) permanently, if the copyright
    holder fails to notify you of the violation by some reasonable means
    prior to 60 days after the cessation.

    Moreover, your license from a particular copyright holder is
    reinstated permanently if the copyright holder notifies you of the
    violation by some reasonable means, this is the first time you have
    received notice of violation of this License (for any work) from that
    copyright holder, and you cure the violation prior to 30 days after
    your receipt of the notice.

    Termination of your rights under this section does not terminate the
    licenses of parties who have received copies or rights from you under
    this License. If your rights have been terminated and not permanently
    reinstated, you do not qualify to receive new licenses for the same
    material under section 10.

    9. Acceptance Not Required for Having Copies.

    You are not required to accept this License in order to receive or
    run a copy of the Program. Ancillary propagation of a covered work
    occurring solely as a consequence of using peer-to-peer transmission
    to receive a copy likewise does not require acceptance. However,
    nothing other than this License grants you permission to propagate or
    modify any covered work. These actions infringe copyright if you do
    not accept this License. Therefore, by modifying or propagating a
    covered work, you indicate your acceptance of this License to do so.

    10. Automatic Licensing of Downstream Recipients.

    Each time you convey a covered work, the recipient automatically
    receives a license from the original licensors, to run, modify and
    propagate that work, subject to this License. You are not responsible
    for enforcing compliance by third parties with this License.

    An "entity transaction" is a transaction transferring control of an
    organization, or substantially all assets of one, or subdividing an
    organization, or merging organizations. If propagation of a covered
    work results from an entity transaction, each party to that
    transaction who receives a copy of the work also receives whatever
    licenses to the work the party's predecessor in interest had or could
    give under the previous paragraph, plus a right to possession of the
    Corresponding Source of the work from the predecessor in interest, if
    the predecessor has it or can get it with reasonable efforts.

    You may not impose any further restrictions on the exercise of the
    rights granted or affirmed under this License. For example, you may
    not impose a license fee, royalty, or other charge for exercise of
    rights granted under this License, and you may not initiate litigation
    (including a cross-claim or counterclaim in a lawsuit) alleging that
    any patent claim is infringed by making, using, selling, offering for
    sale, or importing the Program or any portion of it.

    11. Patents.

    A "contributor" is a copyright holder who authorizes use under this
    License of the Program or a work on which the Program is based. The
    work thus licensed is called the contributor's "contributor version".

    A contributor's "essential patent claims" are all patent claims
    owned or controlled by the contributor, whether already acquired or
    hereafter acquired, that would be infringed by some manner, permitted
    by this License, of making, using, or selling its contributor version,
    but do not include claims that would be infringed only as a
    consequence of further modification of the contributor version. For
    purposes of this definition, "control" includes the right to grant
    patent sublicenses in a manner consistent with the requirements of
    this License.

    Each contributor grants you a non-exclusive, worldwide, royalty-free
    patent license under the contributor's essential patent claims, to
    make, use, sell, offer for sale, import and otherwise run, modify and
    propagate the contents of its contributor version.

    In the following three paragraphs, a "patent license" is any express
    agreement or commitment, however denominated, not to enforce a patent
    (such as an express permission to practice a patent or covenant not to
    sue for patent infringement). To "grant" such a patent license to a
    party means to make such an agreement or commitment not to enforce a
    patent against the party.

    If you convey a covered work, knowingly relying on a patent license,
    and the Corresponding Source of the work is not available for anyone
    to copy, free of charge and under the terms of this License, through a
    publicly available network server or other readily accessible means,
    then you must either (1) cause the Corresponding Source to be so
    available, or (2) arrange to deprive yourself of the benefit of the
    patent license for this particular work, or (3) arrange, in a manner
    consistent with the requirements of this License, to extend the patent
    license to downstream recipients. "Knowingly relying" means you have
    actual knowledge that, but for the patent license, your conveying the
    covered work in a country, or your recipient's use of the covered work
    in a country, would infringe one or more identifiable patents in that
    country that you have reason to believe are valid.

    If, pursuant to or in connection with a single transaction or
    arrangement, you convey, or propagate by procuring conveyance of, a
    covered work, and grant a patent license to some of the parties
    receiving the covered work authorizing them to use, propagate, modify
    or convey a specific copy of the covered work, then the patent license
    you grant is automatically extended to all recipients of the covered
    work and works based on it.

    A patent license is "discriminatory" if it does not include within
    the scope of its coverage, prohibits the exercise of, or is
    conditioned on the non-exercise of one or more of the rights that are
    specifically granted under this License. You may not convey a covered
    work if you are a party to an arrangement with a third party that is
    in the business of distributing software, under which you make payment
    to the third party based on the extent of your activity of conveying
    the work, and under which the third party grants, to any of the
    parties who would receive the covered work from you, a discriminatory
    patent license (a) in connection with copies of the covered work
    conveyed by you (or copies made from those copies), or (b) primarily
    for and in connection with specific products or compilations that
    contain the covered work, unless you entered into that arrangement,
    or that patent license was granted, prior to 28 March 2007.

    Nothing in this License shall be construed as excluding or limiting
    any implied license or other defenses to infringement that may
    otherwise be available to you under applicable patent law.

    12. No Surrender of Others' Freedom.

    If 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 convey a
    covered work so as to satisfy simultaneously your obligations under this
    License and any other pertinent obligations, then as a consequence you may
    not convey it at all. For example, if you agree to terms that obligate you
    to collect a royalty for further conveying from those to whom you convey
    the Program, the only way you could satisfy both those terms and this
    License would be to refrain entirely from conveying the Program.

    13. Use with the GNU Affero General Public License.

    Notwithstanding any other provision of this License, you have
    permission to link or combine any covered work with a work licensed
    under version 3 of the GNU Affero General Public License into a single
    combined work, and to convey the resulting work. The terms of this
    License will continue to apply to the part which is the covered work,
    but the special requirements of the GNU Affero General Public License,
    section 13, concerning interaction through a network will apply to the
    combination as such.

    14. Revised Versions of this License.

    The Free Software Foundation may publish revised and/or new versions of
    the GNU 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 that a certain numbered version of the GNU General
    Public License "or any later version" applies to it, you have the
    option of following the terms and conditions either of that numbered
    version or of any later version published by the Free Software
    Foundation. If the Program does not specify a version number of the
    GNU General Public License, you may choose any version ever published
    by the Free Software Foundation.

    If the Program specifies that a proxy can decide which future
    versions of the GNU General Public License can be used, that proxy's
    public statement of acceptance of a version permanently authorizes you
    to choose that version for the Program.

    Later license versions may give you additional or different
    permissions. However, no additional obligations are imposed on any
    author or copyright holder as a result of your choosing to follow a
    later version.

    15. Disclaimer of Warranty.

    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.

    16. Limitation of Liability.

    IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
    WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
    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.

    17. Interpretation of Sections 15 and 16.

    If the disclaimer of warranty and limitation of liability provided
    above cannot be given local legal effect according to their terms,
    reviewing courts shall apply local law that most closely approximates
    an absolute waiver of all civil liability in connection with the
    Program, unless a warranty or assumption of liability accompanies a
    copy of the Program in return for a fee.

    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
    state the exclusion of warranty; and each file should have at least
    the "copyright" line and a pointer to where the full notice is found.

    <one line to give the program's name and a brief idea of what it does.>
    Copyright (C) <year> <name of author>

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 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, see <http://www.gnu.org/licenses/>.

    Also add information on how to contact you by electronic and paper mail.

    If the program does terminal interaction, make it output a short
    notice like this when it starts in an interactive mode:

    <program> Copyright (C) <year> <name of author>
    This program 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, your program's commands
    might be different; for a GUI interface, you would use an "about box".

    You should also get your employer (if you work as a programmer) or school,
    if any, to sign a "copyright disclaimer" for the program, if necessary.
    For more information on this, and how to apply and follow the GNU GPL, see
    <http://www.gnu.org/licenses/>.

    The GNU 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 Lesser General
    Public License instead of this License. But first, please read
    <http://www.gnu.org/philosophy/why-not-lgpl.html>.
  • Property svn:keywords set to Id Rev Author Date
File size: 92.0 KB
Line 
1package Bccd;
2
3# $Id: Bccd.pm 6097 2018-10-23 04:06:49Z skylar $
4
5# This file is part of BCCD, an open-source live CD for computational science
6# education.
7#
8# Copyright (C) 2010 Andrew Fitz Gibbon, Paul Gray, Kevin Hunter, Dave Joiner,
9#   Sam Leeman-Munk, Tom Murphy, Charlie Peck, Skylar Thompson, & Aaron Weeden
10
11#
12# This program is free software: you can redistribute it and/or modify
13# it under the terms of the GNU General Public License as published by
14# the Free Software Foundation, either version 3 of the License, or
15# (at your option) any later version.
16#
17# This program is distributed in the hope that it will be useful,
18# but WITHOUT ANY WARRANTY; without even the implied warranty of
19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20# GNU General Public License for more details.
21#
22# You should have received a copy of the GNU General Public License
23# along with this program.  If not, see <http://www.gnu.org/licenses/>.
24
25use strict;
26use warnings;
27use File::Path;
28use File::Temp;
29use File::Copy;
30use File::Basename;
31use WWW::Mechanize;
32use Term::ReadKey;
33use POSIX;
34use Carp;
35use Readonly;
36use UI::Dialog;
37use Data::Dumper;
38use NetAddr::IP;
39use IO::Socket::INET;
40use Net::DHCP::Packet;
41use Net::DHCP::Constants;
42use Net::CIDR ':all';
43use Errno qw(:POSIX);
44use Fcntl qw(:mode);
45use YAML qw/LoadFile/;
46use Digest::MD5;
47use List::MoreUtils qw/uniq/;
48
49my $passed = 0;
50my $total = 0;
51Readonly my $KERNREV => '4.15.0-1-amd64';
52Readonly my $DHCFILE => '/etc/dhcp/dhclient.conf';
53Readonly my $ALLOUTFILE    => "allout";
54Readonly my $LVMROOT       => "/sbin/";
55Readonly my $PROJECT       => "bccd";
56Readonly my $IFCONFIG      => "/sbin/ifconfig -a";
57Readonly my $INTFILE       => "/etc/network/interfaces";
58Readonly my $NATSH         => "/etc/network/if-up.d/nat";
59Readonly my $TEMPLATE_IPTABLES_UP   => '/etc/iptables.up.rules.template';
60Readonly my $IPTABLES_UP   => '/etc/iptables.up.rules';
61Readonly my $START_PKBFILE => "/etc/network/if-up.d/start-pkbcast";
62Readonly my $CMDLINE_FILE => "/proc/cmdline";
63Readonly my $BCCD_NET  => { 'ipaddr'  => '192.168.3.1',
64                            'mask' => '255.255.255.0',
65                            'bcast'   => '192.168.3.255',
66                            'net'       => '192.168.3.0',
67                            'dhcp'    => 0,
68                            'bccdnet' => 1,
69};
70# res is the top of the reserved range
71# dhcp is the top of the DHCP range for BCCD systems
72Readonly my $DHCP_RANGES => { 'res'  => '192.168.3.10',
73                              'dhcp' => '192.168.3.100',
74                              'pxe'  => 100
75};
76Readonly my $DHCP_CONF => '/etc/dhcp/bccd_net.conf';
77Readonly my $DEFAULT_DHCP_CONF => '/etc/default/isc-dhcp-server';
78Readonly my $TEMPLATE_DHCP_CONF => $DHCP_CONF."_template";
79Readonly my $PXELINUX => "/srv/tftp/pxelinux.cfg/default";
80Readonly my $TEMPLATE_PXELINUX => $PXELINUX."_template";
81Readonly my $DISKLESS_FSTAB => "/diskless/bccd/etc/fstab";
82Readonly my $TEMPLATE_DISKLESS_FSTAB => $DISKLESS_FSTAB."_template";
83
84#Boot Flag Indices
85Readonly my $CUSTOM_NIC => "02";
86Readonly my $IS_BCCD_NETWORK_NIC => 0;
87
88# LOGGING FLAGS
89my $debug = 0;
90my $INFO = 0b1;
91my $DEBUG = 0b10;
92my $LOG = 0;
93
94sub new {
95    my $class = shift;
96    my $self = {};
97    bless($self,$class);
98    return $self;
99}
100
101# #915 - LOGGING ROUTINES
102# Possible improvements:
103#
104# carp with calling line number, not log_and_foo line number
105# Consolidate to one function, use croak and eval{ }
106# Test logging level w/i logging subroutines, not in calling code
107sub log_and_cont( $$$$ ) {
108    my($self,$code,$func,$msg) = @_;
109
110    carp "$0: $code: $func: $msg\n";
111
112}
113
114sub log_and_die( $$$$ ) {
115    my($self,$code,$func,$msg) = @_;
116
117    croak "$0: $code: $func: $msg\n";
118}
119
120sub enter_sub( $$ ) {
121    my($self,$sub) = @_;
122
123    if($self->is_log($DEBUG)) {
124        $self->log_and_cont("DEBUG",$sub,"Entering $sub");
125    }
126}
127
128sub leave_sub( $$ ) {
129    my($self,$sub) = @_;
130   
131    if($self->is_log($DEBUG)) {
132        $self->log_and_cont("DEBUG",$sub,"Leaving $sub") ;
133    }
134}
135
136# #915 - Possible improvements:
137# Should return, can catch w/ eval { }
138sub cmd_num_die( $@ ) {
139    my($self,@cmds) = @_;
140    my $sub = "cmd_num_die";
141    $self->enter_sub($sub);
142   
143    $self->log_and_die("ERROR",$sub,"Incorrect number of command line arguments: $#cmds; @cmds");
144    $self->leave_sub($sub);
145}
146
147sub print_array ( $@ ) {
148    my($self,@array) = @_;
149    my $sub = "print_array";
150    $self->enter_sub($sub);
151    my $i;
152   
153    $i = 0;
154    foreach my $row ( @array ) {
155        print "$i: $row\n";
156        $i++;
157    }
158    $self->leave_sub($sub);
159}
160
161# LVM ROUTINES
162sub get_lvminfo( $$ ) {
163    my($self,$layer) = @_;
164    my($sub,$cmd,$rc,$out);
165    my(@info,@splitinfo);
166    $sub = "get_lvminfo";
167    $self->enter_sub($sub);
168   
169    if($layer !~ m/(?:pv|vg|lv)/) {
170        $self->log_and_die("ERROR",$sub,"Layer must be one of pv, vg, or lv.");
171    }
172   
173    $cmd = [
174        "$LVMROOT/".$layer."display",
175        '-c',
176    ];
177    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
178        $self->log_and_cont("INFO",$sub,"Executing @{$cmd}");
179    }
180    ($rc,$out) = $self->exec_system($cmd);
181    if($rc == 5) {
182        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
183            $self->log_and_cont("INFO",$sub,"Nothing to display for @{$cmd}.");
184        }
185        return;
186    }
187    # BUG: Why the two tests of $rc?
188    elsif($rc) {
189        if($rc) {
190            $self->log_and_cont("NOTICE", $sub,"@{$cmd} failed with output $out and rc $rc: $!");
191        }
192        return;
193    }
194   
195    PV:
196    foreach my $line ( split('\n',$out) ) {
197        $line =~ s/^\s+//g;
198        if($line =~ m/is a new physical volume/) { # pvdisplay reports this when the PV has no VG
199            next PV;
200        }
201        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
202            $self->log_and_cont("INFO",$sub,"Pushing line $line.");
203        }
204        push(@splitinfo,[ split(':',$line) ]);
205    }
206   
207    return @splitinfo;
208}
209
210
211sub rm_all_lv( $ ) {
212    my($self) = @_;
213    my($sub,$cmdrc,$rc,$out);
214    my @info;
215    my %lvs;
216    $sub = 'rm_all_lv';
217    $self->enter_sub($sub);
218
219    $rc = 0;
220    @info = $self->get_lvminfo('lv');
221    if(@info) {   
222        for(my $i=0;$i<=$#info;$i++) {
223            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
224                $self->log_and_cont("INFO",$sub,"Found volume group for logical volumes: $info[$i][1].");
225            }
226            $lvs{$info[$i][1]} = 1;
227        }
228       
229        foreach my $key ( keys %lvs ) {
230            my $cmd = [
231                '/sbin/lvremove',
232                '-f',
233                $key,
234            ];
235            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
236                $self->log_and_cont("INFO",$sub,"Running cmd @{$cmd}.");
237            }
238            ($cmdrc,$out) = $self->exec_system($cmd);
239            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
240                $self->log_and_cont("INFO",$sub,"@{$cmd} returned $cmdrc with output $out");
241            }
242            if($rc) {
243                $self->log_and_cont("ERROR", $sub,"@{$cmd} failed with output $out and rc $rc: $!");
244            }
245            $rc += $cmdrc;
246        }
247    }
248   
249    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
250        $self->log_and_cont("INFO",$sub,"Returning with rc $rc.");
251    }
252    $self->leave_sub($sub);
253    return $rc;
254}
255
256sub rm_all_vg( $ ) {
257    my($self) = @_;
258    my($sub,$rc,$cmdrc,$out);
259    my @info;
260    my %vgs;
261    $sub = 'rm_all_vg';
262    $self->enter_sub($sub);
263   
264    $rc = 0;
265    @info = $self->get_lvminfo('vg');
266    if(@info) {
267        for(my $i=0;$i<=$#info;$i++) {
268            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
269                $self->log_and_cont("INFO",$sub,"Found volume group: $info[$i][0].");
270            }
271            $vgs{$info[$i][0]} = 1;
272        }
273       
274        foreach my $key ( keys %vgs ) {
275            my $cmd = [
276                '/sbin/vgremove',
277                '-f',
278                $key,
279            ];
280            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
281                $self->log_and_cont("INFO",$sub,"Running cmd @{$cmd}.");
282            }
283            ($cmdrc,$out) = $self->exec_system($cmd);
284            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
285                $self->log_and_cont("INFO",$sub,"@{$cmd} returned $cmdrc with output $out");
286            }
287            if($rc) {
288                $self->log_and_cont("ERROR", $sub,"@{$cmd} failed with output $out and rc $rc: $!");
289            }
290            $rc += $cmdrc;
291        }
292    }
293    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
294        $self->log_and_cont("INFO",$sub,"Returning with rc $rc.");
295    }
296   
297    $self->leave_sub($sub);
298    return $rc;
299}
300
301sub rm_all_pv( $ ) {
302    my($self) = @_;
303    my($sub,$cmdrc,$rc,$out);
304    my @info;
305    my %pvs;
306    $sub = 'rm_all_pv';
307    $self->enter_sub($sub);
308   
309    $rc = 0;
310    @info = $self->get_lvminfo('pv');
311    if(@info) {
312        for(my $i=0;$i<=$#info;$i++) {
313            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
314                $self->log_and_cont("INFO",$sub,"Found physical volume: $info[$i][0].");
315            }
316            $pvs{$info[$i][0]} = 1;
317        }
318       
319        foreach my $key ( keys %pvs ) {
320            my $cmd = [
321                '/sbin/pvremove',
322                '-f',
323                $key,
324            ];
325            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
326                $self->log_and_cont("INFO",$sub,"Running cmd @{$cmd}.");
327            }
328               
329            ($cmdrc,$out) = $self->exec_system($cmd);
330            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
331                $self->log_and_cont("INFO",$sub,"@{$cmd} returned $cmdrc with output $out");
332            }
333             
334            if($rc) { 
335                $self->log_and_die("ERROR", $sub,"@{$cmd} failed with output $out and rc $rc: $!");
336            }
337            $rc += $cmdrc;
338        }
339    }
340
341    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
342        $self->log_and_cont("INFO",$sub,"Returning with rc $rc.");
343    }
344       
345    $self->leave_sub($sub);
346    return $rc;
347}
348
349sub get_lvinfo( $ ) {
350    my($self) = @_;
351    my $sub = "get_lvinfo";
352    $self->enter_sub($sub);
353    my($lvinfo,$cmd,$rc);
354
355    $cmd = [
356        "$LVMROOT/lvdisplay",
357        '-c',
358    ];
359    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
360        $self->log_and_cont("INFO",$sub,"Executing @{$cmd}");
361    }
362    ($rc,$lvinfo) = $self->exec_system($cmd);
363    if($rc) {
364        $self->log_and_cont("@{$cmd} failed with $rc, out $lvinfo");
365        return;
366    }
367    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
368        $self->log_and_cont("INFO",$sub,"Ran @{$cmd} and got output $lvinfo");
369    }
370
371    $self->leave_sub($sub);
372    return split(':', $lvinfo);
373}
374
375sub get_vginfo( $ ) {
376    my($self) = @_;
377    my $sub = "get_vginfo";
378    $self->enter_sub($sub);
379    my($vginfo,$cmd,$rc);
380
381    $cmd = [
382        "$LVMROOT/vgdisplay",
383        '-c',
384    ];
385    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
386        $self->log_and_cont("INFO",$sub,"Executing @{$cmd}");
387    }
388    ($rc,$vginfo) = $self->exec_system($cmd);
389    if($rc) {
390        $self->log_and_cont("@{$cmd} failed with $rc, out $vginfo");
391        return;
392    }
393    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
394        $self->log_and_cont("INFO",$sub,"Ran @{$cmd} and got output $vginfo");
395    }
396
397    $self->leave_sub($sub);
398    return split(':', $vginfo);
399}
400
401sub get_pvinfo( $ ) {
402    my($self) = @_;
403    my $sub = "get_pvinfo";
404    $self->enter_sub($sub);
405    my($pvinfo,$cmd,$rc);
406
407    $cmd = [
408        "$LVMROOT/pvdisplay",
409        '-c',
410    ];
411    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
412        $self->log_and_cont("INFO",$sub,"Executing @{$cmd}");
413    }
414    ($rc,$pvinfo) = $self->exec_system($cmd);
415    if($rc) {
416        $self->log_and_cont('ERROR',$sub,"@{$cmd} failed with $rc, out $pvinfo");
417        return;
418    }
419    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
420        $self->log_and_cont("INFO",$sub,"Ran @{$cmd} and got output $pvinfo");
421    }
422    $self->leave_sub($sub);
423    return split(':', $pvinfo);
424}
425
426sub get_pe_size( $ ) {
427    my($self) = @_;
428    my $sub = "get_pe_size";
429    $self->enter_sub($sub);
430    my @vginfo = $self->get_vginfo();
431    if($self->is_log($DEBUG)) {
432        $self->log_and_cont("DEBUG",$sub,"Retrieved @vginfo from get_vginfo.");
433    }
434
435    $self->leave_sub($sub);
436    return $vginfo[12];
437}
438
439sub get_free_pe_count( $ ) {
440    my($self) = @_;
441    my $sub = "get_free_pe_count";
442    $self->enter_sub($sub);
443
444    my @vginfo = $self->get_vginfo();
445    if($self->is_log($DEBUG)) {
446        $self->log_and_cont("DEBUG",$sub,"Retrieved @vginfo from get_vginfo.");
447    }
448
449    $self->leave_sub($sub);
450    return $vginfo[15];
451}
452
453# #915 - Possible improvements:
454# Use File::Slurp instead?
455sub snarf_file( $$ ) {
456    my($self,$file) = @_;
457    my($sub,$FILE);
458    $sub = "snarf_file";
459    $self->enter_sub($sub);
460    my $input;
461    {
462        local $/;
463        open($FILE, "< $file") or $self->log_and_die("ERROR",$sub,"Could not open file $file for reading: $!");
464        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
465            $self->log_and_cont("INFO",$sub,"Opened $file for reading.");
466        }
467       
468        $input = <$FILE>;
469    }
470    close($FILE);
471   
472    chomp $input;
473
474    $self->leave_sub($sub);
475    return $input;
476}
477
478# #915 - Improvements for all tests:
479# Use a wrapper function that prints out the argument list and test name
480
481# #915 - Test should be separate; croak, return undef on error
482sub test_regexsub_file( $$$$$$$ ) {
483    my($self,$type,$okrc,$msg,$file,$regex1,$regex2) = @_;
484    my($sub,$text,$rc);
485    $sub = 'test_regexsub_file';
486
487    if($okrc eq '') {
488        $okrc = 1;
489    }
490   
491    if( ! -f $file ) {
492        $self->fail_msg("$msg: $file not found for regex sub.");
493        return 0;
494    }
495   
496    $text = $self->snarf_file($file);
497   
498    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
499        $self->log_and_cont("INFO",$sub,"Regex1: $regex1; Regex2: $regex2; Pretext: $text");
500    }
501     
502    $text =~ s/$regex1/$regex2/g;
503    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
504        $self->log_and_cont("INFO",$sub,"Posttext: $text");
505    }
506
507    $rc = $self->test_fwrite($type,$okrc,"Writing $file after $regex1 -> $regex2."
508                             ,'w',$file,$text);
509
510    if($rc == $okrc) {
511        $self->ok_msg($msg);
512        $rc = 1;
513    }
514    else {
515        $self->fail_msg($msg);
516        $rc = 0;
517    }
518
519    return $rc;
520}
521
522# #915 - Test should be separate; croak, return undef on error
523sub test_read_yaml{
524        my($self,$type,$okrc,$msg,$file) = @_;
525        my $sub = 'test_read_yaml';
526
527        $self->enter_sub($sub);
528
529        if(! -f $file) {
530                $self->log_and_die("ERROR",$sub,"Cannot read in $file");
531        }
532
533        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
534                $self->log_and_cont("INFO",$sub,"Reading in: $file");
535        }
536        my $y = LoadFile($file);
537        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
538                $self->log_and_cont("INFO",$sub,"Read in:".Dumper($y));
539        }
540
541        $self->leave_sub($sub);
542        return $y;
543}
544
545# #915 - Test should be separate; croak, return undef on error
546sub test_mknods{
547        my($self,$type,$okrc,$msg,$file,$base) = @_;
548        my($rc,$temprc,$out);
549        my $sub = 'test_mknods';
550
551        $self->enter_sub($sub);
552
553        if($okrc eq '') {
554        $okrc = 0;
555    }
556
557        my $y = $self->test_read_yaml($type,$okrc,"Reading mknod configuration from $file.",$file);
558        if(!defined($y)) {
559                $self->log_and_die("ERROR",$sub,"Can't proceeded with invalid configuration.");
560        }
561
562        $rc = 0;
563        foreach my $d (keys(%{$y})) {
564                my $cmd = [
565            '/bin/mknod',
566            "$base/$d",
567            $y->{$d}->{type},
568            $y->{$d}->{major},
569            $y->{$d}->{minor},
570        ];
571        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
572            $self->log_and_cont("INFO",$sub,"Running @{$cmd}");
573        }
574
575                ($temprc,$out) = $self->exec_system($cmd);
576                if($rc) {
577                        $self->log_and_cont("@{$cmd} failed with $temprc, out $out");
578                }
579                if($temprc > $rc) {
580                        $rc = $temprc;
581                }
582        }
583
584    if($rc == $okrc) {
585        $self->ok_msg($msg);
586        $rc = 1;
587    }
588    else {
589        $self->fail_msg($msg);
590        $rc = 0;
591    }
592
593        $self->leave_sub($sub);
594        return $rc;
595}
596
597# #915 - Test should be separate; croak, return undef on error
598sub test_md5file {
599    my($self,$type,$okrc,$msg,$infile,$outfile) = @_;
600        my($rc,$md5,$out,$INFILE,$OUTFILE);
601        my $sub = 'test_md5file';
602
603        $self->enter_sub($sub);
604
605        if($okrc eq '') {
606        $okrc = 0;
607    }
608
609    $md5 = Digest::MD5->new();
610
611    if(!defined(open($INFILE,'<',$infile))) {
612        $self->log_and_cont('ERROR',$sub,"Can't open $infile for reading: $!");
613        return;
614    }
615
616    if(!defined(open($OUTFILE,'>',$outfile))) {
617        $self->log_and_cont('ERROR',$sub,"Can't open $outfile for writing: $!");
618        return;
619    }
620
621    binmode($INFILE);
622
623    if(!defined($md5 = $md5->addfile($INFILE))) {
624        $self->log_and_cont('ERROR',$sub,"Failed to generate MD5 sum for $infile");
625        return;
626    }
627
628    print $OUTFILE "MD5 (".basename($infile).") = ".$md5->hexdigest()."\n";
629
630    if(!defined(close($INFILE))) {
631        $self->log_and_cont('NOTICE',$sub,"Can't close $infile: $!");
632    }
633    if(!defined(close($OUTFILE))) {
634        $self->log_and_cont('ERROR',$sub,"Can't close $outfile: $!");
635        return;
636    }
637
638    return 1;
639}
640
641# #915 - Test should be separate; croak, return undef on error
642sub test_rm_lvm( $$$$ ) {
643    my($self,$type,$okrc,$msg) = @_;
644    my($sub,$rc,$cmdrc);
645    $sub = 'test_rm_lvm';
646    $self->enter_sub($sub);
647
648    if($okrc eq '') {
649        $okrc = 0;
650    }
651
652    $rc = 0;
653    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
654        $self->log_and_cont("INFO",$sub,"Removing logical volumes.");
655    }
656    $cmdrc = $self->rm_all_lv();
657    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
658        $self->log_and_cont("INFO",$sub,"Logical volume remove exited with rc $cmdrc.");
659    }
660    $rc += $cmdrc;
661    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
662        $self->log_and_cont("INFO",$sub,"Removing volume groups.");
663    }
664    $cmdrc = $self->rm_all_vg();
665    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
666        $self->log_and_cont("INFO",$sub,"Volume group remove exited with rc $cmdrc.");
667    }
668    $rc += $cmdrc;
669    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
670        $self->log_and_cont("INFO",$sub,"Removing physical volumes.");
671    }
672    $cmdrc = $self->rm_all_pv();
673    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
674        $self->log_and_cont("INFO",$sub,"Physical volume remove exited with rc $cmdrc.");
675    }
676    $rc += $cmdrc;
677
678    if($rc == $okrc) {
679        $self->ok_msg($msg);
680        $rc = 1;
681    }
682    else {
683        $self->fail_msg($msg);
684        $rc = 0;
685    }
686
687    $self->leave_sub($sub);
688    return $rc;
689}
690
691# #915 - Test should be separate; croak, return undef on error
692sub test_system( $$$$$ ) {
693    my($self,$type,$okrc,$msg,$cmd) = @_;
694    my $sub = "test_system";
695    $self->enter_sub($sub);
696    my $rc = 0;
697    my $out;
698
699    if( $okrc eq "" ) {
700        $okrc = 0;
701    }
702    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
703        $self->log_and_cont("INFO",$sub,"Passing @{$cmd} to exec_system");
704    }
705    ($rc,$out) = $self->exec_system($cmd);
706    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
707        $self->log_and_cont("INFO",$sub,"@{$cmd} came back with rc $rc, out $out");
708    }
709
710    if($rc == $okrc) {
711        $self->ok_msg($msg);
712        $rc = 1;
713    }
714    else {
715        $self->fail_msg("$msg,$out");
716        $rc = 0;
717    }
718
719    $self->leave_sub($sub);
720    return ($out,$rc);
721}
722
723# #915 - Just use chdir, and trap errors
724sub test_chdir( $$$$$ ) {
725    my($self,$type,$okrc,$msg,$dir) = @_;
726    my $sub = "test_chdir";
727    $self->enter_sub($sub);
728    my $rc = 0;
729
730    if( $okrc eq "" ) {
731        $okrc = 1;
732    }
733    $rc = chdir($dir);
734    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
735        $self->log_and_cont("INFO",$sub,"chdir'd to $dir with rc $rc");
736    }
737
738    if($rc == $okrc) {
739        $self->ok_msg($msg);
740        $rc = 1;
741    }
742    else {
743        $self->fail_msg($msg);
744        $rc = 0;
745    }
746
747    $self->leave_sub($sub);
748    return $rc;
749}
750
751# #915 - Just use chdir, and trap errors
752sub test_mkpath( $$$$$ ) {
753    my($self,$type,$okrc,$msg,$dir) = @_;
754    my $sub = "test_mkpath";
755    $self->enter_sub($sub);
756    my $rc = 0;
757
758    if( $okrc eq "" ) {
759        $okrc = 1;
760    }
761    eval { mkpath($dir) };
762    if($@) {
763        $rc = 0;
764    }
765    else {
766        $rc = $okrc;
767    }
768    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
769        $self->log_and_cont("INFO",$sub,"mkpath'd $dir with rc $rc");
770    }
771
772    if($rc == $okrc) {
773        $self->ok_msg($msg);
774        $rc = 1;
775    }
776    else {
777        $self->fail_msg($msg);
778        $rc = 0;
779    }
780
781    $self->leave_sub($sub);
782    return $rc;
783}
784
785# #915 - Just use chdir, and trap errors
786sub test_wwwmech( $$$$$$ ) {
787    my($self,$type,$okrc,$msg,$srcurl,$destfile) = @_;
788    my $sub = "test_wwwmech";
789    $self->enter_sub($sub);
790    my $rc = 0;
791    my $out;
792
793    if( $okrc eq "" ) {
794        $okrc = 1;
795    }
796    my $mech = WWW::Mechanize->new();
797    $mech->get("$srcurl", ':content_file' => "$destfile");
798    $rc = $mech->success();
799    $out = $mech->status();
800
801    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
802        $self->log_and_cont("INFO",$sub,"Fetched $srcurl to $destfile with rc $rc and output $out");
803    }
804
805    if($rc == $okrc) {
806        $self->ok_msg($msg);
807        $rc = 1;
808    }
809    else {
810        $self->fail_msg($msg);
811        $rc = 0;
812    }
813
814    $self->leave_sub($sub);
815    return $rc;
816}
817
818# #915 - Just use chmod, trap errors
819sub test_chmod( $$$$$$ ) {
820    my($self,$type,$okrc,$msg,$mode,$file) = @_;
821    my $sub = "test_chmod";
822    $self->enter_sub($sub);
823    my $rc = 0;
824
825    if( $okrc eq "" ) {
826        $okrc = 1;
827    }
828    $rc = chmod($mode,"$file");
829
830    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
831        $self->log_and_cont("INFO",$sub,"chmod'd $file to $mode");
832    }
833
834    if($rc == $okrc) {
835        $self->ok_msg($msg);
836        $rc = 1;
837    }
838    else {
839        $self->fail_msg($msg);
840        $rc = 0;
841    }
842
843    $self->leave_sub($sub);
844    return $rc;
845}
846
847# #915 - Just use chmod, trap errors
848sub test_unlink( $$$$$ ) {
849    my($self,$type,$okrc,$msg,$file) = @_;
850    my $sub = "test_unlink";
851    $self->enter_sub($sub);
852    my $rc = 0;
853
854    if( $okrc eq "" ) {
855        $okrc = 1;
856    }
857    $rc = unlink($file);
858    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
859        $self->log_and_cont("INFO",$sub,"unlink'd $file with rc $rc");
860    }
861
862    if($rc >= $okrc) {
863        $self->ok_msg($msg);
864        $rc = 1;
865    }
866    else {
867        $self->fail_msg($msg);
868        $rc = 0;
869    }
870
871    $self->leave_sub($sub);
872    return $rc;
873}
874
875# #915 - Do we even want this function? Goes against one-test-per-action philosophy. Use loop and trap errors instead
876sub test_unlinkall( $$$$$ ) {
877    my($self,$type,$okrc,$msg,$dir) = @_;
878    my $sub = "test_unlinkall";
879    $self->enter_sub($sub);
880    my $rc = 0;
881
882    if( $okrc eq "" ) {
883        $okrc = 1;
884    }
885    my @files = <$dir/*>;
886    $rc = unlink(@files);
887    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
888        $self->log_and_cont("INFO",$sub,"Unlink'd files in $dir with rc $rc");
889    }
890
891    $msg .= " Deleted $rc files out of $#files total files.";
892
893    if($rc >= $okrc && $rc == $#files) {
894        $self->ok_msg($msg);
895        $rc = 1;
896    }
897    else {
898        $self->fail_msg($msg);
899        $rc = 0;
900    }
901
902    $self->leave_sub($sub);
903    return $rc;
904}
905
906# #915 - Just use symlink, and trap errors
907sub test_symlink( $$$$$$ ) {
908    my($self,$type,$okrc,$msg,$srcfile,$destfile) = @_;
909    my $sub = "test_symlink";
910    $self->enter_sub($sub);
911    my $rc = 0;
912
913    if( $okrc eq "" ) {
914        $okrc = 1;
915    }
916    $rc = symlink($srcfile,$destfile);
917    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
918        $self->log_and_cont("INFO",$sub,"Symlink'd $srcfile to $destfile with rc $rc");
919    }
920
921    if($rc == $okrc) {
922        $self->ok_msg($msg);
923        $rc = 1;
924    }
925    else {
926        $self->fail_msg($msg);
927        $rc = 0;
928    }
929
930    $self->leave_sub($sub);
931    return $rc;
932}
933
934# #915 - Test separately, trap errors
935sub test_extract_cpio( $$$$$$ ) {
936    my($self,$type,$okrc,$msg,$extract_dir,$cpio_file) = @_;
937    my $sub = "test_extract_cpio";
938    $self->enter_sub($sub);
939    my $rc = 0;
940    my($CPIO_FILE,$CPIO_CMD,$cpio_cmd);
941
942    if( $okrc eq "" ) {
943        $okrc = 0;
944    }
945
946    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
947        $self->log_and_cont('INFO',$sub,"Opening $cpio_file for reading");
948    }
949
950    if(!defined(open($CPIO_FILE,'<',$cpio_file))) {
951        $self->log_and_cont("ERROR",$sub,"Failed to open $cpio_file for reading: $!\n");
952        return;
953    }
954
955    $cpio_cmd = [
956        '/bin/cpio',
957        '--make-directories',
958        '-i',
959        $extract_dir,
960        $cpio_file,
961    ];
962
963    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
964        $self->log_and_cont('INFO',$sub,"Opening @{$cpio_cmd} for writing");
965    }
966
967    if(!defined(open($CPIO_CMD,'|-',@{$cpio_cmd}))) {
968        $self->log_and_cont("ERROR",$sub,"Failed to open @{$cpio_cmd} for writing: $!\n");
969        return -1;
970    }
971
972    CPIO_WRITE:
973    while(my $data = <$CPIO_FILE>) {
974        if(!defined(print {$CPIO_CMD} $data)) {
975            $self->log_and_cont("ERROR",$sub,"Failed to write data from $cpio_file");
976            last CPIO_WRITE;
977        }
978    }
979
980    if(!defined(close($CPIO_FILE))) {
981        $self->log_and_cont('NOTICE',$sub,"Closing $cpio_file encountered problems: $!");
982    }
983
984    if(!defined(close($CPIO_CMD))) {
985        $self->log_and_cont("ERROR",$sub,"Closing @{$cpio_cmd} for writing failed: $!");
986    }
987
988    $rc = WEXITSTATUS($?);
989    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
990        $self->log_and_cont('INFO',$sub,"@{$cpio_cmd} finished with RC $rc");
991    }
992
993    if($rc != $okrc) {
994        $self->log_and_cont("ERROR",$sub,"@{$cpio_cmd} failed");
995    }
996
997    if($rc == $okrc) {
998        $self->ok_msg($msg);
999        $rc = 1;
1000    }
1001    else {
1002        $self->fail_msg($msg);
1003        $rc = 0;
1004    }
1005
1006    $self->leave_sub($sub);
1007    return $rc;
1008}
1009
1010# #915 - Just call copy, and trap errors
1011sub test_fcopy( $$$$$$ ) {
1012    my($self,$type,$okrc,$msg,$srcfile,$destfile) = @_;
1013    my $sub = "test_fcopy";
1014    $self->enter_sub($sub);
1015    my $rc = 0;
1016
1017    if( $okrc eq "" ) {
1018        $okrc = 1;
1019    }
1020
1021    $rc = copy($srcfile,$destfile);
1022    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1023        $self->log_and_cont("INFO",$sub,"Copied $srcfile to $destfile with rc $rc");
1024    }
1025
1026    if($rc == $okrc) {
1027        $self->ok_msg($msg);
1028        $rc = 1;
1029    }
1030    else {
1031        $self->fail_msg($msg);
1032        $rc = 0;
1033    }
1034
1035    $self->leave_sub($sub);
1036    return $rc;
1037}
1038
1039# #915 - Just call move, and trap errors
1040sub test_fmove( $$$$$$ ) {
1041    my($self,$type,$okrc,$msg,$srcfile,$destfile) = @_;
1042    my $sub = "test_fmove";
1043    $self->enter_sub($sub);
1044    my $rc = 0;
1045
1046    if( $okrc eq "" ) {
1047        $okrc = 1;
1048    }
1049    $rc = move($srcfile,$destfile);
1050    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1051        $self->log_and_cont("INFO",$sub,"Moved $srcfile to $destfile with rc $rc");
1052    }
1053
1054    if($rc == $okrc) {
1055        $self->ok_msg($msg);
1056        $rc = 1;
1057    }
1058    else {
1059        $self->fail_msg($msg);
1060        $rc = 0;
1061    }
1062
1063    $self->leave_sub($sub);
1064    return $rc;
1065}
1066
1067# #915 - Trap errors
1068sub test_getsvnrev( $$$$$ ) {
1069    my($self,$type,$okrc,$msg,$websvn) = @_;
1070    my $sub = "test_getsvnrev";
1071    $self->enter_sub($sub);
1072    my $rc = 0;
1073
1074    if( $okrc eq "" ) {
1075        $okrc = 1;
1076    }
1077    $rc = $self->get_svn_rev($websvn);
1078    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1079        $self->log_and_cont("INFO",$sub,"Got rev $rc from $websvn");
1080    }
1081
1082    if($rc >= $okrc) {
1083        $self->ok_msg($msg);
1084    }
1085    else {
1086        $self->fail_msg($msg);
1087        $rc = 0;
1088    }
1089
1090    $self->leave_sub($sub);
1091    return $rc;
1092}
1093
1094# #915 - Trap errors
1095sub test_fwrite( $$$$$$$ ) {
1096    my($self,$type,$okrc,$msg,$mode,$file,$text) = @_;
1097    my($sub,$FILE);
1098    $sub = "test_fwrite";
1099    $self->enter_sub($sub);
1100    my $rc = 0;
1101    my $temprc;
1102   
1103    if( $okrc eq "" ) {
1104        $okrc = 2;
1105    }
1106   
1107    if( "$mode" =~ /^w$/ ) {
1108        $rc += open($FILE, '>', $file) or $self->log_and_die("ERROR", $sub, "Opening file $file for replace&write failed with return $?: $!");
1109        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1110            $self->log_and_cont("INFO",$sub,"Opened file $file for replace&write.");
1111        }
1112    }
1113    elsif( "$mode" =~ m/^a$/ ) {
1114        $rc += open($FILE, '>>', $file) or $self->log_and_die("ERROR",$sub, "Opening file $file for appending failed with return $?, rc $rc: $!");
1115        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1116            $self->log_and_cont("INFO",$sub,"Opened file $file for appending.");
1117        }
1118    }
1119    else {
1120        $self->log_and_die("ERROR",$sub,"Unknown write option: $mode!");
1121    }
1122   
1123    $temprc = print $FILE "$text\n";
1124    $self->log_and_cont("WARN", $sub, "Writing to filehandle FILE (file $file) failed with return $?, rc $rc, errno $!.") if(!$temprc);
1125    $rc += $temprc;
1126    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1127        $self->log_and_cont("INFO",$sub,"Wrote text to filehandle FILE.");
1128    }
1129   
1130    $rc += close($FILE) or $self->log_and_die("ERROR", $sub,"Can't close file handle FILE (file $file): $!");
1131    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1132        $self->log_and_cont("INFO",$sub,"Closed filehandle FILE (file $file).");
1133    }
1134   
1135    if($rc >= $okrc) {
1136        $self->ok_msg($msg);
1137        $rc = 1;
1138    }
1139    else {
1140        $self->fail_msg($msg);
1141        $rc = 0;
1142    }
1143   
1144    $self->leave_sub($sub);
1145    return $rc;
1146}
1147
1148# #915 - Trap errors
1149sub test_revfetch( $$$$$$$ ) {
1150    my($self,$type,$okrc,$msg,$svnrev,$url,$destfile) = @_;
1151    my $sub = "test_revfetch";
1152    $self->enter_sub($sub);
1153    my $rc = 0;
1154    my($out,$cmd);
1155
1156    if( $okrc eq "" ) {
1157        $okrc = 0;
1158    }
1159
1160    $cmd = [
1161        'svn',
1162        'cat',
1163        '-r',
1164        $svnrev,
1165        $url,
1166        '>',
1167        $destfile,
1168    ];
1169    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1170        $self->log_and_cont("INFO",$sub,"Executing @{$cmd}");
1171    }
1172    ($rc,$out) = $self->exec_system($cmd);
1173    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1174        $self->log_and_cont("INFO",$sub,"@{$cmd} returned rc $rc with output $out");
1175    }
1176
1177    if($rc == $okrc) {
1178        $self->ok_msg($msg);
1179        $rc = 1;
1180    }
1181    else {
1182        $self->fail_msg("$msg: $out,$rc");
1183        $self->test_unlink($type,"","Unlinking $destfile from url $url at rev $svnrev due to failure.",$destfile);
1184        $rc = 0;
1185    }
1186
1187    $self->leave_sub($sub);
1188    return $rc;
1189}
1190
1191# #915 - Just call rename, trap errors
1192sub test_rename( $$$$$$ ) {
1193    my($self,$type,$okrc,$msg,$srcfile,$destfile) = @_;
1194    my $sub = "test_rename";
1195    $self->enter_sub($sub);
1196    my $rc;
1197
1198    if( $okrc eq "" ) {
1199        $okrc = 1;
1200    }
1201    $rc = rename("$srcfile","$destfile");
1202    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1203        $self->log_and_cont("INFO",$sub,"Renamed $srcfile to $destfile with rc $rc");
1204    }
1205
1206    if($rc == $okrc) {
1207        $self->ok_msg($msg);
1208        $rc = 1;
1209    }
1210    else {
1211        $self->fail_msg($msg);
1212        $rc = 0;
1213    }
1214
1215    $self->leave_sub($sub);
1216    return $rc;
1217}
1218
1219# #915 - Trap errors
1220sub test_recrevfetch( $$$$$$ ) {
1221    my($self,$type,$okrc,$msg,$svnrev,$svndir) = @_;
1222    my $sub = "test_recrevfetch";
1223    $self->enter_sub($sub);
1224    my($rc,$out,$cmd);
1225
1226    if( $okrc eq "" ) {
1227        $okrc = 0;
1228    }
1229
1230    $cmd = [
1231        'svn',
1232        '--force',
1233        'export',
1234        '-r',
1235        $svnrev,
1236        $svndir,
1237    ];
1238    ($rc,$out) = $self->exec_system($cmd);
1239    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1240        $self->log_and_cont("DEBUG",$sub,
1241            "Fetched from SVN with command @{$cmd} and rc $rc"
1242        );
1243    }
1244
1245    if($rc == $okrc) {
1246        $self->ok_msg($msg);
1247        $rc = 1;
1248    }
1249    else {
1250        $self->fail_msg($msg);
1251        $rc = 0;
1252    }
1253
1254    $self->leave_sub($sub);
1255    return $rc;
1256}
1257
1258# #915 - Call rmtree, trap errors
1259sub test_rmtree( $$$$$ ) {
1260    my($self,$type,$okrc,$msg,$dir) = @_;
1261    my $sub = "test_rmtree";
1262    $self->enter_sub($sub);
1263    my $rc;
1264
1265    if( $okrc eq "" ) {
1266        $okrc = 1;
1267    }
1268    $rc = rmtree("$dir",0,0);
1269    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1270        $self->log_and_cont("INFO",$sub,"Removed $dir tree with rc $rc");
1271    }
1272
1273    if($rc >= $okrc) {
1274        $self->ok_msg($msg);
1275        $rc = 1;
1276    }
1277    else {
1278        $self->fail_msg($msg);
1279        $rc = -1;
1280    }
1281
1282    $self->leave_sub($sub);
1283    return $rc;
1284}
1285
1286# #915 - Call getpwnam, trap errors
1287sub test_getuseruid( $$$$$ ) {
1288    my($self,$type,$okrc,$msg,$user) = @_;
1289    my $sub = "test_getuseruid";
1290    $self->enter_sub($sub);
1291    my $rc;
1292
1293    if( $okrc eq "" ) {
1294        $okrc = 1;
1295    }
1296
1297    (undef,undef,$rc,undef) = getpwnam("$user") or $self->log_and_die("ERROR",$sub,"Can't find $user in user database for user lookup: $!");
1298    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1299        $self->log_and_cont("INFO",$sub,"getpwnam $user returned with rc $rc");
1300    }
1301
1302    if($rc >= $okrc) {
1303        $self->ok_msg($msg);
1304    }
1305    else {
1306        $self->fail_msg($msg);
1307        $rc = -1;
1308    }
1309
1310    $self->leave_sub($sub);
1311    return $rc;
1312}
1313
1314# #915 - Call getpwnam, trap errors
1315sub test_getusergid( $$$$$ ) {
1316    my($self,$type,$okrc,$msg,$user) = @_;
1317    my $sub = "test_getusergid";
1318    $self->enter_sub($sub);
1319    my $rc;
1320
1321    if( $okrc eq "" ) {
1322        $okrc = 1;
1323    }
1324
1325    (undef,undef,undef,$rc) = getpwnam("$user") or $self->log_and_die("ERROR",$sub,"Can't find $user in user database for group lookup: $!");
1326    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1327        $self->log_and_cont("INFO",$sub,"getpwnam $user returned with rc $rc");
1328    }
1329
1330    if($rc >= $okrc) {
1331        $self->ok_msg($msg);
1332    }
1333    else {
1334        $self->fail_msg($msg);
1335        $rc = 0;
1336    }
1337
1338    $self->leave_sub($sub);
1339    return $rc;
1340}
1341
1342# #915 - Trap errors, use three-position open
1343sub test_lsofkill( $$$$$ ) {
1344    my($self,$type,$okrc,$msg,$dirname) = @_;
1345    my $sub = "test_lsofkill";
1346    $self->enter_sub($sub);
1347    my(@pids,@pnames,@lsof);
1348    my($ppid,$rc,$i);
1349    if( $okrc eq "" ) {
1350        $okrc = 1;
1351    }
1352   
1353    $rc = 0;
1354    open(my $LSOF, "lsof|") or $self->log_and_die("ERROR",$sub,"Opening lsof for piping failed with return $?, rc $rc: $!");
1355    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1356        $self->log_and_cont("INFO",$sub,"Running lsof|");
1357    }
1358    $rc += $?;
1359    if($self->is_log($DEBUG)) {
1360        $self->log_and_cont('DEBUG',$sub,"lsof ended with $rc");
1361    }
1362    while( @lsof = split('\s+', <$LSOF> ) ) {
1363        if($self->is_log($DEBUG)) {
1364            $self->log_and_cont("DEBUG",$sub,"Got @lsof from lsof");
1365        }
1366        if( $lsof[8] && $lsof[8] =~ m/$dirname/ && !($lsof[1] =~ m/(?:$$|getppid())/) && !($lsof[0] =~ m/lsof/) && !$self->in_list(\@pids,$lsof[1])  ) {
1367            if(($rc += kill(15,$lsof[1])) && $self->log_and_cont($INFO)) {
1368                $self->log_and_cont('INFO',$sub,"Killing $lsof[1] resulted in non-0 rc $rc");
1369            }
1370            if($self->is_log($INFO)) {
1371                $self->log_and_cont("INFO",$sub,"Killed $lsof[1]");
1372            }
1373            push(@pnames,$lsof[0]);
1374            push(@pids,$lsof[1]);
1375        }
1376    }
1377    $rc += close($LSOF);
1378    for($i=0;$i<$#pnames;$i++) {
1379        $msg .= " $pnames[$i]:$pids[$i]";
1380    }
1381    $msg .= "\n";
1382
1383    if($self->is_log($DEBUG)) {
1384        $self->log_and_cont('DEBUG',$sub,"Ending with rc $rc");
1385    }
1386   
1387    if($rc >= $okrc) {
1388        $self->ok_msg($msg);
1389        $rc = 1;
1390    }
1391    else {
1392        $self->fail_msg($msg);
1393        $rc = 0;
1394    }
1395
1396    $self->leave_sub($sub);
1397    return $rc;
1398}
1399
1400# #915 - Call chown, trap errors
1401sub test_chown( $$$$$$$ ) {
1402    my($self,$type,$okrc,$msg,$user,$group,$path) = @_;
1403    my $sub = "test_chown";
1404    $self->enter_sub($sub);
1405    my $rc;
1406
1407    if( $okrc eq "" ) {
1408        $okrc = 0;
1409    }
1410
1411    $rc = chown($user,$group,$path);
1412    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1413        $self->log_and_cont("INFO",$sub,"chown'd $path to $user:$group");
1414    }
1415
1416    if($rc > $okrc) {
1417        $self->ok_msg($msg);
1418    }
1419    else {
1420        $self->fail_msg($msg);
1421        $rc = -1;
1422    }
1423
1424    if($self->is_log($DEBUG)) {
1425        $self->log_and_cont("DEBUG",$sub,"Leaving test_chown");
1426    }
1427    return $rc;
1428}
1429
1430# #915 - Trap error
1431sub test_rsync( $$$$$$ ) {
1432    my($self,$type,$okrc,$msg,$src,$dst,$exclude_file) = @_;
1433    my $sub = "test_rsync";
1434    $self->enter_sub($sub);
1435    my($rc,$out,$cmd,$destdir);
1436
1437    if( $okrc eq "" ) {
1438        $okrc = 0;
1439    }
1440
1441    my $tmpdir = defined($ENV{WORKSPACE})
1442            ? $ENV{WORKSPACE}
1443            : "/tmp";
1444
1445    $cmd = [
1446        '/usr/bin/rsync',
1447        '-T',
1448        $tmpdir,
1449        '-xav',
1450        "--exclude-from=$exclude_file",
1451        $src,
1452        $dst,
1453    ];
1454   
1455    ($rc,$out) = $self->exec_system($cmd);
1456    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1457        $self->log_and_cont("INFO",$sub,"Ran @{$cmd} with rc $rc and output $out");
1458    }
1459
1460    if($rc == $okrc) {
1461        $self->ok_msg($msg);
1462        $rc = 1;
1463    }
1464    else {
1465        $self->fail_msg("$msg,$out");
1466        $rc = 0;
1467    }
1468
1469    $self->leave_sub($sub);
1470    return $rc;
1471}
1472
1473# #915 - Do logging here, can we use a function reference to condense this?
1474# Type will define what function is run
1475# This function should be moved into Dc.pm once all tests are entered
1476sub run_test {
1477    my $self = shift;
1478    my @args = @_;
1479    my $sub = "run_test";
1480    $self->enter_sub($sub);
1481    my $metatests = 3;
1482    my($rc,$out,$type,$okrc,$msg,$i);
1483    my @cmds;
1484
1485    if($#args < $metatests ) { # there must be at least one command
1486        $self->log_and_die("ERROR",$sub,"Not enough arguments to run_test! Minimum of $metatests.");
1487    }
1488
1489    $type = $args[0];
1490    $okrc = $args[1];
1491    $msg = $args[2];
1492
1493    @cmds = splice(@args,$metatests);
1494
1495    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1496        $self->log_and_cont("INFO",$sub,"Running test $type");
1497    }
1498    if( $type =~ m/^system$/ ) {
1499        if( $#cmds != 0 ) {
1500            $self->cmd_num_die(@cmds);
1501        }
1502        ($out,$rc) = $self->test_system($type,$okrc,$msg,$cmds[0]);
1503    }
1504    elsif( $type =~ m/^chdir$/ ) {
1505        if( $#cmds != 0 ) {
1506            $self->cmd_num_die(@cmds);
1507        }
1508        $rc = $self->test_chdir($type,$okrc,$msg,$cmds[0]);
1509    }
1510    elsif( $type =~ m/^mkpath$/ ) {
1511        if( $#cmds != 0 ) {
1512            $self->cmd_num_die(@cmds);
1513        }
1514        $rc = $self->test_mkpath($type,$okrc,$msg,$cmds[0]);
1515    }
1516    elsif( $type =~ m/^wwwmech$/ ) {
1517        if( $#cmds != 1 ) {
1518            $self->cmd_num_die(@cmds);
1519        }
1520        $rc = $self->test_wwwmech($type,$okrc,$msg,$cmds[0],$cmds[1]);
1521    }
1522    elsif( $type =~ m/^chmod$/ ) {
1523        if( $#cmds != 1 ) {
1524            $self->cmd_num_die(@cmds);
1525        }
1526        $rc = $self->test_chmod($type,$okrc,$msg,$cmds[0],$cmds[1]);
1527    }
1528    elsif( $type =~ m/^unlink$/ ) {
1529        if( $#cmds != 0 ) {
1530            $self->cmd_num_die(@cmds);
1531        }
1532        $rc = $self->test_unlink($type,$okrc,$msg,$cmds[0]);
1533    }
1534    elsif( $type =~ m/^unlinkall$/ ) {
1535        if( $#cmds != 0 ) {
1536                $self->cmd_num_die(@cmds);
1537        }
1538        $rc = $self->test_unlinkall($type,$okrc,$msg,$cmds[0]);
1539    }
1540    elsif( $type =~ m/^symlink$/ ) {
1541        if( $#cmds != 1 ) {
1542            $self->cmd_num_die(@cmds);
1543        }
1544        $rc = $self->test_symlink($type,$okrc,$msg,$cmds[0],$cmds[1]);
1545    }
1546    elsif ( $type =~ m/^fcopy$/ ) {
1547        if( $#cmds != 1 ) {
1548            $self->cmd_num_die(@cmds);
1549        }
1550        $rc = $self->test_fcopy($type,$okrc,$msg,$cmds[0],$cmds[1]);
1551    }
1552    elsif( $type =~ m/^getsvnrev$/ ) {
1553        if( $#cmds != 0 ) {
1554            $self->cmd_num_die(@cmds);
1555        }
1556        $rc = $self->test_getsvnrev($type,$okrc,$msg,$cmds[0]);
1557    }
1558    elsif( $type =~ m/^fwrite$/ ) {
1559        if( $#cmds != 2 ) {
1560            $self->cmd_num_die(@cmds);
1561        }
1562        $rc = $self->test_fwrite($type,$okrc,$msg,$cmds[0],$cmds[1],$cmds[2]);
1563    }
1564    elsif( $type =~ m/^revfetch$/ ) {
1565        if( $#cmds != 2 ) {
1566            $self->cmd_num_die(@cmds);
1567        }
1568        $rc = $self->test_revfetch($type,$okrc,$msg,$cmds[0],$cmds[1],$cmds[2]);
1569    }
1570    elsif( $type =~ m/^recrevfetch$/ ) {
1571        if( $#cmds != 1 ) {
1572            $self->cmd_num_die(@cmds);
1573        }
1574        $rc = $self->test_recrevfetch($type,$okrc,$msg,$cmds[0],$cmds[1]);
1575    }
1576    elsif( $type =~ m/^rename$/ ) {
1577        if( $#cmds != 1 ) {
1578            $self->cmd_num_die(@cmds);
1579        }
1580        $rc = $self->test_rename($type,$okrc,$msg,$cmds[0],$cmds[1]);
1581    }
1582    elsif( $type =~ m/^rmtree$/ ) {
1583        if($#cmds != 0) {
1584            $self->cmd_num_die(@cmds);
1585        }
1586        $rc = $self->test_rmtree($type,$okrc,$msg,$cmds[0]);
1587    }
1588    elsif( $type =~ m/^lsofkill$/ ) {
1589        if( $#cmds != 0 ) {
1590            $self->cmd_num_die(@cmds);
1591        }
1592        $rc = $self->test_lsofkill($type,$okrc,$msg,$cmds[0]);
1593    }
1594    elsif( $type =~ m/^getuseruid$/ ) {
1595        if( $#cmds != 0 ) {
1596            $self->cmd_num_die(@cmds);
1597        }
1598        $rc = $self->test_getuseruid($type,$okrc,$msg,$cmds[0]);
1599    }
1600    elsif( $type =~ m/getusergid$/ ) {
1601        if( $#cmds != 0 ) {
1602            $self->cmd_num_die(@cmds);
1603        }
1604        $rc = $self->test_getusergid($type,$okrc,$msg,$cmds[0]);
1605    }
1606    elsif( $type =~ m/^chown$/ ) {
1607        if( $#cmds != 2 ) {
1608            $self->cmd_num_die(@cmds);
1609        }
1610        $rc = $self->test_chown($type,$okrc,$msg,$cmds[0],$cmds[1],$cmds[2]);
1611    }
1612    elsif( $type =~ m/^extract_cpio$/ ) {
1613        if( $#cmds != 1 ) {
1614            $self->cmd_num_die(@cmds);
1615        }
1616        $rc = $self->test_extract_cpio($type,$okrc,$msg,$cmds[0],$cmds[1]);
1617    }
1618    elsif( $type =~ m/^fmove$/ ) {
1619        if( $#cmds != 1 ) {
1620            $self->cmd_num_die(@cmds);
1621        }
1622        $rc = $self->test_fmove($type,$okrc,$msg,$cmds[0],$cmds[1]);
1623    }
1624    elsif( $type =~ m/^rsync$/ ) {
1625        if( $#cmds != 2 ) {
1626            $self->cmd_num_die(@cmds);
1627        }
1628        $rc = $self->test_rsync($type,$okrc,$msg,$cmds[0],$cmds[1],$cmds[2]);
1629    }
1630    elsif($type =~ m/^rm_lvm$/ ) {
1631        $rc = $self->test_rm_lvm($type,$okrc,$msg);
1632    }
1633    elsif($type =~ m/^regexsub_file$/) {
1634        if( $#cmds != 2 ) {
1635            $self->cmd_num_die(@cmds);
1636        }
1637        $rc = $self->test_regexsub_file($type,$okrc,$msg,$cmds[0],$cmds[1],$cmds[2]);
1638    }
1639        elsif($type =~ m/^read_yaml$/) {
1640                if( $#cmds != 0 ) {
1641                        $self->cmd_num_die(@cmds);
1642                }
1643                $rc = $self->test_read_yaml($type,$okrc,$msg,$cmds[0]);
1644        }
1645        elsif($type =~ m/^mknods$/) {
1646                if( $#cmds != 1 ) {
1647                        $self->cmd_num_die(@cmds);
1648                }
1649                $rc = $self->test_mknods($type,$okrc,$msg,$cmds[0],$cmds[1]);
1650        }
1651    elsif($type =~ m/^md5file$/) {
1652        if( $#cmds != 1 ) {
1653            $self->cmd_num_die(@cmds);
1654        }
1655        $rc = $self->test_md5file($type,$okrc,$msg,$cmds[0],$cmds[1]);
1656    }
1657    else {
1658        $self->log_and_die("ERROR",$sub,"This is an undefined test: $type!");
1659    }
1660
1661    if($self->is_log($DEBUG)) {
1662        $self->log_and_cont('DEBUG',$sub,"Got RC $rc from $type");
1663    }
1664
1665    $self->incr_total();
1666    if($rc) {
1667        $self->incr_passed();
1668        if($self->is_log($DEBUG)) {
1669            $self->log_and_cont('DEBUG',$sub,"Passed $type");
1670        }
1671    }
1672    else {
1673        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1674            $self->log_and_cont('INFO',$sub,"Failed to pass $type");
1675        }
1676    }
1677
1678    $self->leave_sub($sub);   
1679    if(defined($out)) {
1680        return($out,$rc);
1681    } else {
1682        return $rc;
1683    }
1684}
1685
1686# #915 - Croak on error
1687sub exec_system( $$ ) {
1688    my($self,$cmd) = @_;
1689    my $sub = "exec_system";
1690    my $CMD;
1691    $self->enter_sub($sub);
1692    my($out,$rc);
1693
1694    open($CMD, '-|',@{$cmd});
1695    while(my $line = <$CMD>) {
1696        chomp $line;
1697        $out .= "$line\n";
1698    }
1699    close($CMD);
1700    $rc = WEXITSTATUS($?);
1701
1702    if(!defined($out)) {
1703        $out = '<NO OUTPUT>';
1704    }
1705
1706    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1707        $self->log_and_cont("INFO",$sub,"Ran ".Dumper($cmd)."with rc $rc and output $out");
1708    }
1709
1710    $self->leave_sub($sub);
1711    return ($rc,$out);
1712}
1713
1714# #915 - Use Data::Dumper instead
1715sub print_hash ( $% ) {
1716    my($self,%h) = @_;
1717    my $sub = "print_hash";
1718    $self->enter_sub($sub);
1719   
1720    foreach my $k (sort keys %h) {
1721        print "$k => $h{$k}\n";
1722    }
1723    $self->leave_sub($sub);
1724}
1725
1726# #915 - Just do this in the Mech
1727sub mech_error( $$ ) {
1728    my($self,$mech) = @_;
1729    my $sub = "mech_error";
1730    $self->enter_sub($sub);
1731    $self->leave_sub($sub);
1732    return "HTTP status: ".$mech->status."\n";
1733}
1734
1735# #915 - Look at a List::* for an equivalent
1736sub in_list( $$$ ) {
1737    my($self,$list_ref,$s) = @_;
1738    my $sub = "in_list";
1739    $self->enter_sub($sub);
1740    my @list = @{$list_ref};
1741
1742    if( $#list > 0 ) {
1743        foreach my $x ( @list ) {
1744            if( "$x" eq "$s" ) {
1745                $self->leave_sub($sub);
1746                return 1;
1747            }
1748        }
1749        $self->leave_sub($sub);
1750        return 0;
1751    }
1752    else {
1753        $self->leave_sub($sub);
1754        return 0;
1755    }
1756}
1757
1758sub get_stage( $ ) {
1759    my($self) = @_;
1760    my $sub = "get_state";
1761    $self->enter_sub($sub);
1762    if( !(-f "/etc/$PROJECT-stage") ) {
1763        $self->leave_sub($sub);
1764        return "BUILD"; # Should only true for build system
1765    }
1766
1767    $self->leave_sub($sub);
1768    return $self->snarf_file("/etc/$PROJECT-stage");
1769}
1770
1771# #915 - Croak on error
1772sub get_svn_rev( $$ ) {
1773    my($self,$svnurl) = @_;
1774    my $sub = "get_svn_rev";
1775    $self->enter_sub($sub);
1776    my $mech = WWW::Mechanize->new();
1777   
1778    $mech->get($svnurl);
1779    if( !$mech->success() ) {
1780        $self->log_and_die("ERROR","get_svn_rev","Could not fetch $svnurl: $mech->status()!");
1781    }
1782
1783    $self->leave_sub($sub);
1784    if( ($mech->content( format => 'text' )) =~ m/^svn\s-\sRevision\s+(\d+):/ ) {
1785        return $1;
1786    }
1787
1788    return 0;
1789}
1790
1791# #915 - Croak on error
1792sub get_rev( $ ) {
1793    my($self) = @_;
1794    my $sub = "get_rev";
1795    $self->enter_sub($sub);
1796
1797    if( !(-f "/etc/$PROJECT-revision") ) {
1798        $self->leave_sub($sub);
1799        return 0; # Invalid for build system
1800    }
1801
1802    $self->leave_sub($sub);
1803    return $self->snarf_file("/etc/$PROJECT-revision");
1804}
1805
1806sub get_project( $ ) {
1807    my($self) = @_;
1808    my $sub = 'get_project';
1809    $self->enter_sub($sub);
1810
1811    $self->leave_sub($sub);
1812    return $PROJECT;
1813}
1814
1815sub get_passed( $ ) {
1816    my $self = shift;
1817    my $sub = "get_passed";
1818    $self->enter_sub($sub);
1819    $self->leave_sub($sub);
1820    return $passed;
1821}
1822
1823sub get_total( $ ) {
1824    my $self = shift;
1825    my $sub = "get_total";
1826    $self->enter_sub($sub);
1827    $self->leave_sub($sub);
1828    return $total;
1829}
1830
1831sub incr_passed {
1832    my $self = shift;
1833    my $sub = "incr_passed";
1834    $self->enter_sub($sub);
1835    $self->leave_sub($sub);
1836    $passed++;
1837    return $passed;
1838}
1839
1840sub incr_total( $ ) {
1841    my $self = shift;
1842    my $sub = "incr_total";
1843    $self->enter_sub($sub);
1844    $self->leave_sub($sub);
1845    $total++;
1846}
1847
1848sub ok_msg( $$ ) {
1849    my($self,$msg) = @_;
1850    my $sub = "ok_msg";
1851    $self->enter_sub($sub);
1852    $self->leave_sub($sub);
1853    print "ok ".get_total($self)." - $msg\n";
1854}
1855
1856sub fail_msg( $$ ) {
1857    my($self,$msg) = @_;
1858    my $sub = "fail_msg";
1859    $self->enter_sub($sub);
1860    $self->leave_sub($sub);
1861    print "not ok ".get_total($self)." - $msg\n";
1862}
1863
1864sub redirect_stdio( $ ) {
1865    my $self = shift;
1866    my $sub = "redirect_stdio";
1867    $self->enter_sub($sub);
1868    my($outdir) = @_;
1869    open(STDOUT, '>', "$outdir/$ALLOUTFILE") or
1870        $self->log_and_die("ERROR","redirect_stdio","Can't open file $outdir/$ALLOUTFILE: $!");
1871    open(STDERR, ">&STDOUT");
1872    $self->leave_sub($sub);
1873}
1874
1875sub close_stdio( $ ) {
1876    my $self = shift;
1877    my $sub = "close_stdio";
1878    $self->enter_sub($sub);
1879    close(STDERR);
1880    close(STDOUT);
1881    $self->leave_sub($sub);
1882}
1883
1884sub get_lvmroot( $ ) {
1885    my $self = shift;
1886    my $sub = "get_lvmroot";
1887    $self->enter_sub($sub);
1888
1889    $self->leave_sub($sub);
1890    return $LVMROOT;
1891}
1892
1893# #915 - Use text tags instead
1894sub set_debug( $$ ) {
1895    my($self,$log) = @_;
1896    my $sub = "set_debug";
1897    $self->enter_sub($sub);
1898    if($log eq 'INFO') {
1899        $LOG |= $INFO;
1900    }
1901    elsif($log eq 'DEBUG') {
1902        $LOG |= $DEBUG;
1903    }
1904    else {
1905        $self->log_and_cont("WARN","set_debug","Unknown log setting $log");
1906    }
1907    $self->leave_sub($sub);
1908}
1909
1910sub unset_debug( $$ ) {
1911    my($self,$log) = @_;
1912    my $sub = "unset_debug";
1913    $self->enter_sub($sub);
1914    if($log eq 'INFO') {
1915        $LOG &= ~$INFO;
1916    }
1917    elsif($log eq 'DEBUG') {
1918        $LOG &= ~$DEBUG;
1919    }
1920    else {
1921        $self->log_and_cont("WARN","unset_debug","Unknown log setting $log");
1922    }
1923    $self->leave_sub($sub);
1924}
1925
1926# No debug statements to avoid circular references now
1927sub is_log( $$ ) {
1928    my($self,$log) = @_;
1929    return ($LOG & $log);
1930}
1931
1932# Fetch from /proc/cmdline
1933sub get_cmdline( $ ) {
1934    my($self) = @_;
1935    my $sub = "get_cmdline";
1936    $self->enter_sub($sub);
1937    $self->leave_sub($sub);
1938    return $self->snarf_file("$CMDLINE_FILE");
1939}
1940
1941# Parse a value-key tuple out of /proc/cmdline
1942sub parse_cmdline( $$ ) {
1943    my($self,$key) = @_;
1944    my($sub,$cmdline,$value);
1945    $sub = "parse_cmdline";
1946    $self->enter_sub($sub);
1947
1948    foreach my $line ( split('\s+',$self->get_cmdline() ) ) {
1949        if( $line =~ m/^$key="?(.*?)"?$/ ) {
1950            return $1;
1951        }
1952        elsif($line =~ m/$key/) {
1953            return 1;
1954        }
1955    }
1956
1957    $self->leave_sub($sub);
1958    return 0;
1959}
1960
1961sub parse_nic_conf( $$ ) {
1962    my($self,$cmdline) = @_;
1963    my $sub = "parse_nic_conf";
1964    $self->enter_sub($sub);
1965    my @nicsconf;
1966
1967    if($cmdline =~ m/nics=\"(.*)\"/) {
1968        @nicsconf = split ':', $1;
1969    } else {
1970        $self->leave_sub($sub);
1971        return @nicsconf;
1972    }
1973   
1974    $self->leave_sub($sub);
1975    return @nicsconf;
1976}
1977
1978sub get_eth_nics( $ ) {
1979    my($self) = @_;
1980    my $sub = "get_eth_nics";
1981    $self->enter_sub($sub);
1982    my @nics;
1983
1984    # Find all NICs in /sys/class/net except lo
1985    foreach my $nic_dir (grep { !/(\.{1,2}|lo)$/ } </sys/class/net/*>) {
1986        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1987            $self->log_and_cont("INFO",$sub,"Found NIC dir $nic_dir")
1988        }
1989        # Only add non-wireless NICs
1990        if( ! -d "$nic_dir/wireless" ) {
1991            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
1992                $self->log_and_cont('INFO',$sub,"NIC dir $nic_dir is wireline, pushing");
1993            }
1994            push(@nics,basename($nic_dir));
1995        }
1996    }
1997   
1998    $self->leave_sub($sub);
1999
2000    return @nics;
2001}
2002
2003sub flash_nic( $$$ ) {
2004    my($self,$nic,$sec) = @_;
2005    my $sub = "flash_nic";
2006    $self->enter_sub($sub);
2007    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
2008        $self->log_and_cont("INFO",$sub,"Flashing NIC $nic for $sec seconds.");
2009    }
2010    $self->exec_system([
2011            'ethtool',
2012            '-p',
2013            $nic,
2014            $sec,
2015        ]
2016    );
2017    $self->leave_sub($sub);
2018    return WEXITSTATUS($?);
2019}
2020
2021sub nic_dialog {
2022    my($self) = @_;
2023    my @nics;
2024    my $sub='nic_dialog';
2025    my $d = new UI::Dialog (backtitle => "Configure NICS",
2026                            listheight => 10, height => 20);
2027   
2028    foreach my $nic ($self->get_eth_nics()) {
2029        push(@nics,($nic,["",0]));
2030    }
2031   
2032    my @chosen_nics = $d->checklist(text => "Pick NICs to configure.",
2033                                    list => \@nics);
2034    if(!$self->is_dialog_ok($d)) {
2035        return;
2036    }
2037   
2038    foreach my $nic (@chosen_nics) {
2039        $self->{nic_conf}->{$nic} = $self->config_nic_dialog($d,$nic);
2040        if(!defined($self->{nic_conf}->{$nic})) {
2041            return;
2042        }
2043    }
2044   
2045    $self->config_interfaces();
2046   
2047    return 1;
2048}
2049
2050sub require_bccd_server {
2051    my($self) = @_;
2052    my($sub,$dhc,$replace,$rc);
2053    $sub='require_bccd_server';
2054
2055        $rc = 0;
2056
2057        $rc += $self->run_test('unlink','','Unlinking dhclient.conf for BCCD.',$DHCFILE);
2058        $rc += $self->run_test('symlink','','Relinking dhclient.conf for BCCD.',"$DHCFILE-bccd",$DHCFILE);
2059
2060        return $rc;
2061}
2062
2063sub unrequire_bccd_server {
2064    my($self) = @_;
2065    my($sub,$dhc,$replace,$rc);
2066    $sub='unrequire_bccd_server';
2067
2068        $rc = 0;
2069
2070        $rc += $self->run_test('unlink','','Unlinking dhclient.conf for BCCD.',$DHCFILE);
2071        $rc += $self->run_test('symlink','','Relinking dhclient.conf for BCCD.',"$DHCFILE-any",$DHCFILE);
2072
2073        return $rc;
2074}
2075
2076sub config_interfaces{
2077    my($self) = @_;
2078    my($sub,$rc);
2079    my @auto;
2080    $sub='config_interfaces';
2081        $self->enter_sub($sub);
2082
2083    if($self->is_log($DEBUG)) {
2084        $self->log_and_cont('DEBUG',$sub,"Configuring interfaces ".
2085            Dumper($self->{nic_conf}));
2086    }
2087   
2088    open(my $INT, '>', $INTFILE) or
2089        $self->log_and_die("ERROR",$sub,"Couldn't open $INTFILE: $!");
2090   
2091    push(@auto,'lo');
2092    print $INT "iface lo inet loopback\n\n";
2093
2094    foreach my $nic (keys(%{$self->{nic_conf}})) {
2095        if($self->{nic_conf}->{$nic}->{'dhcp'}) {
2096            if($self->is_log($DEBUG)) {
2097                $self->log_and_cont('DEBUG',$sub,"Pushing DHCP $nic onto auto stack");
2098            }
2099            push(@auto,$nic);
2100            print $INT "iface $nic inet dhcp\n\n";
2101            if(defined($self->{nic_conf}->{$nic}->{'dhcp_source'})
2102                                && $self->{nic_conf}->{$nic}->{'dhcp_source'} eq 'BCCD') {
2103                if($self->require_bccd_server() > 2) {
2104                    $self->log_and_die("ERROR",$sub,"Couldn't set BCCD server in dhclient.");
2105                }
2106            }
2107            else {
2108                if($self->unrequire_bccd_server() > 2) {
2109                    $self->log_and_die("ERROR",$sub,"Couldn't unset BCCD server in dhclient.");
2110                }
2111            }
2112        }
2113        if(defined($self->{nic_conf}->{$nic}->{'ipaddr'})
2114                        && defined($self->{nic_conf}->{$nic}->{'mask'})) {
2115            if($self->is_log($DEBUG)) {
2116                $self->log_and_cont('DEBUG',$sub,"Pushing static $nic onto auto stack");
2117            }
2118
2119            push(@auto,$nic);
2120            print $INT "iface $nic inet static\n";
2121            print $INT "\taddress $self->{nic_conf}->{$nic}->{'ipaddr'}\n";
2122            print $INT "\tnetmask $self->{nic_conf}->{$nic}->{'mask'}\n";
2123            if(defined($self->{nic_conf}->{$nic}->{'bcast'})) {
2124                print $INT "\tbroadcast $self->{nic_conf}->{$nic}->{'bcast'}\n";
2125            }
2126            if(defined($self->{nic_conf}->{$nic}->{'gw'})) {
2127                print $INT "\tgateway $self->{nic_conf}->{$nic}->{'gw'}\n";
2128            }
2129        }
2130    }
2131    @auto = sort(uniq(@auto));
2132    print $INT "auto @auto\n";
2133    close($INT);
2134    $self->leave_sub($sub);
2135
2136        return 1;
2137}
2138
2139sub check_bccd_net{
2140        my($self) = @_;
2141        my $sub = 'check_bccd_net';
2142
2143        foreach my $nic (keys(%{$self->{nic_conf}})) {
2144                if(defined($self->{nic_conf}->{$nic}->{'dhcp_source'}) &&
2145                        $self->{nic_conf}->{$nic}->{dhcp_source} eq 'BCCD') {
2146                        return 1;
2147                }
2148        }
2149
2150        return;
2151}
2152
2153sub config_dhcp{
2154    my($self) = @_;
2155    my($sub,$pubnetip,$j,$oneip,$file,$pubnet,$pxenet,$havedhcp,
2156       $bcast,$mask,$i,$rc,$out,$pxenic,$pxenetip,$addr,$dhcpnic,
2157       $destfile);
2158    $sub = 'config_dhcp';
2159
2160    if($self->is_log($DEBUG)) {
2161        $self->log_and_cont('DEBUG',$sub,"Processing NICs for DHCP ".
2162            Dumper($self->{nic_conf}));
2163    }
2164   
2165    $havedhcp = 0;
2166  FIND_PXE_NIC:
2167    foreach my $nic (keys(%{$self->{nic_conf}})) {
2168        if(defined($self->{nic_conf}->{$nic}->{'pxenic'})) {
2169            $pxenic = $nic;
2170            last FIND_PXE_NIC;
2171        }
2172    }
2173   
2174    foreach my $nic (keys(%{$self->{nic_conf}})) {
2175        if(defined($self->{nic_conf}->{$nic}->{'dhcp_source'}) &&
2176           $self->{nic_conf}->{$nic}->{'dhcp_source'} eq 'BCCD') {
2177            $havedhcp = 1;
2178        }
2179    }
2180   
2181  HAVE_DHCP:
2182  foreach my $nic (keys(%{$self->{nic_conf}})) {
2183      if($self->is_log($DEBUG)) {
2184          $self->log_and_cont('DEBUG',$sub,"Processing $nic to find BCCD net");
2185      }
2186      if(defined($self->{nic_conf}->{$nic}->{'bccdnet'})) {
2187          if($self->is_log($INFO) || $self->is_log($DEBUG)) {
2188            $self->log_and_cont('INFO',$sub,"$nic has BCCD net");
2189          }
2190          $dhcpnic = $nic;
2191          last HAVE_DHCP;
2192      }
2193  }
2194  if(!defined($dhcpnic)) {
2195      $self->log_and_die('ERROR',$sub,"No NIC available for BCCD");
2196  }
2197
2198  if(defined($pxenic)) {
2199      $pxenetip = new NetAddr::IP($self->{nic_conf}->{$pxenic}->{'ipaddr'},
2200          $self->{nic_conf}->{$pxenic}->{'mask'}) ||
2201      $self->log_and_die("ERROR",$sub,"Couldn't create network "
2202          ."IP object for $self->{nic_conf}->{$pxenic}->{'ipaddr'}: $!");
2203      if(!defined($self->{nic_conf}->{$pxenic}->{'gw'})) {
2204          $self->{nic_conf}->{$pxenic}->{'gw'}
2205          = $self->{nic_conf}->{$pxenic}->{'ipaddr'};
2206      }
2207  }
2208  $pubnetip=new NetAddr::IP($BCCD_NET->{'ipaddr'},$BCCD_NET->{'mask'}) ||
2209        $self->log_and_die("ERROR",$sub,"Couldn't create network IP object for $BCCD_NET->{'ipaddr'}: $!");
2210   
2211    $oneip=new NetAddr::IP('0.0.0.1') || # Addition doesn't work the way it should
2212        $self->log_and_die("ERROR",$sub,"Couldn't create singleton IP object: $!");
2213   
2214    $pubnet->{'network'} = $pubnetip->network();
2215    $pubnet->{'network'} =~ s/\/\d+$//g;
2216    $pubnet->{'bcast'} = $pubnetip->broadcast();
2217    $pubnet->{'bcast'} =~ s/\/\d+$//g;
2218    $pubnet->{'mask'} = $pubnetip->mask();
2219    if(defined($pxenic)) {
2220        $pxenet->{'network'} = $pxenetip->network();
2221        $pxenet->{'network'} =~ s/\/\d+$//g;
2222        $pxenet->{'bcast'} = $pxenetip->broadcast();
2223        $pxenet->{'bcast'} =~ s/\/\d+$//g;
2224        $pxenet->{'mask'} = $pxenetip->mask();
2225        $pxenet->{'next'} = $pxenetip->addr();
2226        $pxenet->{'first'} = $pxenetip->first();
2227        $pxenet->{'first'} =~ s/\/\d+$//g;
2228        $pxenet->{'last'} = $pxenetip->last();
2229        $pxenet->{'last'} =~ s/\/\d+$//g;
2230    }
2231   
2232    $pubnet->{'dhcprange'} = "$DHCP_RANGES->{'res'} $DHCP_RANGES->{'dhcp'}";
2233   
2234    if(defined($pxenic)) {
2235        $i = 0;
2236        while( $pxenetip->addr() ne $pxenet->{'last'} ) {
2237            $pxenetip++;
2238            if($i == 10) {
2239                $pxenet->{'firstip'} = $pxenetip->addr();
2240            }
2241            elsif($i == 100) {
2242                $pxenet->{'lastip'} = $pxenetip->addr();
2243                last;
2244            }
2245            $i++;
2246        }
2247        if(!defined($pxenet->{'firstip'}) || !defined($pxenet->{'lastip'})) {
2248            $self->log_and_die("ERROR",$sub,"No PXE IP range defined!");
2249        }
2250    }
2251
2252    open(my $DCONF,'>',$DHCP_CONF) ||
2253        $self->log_and_die("ERROR",$sub,"Can't open file $DHCP_CONF: $!");
2254   
2255    if(defined($pxenic)) {
2256        print $DCONF "subnet $pxenet->{'network'} netmask $pxenet->{'mask'} {\n";
2257        print $DCONF "\toption subnet-mask $pxenet->{'mask'};\n";
2258        print $DCONF "\toption broadcast-address $pxenet->{'bcast'};\n";
2259        print $DCONF "\toption routers $self->{nic_conf}->{$pxenic}->{'gw'};\n";
2260        print $DCONF "\tpool {\n";
2261        print $DCONF "\t\trange $pxenet->{'firstip'} $pxenet->{'lastip'};\n";
2262        print $DCONF "\t\tdeny members of \"ignored-nodes\";\n";
2263        print $DCONF "\t\tallow members of \"pxelinux-nodes\";\n";
2264        print $DCONF "\t\tfilename \"pxelinux.0\";\n";
2265        print $DCONF "\t\tnext-server $self->{nic_conf}->{$pxenic}->{'ipaddr'};\n";
2266        print $DCONF "\t\toption root-path \"$self->{nic_conf}->{$pxenic}->{'ipaddr'}:/,nfsvers=3,tcp,hard\";\n";
2267        print $DCONF "\t}\n";
2268        print $DCONF "}\n";
2269
2270        open(my $PCONF, '>', $PXELINUX) ||
2271            $self->log_and_die("ERROR",$sub,"Can't open file $PXELINUX: $!");
2272       
2273        print $PCONF "default bccd\n";
2274        print $PCONF "label bccd\n";
2275        print $PCONF "\tkernel vmlinuz-$KERNREV\n";
2276        print $PCONF "\tappend ETHERNET=eth0 initrd=initrd.img-$KERNREV "
2277                        ."root=/dev/nfs nfsroot=$self->{nic_conf}->{$pxenic}->{'ipaddr'}:/ "
2278                        ."ip=dhcp net.ifnames=0 init=/sbin/init vga=791 lang=us\n";
2279       
2280        close($PCONF);
2281                if(-d "/diskless/$PROJECT") {
2282                open(my $FCONF, '>', $DISKLESS_FSTAB) ||
2283                        $self->log_and_die("ERROR",$sub,"Can't open file $DISKLESS_FSTAB: $!");
2284                   
2285            # Add shared (non-aufs) home directory
2286                print $FCONF "$self->{nic_conf}->{$pxenic}->{'ipaddr'}:/home  "
2287                                ."/home   nfs     "
2288                                ."nfsvers=3,tcp,rsize=32768,wsize=32768,hard,intr 0 0\n";
2289            # Mount /sysfs for power management (#770)
2290            print $FCONF "none    /sys    sysfs   defaults 0 0\n";
2291                   
2292                close($FCONF);
2293        }
2294    }
2295# If we have no IP address mask will not be set, and we should not generate
2296# a DHCP config
2297    else {
2298        print $DCONF "allow bootp;\nallow booting;\n\n";
2299                print $DCONF "# This is a total hack to get DHCP to work with interface aliases\n";
2300                print $DCONF "subnet $BCCD_NET->{'net'} netmask $BCCD_NET->{'mask'} {\n\n";
2301                print $DCONF "authoritative;\n";
2302        print $DCONF "\toption subnet-mask $pubnet->{'mask'};\n";
2303        print $DCONF "\toption broadcast-address $pubnet->{'bcast'};\n";
2304        print $DCONF "\toption routers $BCCD_NET->{'ipaddr'};\n";
2305        print $DCONF "\tpool {\n";
2306        print $DCONF "\t\tdeny members of \"ignored-nodes\";\n";
2307        print $DCONF "\t\tallow members of \"bccd-nodes\";\n";
2308        print $DCONF "\t\trange $pubnet->{'dhcprange'};\n";
2309        print $DCONF "\t}\n";
2310        print $DCONF "}\n";
2311       
2312                # Include the base NIC (no alias) as well
2313                my $base_dhcpnic = $dhcpnic;
2314                $base_dhcpnic =~ s{:\d+$}{};
2315
2316        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
2317            $self->log_and_cont('INFO',$sub,"Processing $dhcpnic, $base_dhcpnic");
2318        }
2319       
2320        my $base_dhcpnic_ip
2321            = new NetAddr::IP($self->{nic_conf}->{$base_dhcpnic}->{'ipaddr'},
2322            $self->{nic_conf}->{$base_dhcpnic}->{'mask'});
2323                # Just get the network address, not the mask
2324                my $network = $base_dhcpnic_ip->network();
2325                $network =~ s{/\d+$}{};
2326       
2327            close($DCONF);
2328
2329        # isc-dhcp-server init script will not start unless an interface is set in this file (#1001)
2330        open(my $DEFAULT_DCONF,'>',$DEFAULT_DHCP_CONF) ||
2331            $self->log_and_die("ERROR",$sub,"Can't open file $DEFAULT_DHCP_CONF: $!");
2332
2333        print $DEFAULT_DCONF qq{INTERFACESv4="$base_dhcpnic"\n};
2334
2335        close($DEFAULT_DCONF);
2336        }
2337
2338        if($self->parse_cmdline("recoverdhcp")) {
2339                my($recentmach,$i,$latestts,$ft);
2340                $ft = new File::Temp();
2341                Readonly my $SLEEP => 60;
2342                Readonly my $PWD => getcwd();
2343                my $tempdir = $ft->tempdir("DHCP",CLEANUP => 0);
2344                my(undef,undef,$uid,$gid) = getpwnam('bccd');
2345                chown($uid, $gid, $tempdir);
2346                $rc = $self->run_test("rmtree","","Removing /etc/network/run",'/etc/network/run');
2347                if($rc) {
2348                        $self->log_and_cont("ERROR",$sub,"Couldn't remove /etc/network/run");
2349                }
2350                $rc = $self->run_test("mkpath","","mkdir /etc/network/run",'/etc/network/run');
2351                if($rc) {
2352                        $self->log_and_cont("ERROR",$sub,"Couldn't remake /etc/network/run");
2353                }
2354                ($out,$rc) = $self->run_test(
2355            "system",
2356            "",
2357            "touch /etc/network/run/ifstate",
2358            [
2359                'touch',
2360                '/etc/network/run/ifstate',
2361            ],
2362        );
2363                if(!$rc) {
2364                        $self->log_and_cont("ERROR",$sub,"Couldn't touch /etc/network/run/ifstate: $out");
2365                }
2366                ($out,$rc) = $self->run_test(
2367            "system",
2368            "",
2369            "Starting networking",
2370            [
2371                '/etc/init.d/networking',
2372                'start',
2373            ]
2374        ); # No service because utmp has not been updated
2375                if(!$rc) {
2376                        $self->log_and_cont("ERROR",$sub,"Couldn't start networking: $out");
2377                }
2378                ($out,$rc) = $self->run_test(
2379            "system",
2380            "",
2381            "Starting snmpd",
2382            [
2383                '/usr/sbin/service',
2384                'snmpd',
2385                'start',
2386            ]
2387        );
2388                if(!$rc) {
2389                        $self->log_and_cont("ERROR",$sub,"Couldn't start snmpd: $out");
2390                }
2391                ($rc,$out) = $self->run_test(
2392            "system",
2393            "",
2394            "Starting DHCP server",
2395            [
2396                '/usr/sbin/service',
2397                'isc-dhcp-server',
2398                'stop',
2399            ]
2400        );
2401                if(!$rc) {
2402                        $self->log_and_cont("ERROR",$sub,"Couldn't stop DHCP server: $out");
2403                }
2404                ($rc,$out) = $self->run_test(
2405                "system",
2406                "",
2407                "Starting sshd",
2408                [
2409                    '/usr/sbin/service',
2410                    'ssh',
2411                    'start',
2412                ]
2413        );
2414                if(!$rc) {
2415                        $self->log_and_cont("ERROR",$sub,"Couldn't start ssh: $out");
2416        }
2417        ($rc,$out) = $self->run_test(
2418                "system",
2419                "",
2420                "Starting BCCD autodetection",
2421                [
2422                    '/bin/su',
2423                    'bccd',
2424                    '-c',
2425                    '/bin/bccd-auto-ssh',
2426                ]
2427            );
2428
2429        if($self->is_log($INFO)) {
2430            $self->log_and_cont("INFO",$sub,"Waiting for responses, sleeping $SLEEP seconds...");
2431        }
2432                sleep($SLEEP);
2433       
2434                chdir($tempdir);
2435                ($rc,$out) = $self->run_test(
2436            "system",
2437            "",
2438            "Snarfing hosts",
2439            [
2440                '/bin/su',
2441                'bccd',
2442                '-c',
2443                '/bin/bccd-snarfhosts',
2444                "$tempdir/machines",
2445            ]
2446        );
2447                if($rc) {
2448                        $self->log_and_cont("ERROR",$sub,"Couldn't snarf hosts, $out");
2449                }
2450
2451                open(my $MACHINES, "$tempdir/machines") or
2452                        $self->log_and_die("ERROR",$sub,"Can't open file $tempdir/machines: $!\n");
2453                $i = $latestts = 0;
2454                while(my $line = <$MACHINES>) {
2455                        chomp $line;
2456                        my $machine = (split(/\s+/,$line))[0];
2457                        if($self->is_log($INFO)) {
2458                                $self->log_and_cont("INFO",$sub,"Processing $machine for DHCP leases");
2459                        }
2460                        if($i++ > 0) { # The head node always appears first, and should not be processed
2461                                my $leases;
2462                                $destfile = "$tempdir/$machine"."_dhcpd.leases";
2463                                ($rc,$out) = $self->run_test(
2464                    "system",
2465                    "",
2466                    "Copying lease from $machine",
2467                    [
2468                        '/bin/su',
2469                        'bccd',
2470                        '-c',
2471                        'scp',
2472                        "$machine:/var/tmp/dhcpd.leases",
2473                        $destfile,
2474                    ]
2475                );
2476                                if(!$rc) {
2477                                        $self->log_and_cont("WARN",$sub,"Couldn't copy lease file from $machine");
2478                                }
2479                                else {
2480                                        $leases = $self->snarf_file($destfile);
2481                                        if(!defined($leases)) {
2482                                                $self->log_and_cont("WARN",$sub,"Couldn't read lease file from $machine");
2483                                        }
2484                                        if($leases =~ m{^#\s+BCCD TS:\s+(\d+)$}m) {
2485                                                if($1 > $latestts) {
2486                                                        $latestts = $1;
2487                                                        $recentmach = $machine;
2488                                                        if($self->is_log($INFO)) {
2489                                                                $self->log_and_cont("INFO",$sub,"$machine is most recent");
2490                                                        }
2491                                                }
2492                                        }
2493                                }
2494                        }
2495                }
2496                if(defined($recentmach)) {
2497                        if($self->is_log($DEBUG)) {
2498                                $self->log_and_cont("INFO",$sub,"Copied $tempdir/$recentmach"."_dhcpd.leases to /var/lib/dhcp/dhcpd.leases");
2499                        }
2500                        $rc = $self->run_test("fcopy","","Copying $tempdir/$recentmach"."_dhcpd.leases -> /var/lib/dhcp/dhcpd.leases","$tempdir/$recentmach"."_dhcpd.leases","/var/lib/dhcp/dhcpd.leases");
2501                        if(!$rc) {
2502                                $self->log_and_die("ERROR",$sub,"Couldn't move lease from $recentmach into place.");
2503                        }
2504                }
2505                $self->run_test(
2506            "system",
2507            "",
2508            "Killing pkbcast",
2509            [
2510                '/usr/bin/killall',
2511                'pkbcast',
2512            ]
2513        );
2514                $self->run_test(
2515            "system",
2516            "",
2517            "Killing bccd-allow-all",
2518            [
2519                '/usr/bin/killall',
2520                'bccd-allow-all'
2521            ]
2522        );
2523                close($MACHINES);
2524        }
2525   
2526    if(!$havedhcp) {
2527        ($rc,$out) = $self->exec_system([
2528                '/usr/sbin/update-rc.d',
2529                'isc-dhcp-server',
2530                'defaults',
2531            ]);
2532            if($rc == 0) {
2533            $self->log_and_cont("NOTICE",$sub,"Set DHCP server to start.\n");
2534        }
2535        else {
2536            $self->log_and_die("ERROR",$sub,"Couldn't set DHCP server to start: $out\n");
2537        }
2538    }
2539    else {
2540        ($rc,$out) = $self->exec_system([
2541                '/usr/sbin/update-rc.d',
2542                '-f',
2543                'isc-dhcp-server',
2544                'remove',
2545            ]);
2546        if($rc == 0) {
2547            $self->log_and_cont("NOTICE",$sub,"Set DHCP server not to start.\n");
2548        }
2549        else {
2550            $self->log_and_die("NOTICE",$sub,"Couldn't set DHCP server not to start: $out\n")
2551        }
2552    }
2553    return 1;
2554}
2555
2556sub config_nat{
2557        my($self) = @_;
2558        my($natnic,$sub);
2559        $sub = 'config_nat';
2560    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
2561                $self->log_and_cont('INFO',$sub,"Gathering routing information");
2562        }
2563
2564    open(my $NETSTAT, '-|', '/bin/netstat', '-rn') or
2565        $self->log_and_die("ERROR",$sub,"Couldn't open up netstat for piping!");
2566
2567    NETSTAT:
2568    while(my $line = <$NETSTAT>) {
2569        chomp $line;
2570        my @splitline = split(/\s+/, $line);
2571        if($splitline[0] eq '0.0.0.0') {
2572            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
2573                $self->log_and_cont('INFO',$sub,"$splitline[7] is a default router");
2574            }
2575            $natnic = $splitline[7];
2576            last NETSTAT;
2577        }
2578    }
2579    close($NETSTAT);
2580
2581        if(defined($natnic)) {
2582        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
2583            $self->log_and_cont('INFO',$sub,"Writing out $NATSH");
2584        }
2585        open(my $NAT, '>', $NATSH) or
2586            $self->log_and_die("ERROR",$sub,"Couldn't open $NATSH for writing: $!");
2587       
2588        my $natip = $self->get_nic_ip($natnic);
2589        if(!defined($natip)) {
2590            $self->log_and_die("ERROR",$sub,"Couldn't get IP address for $natnic!");
2591        }
2592       
2593        print $NAT qq{#!/bin/bash\n\n};
2594 
2595        print $NAT qq{if hostname|grep -q node000; then\n};
2596
2597        foreach my $LINE (
2598            q{--flush},
2599            q{-t nat --flush},
2600            q{--delete-chain},
2601            q{-t nat --delete-chain},
2602            qq{-t nat -A POSTROUTING -o $natnic -j LOG --log-level debug --log-prefix "POSTRT: "},
2603            qq{-t nat -A POSTROUTING -o $natnic -s 192.168.3.0/24 -j SNAT --to $natip},
2604            ) {
2605            print $NAT qq{\t/sbin/iptables $LINE\n};
2606        }
2607        print $NAT "fi\n";
2608       
2609        close($NAT);
2610        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
2611                        $self->log_and_cont('INFO',$sub,"Making $NATSH executable");
2612                }
2613                chmod(S_IRWXU|S_IRGRP|S_IXGRP|S_IROTH|S_IXOTH, $NATSH) or
2614                        $self->log_and_die("ERROR",$sub,"Couldn't set $NATSH to be executable: $!");
2615               
2616                return 1;
2617        }
2618        return;
2619}
2620
2621sub is_dialog_ok {
2622    my($self,$d) = @_;
2623   
2624    if($d->state() eq 'OK') {
2625        return 1;
2626    }
2627   
2628    return;
2629}
2630
2631sub config_nic_dialog {
2632    my($self,$d,$nic) = @_;
2633    my($temp,$gotpxe,$dhcp_source,$sub,$rc,$msg_string);
2634    $sub = 'config_nic_dialog';
2635    $self->enter_sub($sub);
2636
2637    # Find NICs with external connectivity
2638  FIND_EXT_NIC:
2639    {
2640        my @dhcp_nics;
2641        # See if there's a BCCD server response
2642        foreach my $nic (keys(%{$self->{nic_conf}})) {
2643            if($self->is_log($DEBUG)) {
2644                $self->log_and_cont('DEBUG',$sub,"Testing $nic for BCCD
2645presence");
2646            }
2647            if(defined($self->{nic_conf}->{$nic}->{'dhcp_source'})
2648               && $self->{nic_conf}->{$nic}->{'dhcp_source'} eq 'BCCD') {
2649                if($self->is_log($DEBUG) || $self->is_log($INFO)) {
2650                    $self->log_and_cont('INFO',$sub,"$nic has BCCD on it");
2651                }
2652                $dhcp_source = 'BCCD';
2653            }
2654        }
2655
2656        # Display NICs that have non-BCCD IP addresses with the IP address they got
2657        foreach my $nic (sort(keys(%{$self->{nic_conf}}))) {
2658            # Only if we didn't pick up a BCCD server
2659            if((defined($self->{nic_conf}->{$nic}->{'dhcp_source'})
2660                                && $self->{nic_conf}->{$nic}->{'dhcp_source'} ne 'BCCD')
2661                                || !defined($dhcp_source)) {
2662                if($self->is_log($DEBUG)) {
2663                    $self->log_and_cont('DEBUG',$sub,"$nic is safe to prompt");
2664                }
2665                my $ip = $self->get_nic_ip($nic);
2666                push(@dhcp_nics,($nic,defined($ip) ? "($ip)" : "()"));
2667            }
2668        }
2669
2670        if($self->is_log($DEBUG)) {
2671            $self->log_and_cont('DEBUG',$sub,"Found ".($#dhcp_nics+1)." DHCP NICs");
2672        }
2673
2674        # If only one NIC is present, choose it for the BCCD network without prompting
2675        if($#dhcp_nics == 0) {
2676            if($self->is_log($DEBUG)) {
2677                $self->log_and_cont('DEBUG',$sub,"Only one NIC for BCCD");
2678            }
2679            $self->{bccd_nic} = $dhcp_nics[0];
2680        }
2681        elsif($#dhcp_nics > 0 and not -e '/testmode') {
2682            if($self->is_log($DEBUG)) {
2683                $self->log_and_cont('DEBUG',$sub,"Multiple NICs for BCCD, prompting ".Dumper(@dhcp_nics));
2684            }
2685            $d->msgbox(
2686                text => 'The next screen has a list of NICs and their '
2687                    .'IP addresses. Select the NIC that you want to setup a '
2688                    .'BCCD network on. For LittleFe, this will be the one with '
2689                    .'no IP address.'
2690                );
2691            # Set NIC that will have a locked-down DHCP server listening on it
2692            $self->{bccd_nic} = $d->menu(text=>"Choose NIC to have BCCD network.", list => \@dhcp_nics);
2693
2694            if($self->is_log($INFO) || $self->is_log($DEBUG)) {
2695                $self->log_and_cont('INFO',$sub,"User selected $self->{bccd_nic} to be BCCD NIC.");
2696            }
2697            if(!$self->is_dialog_ok($d)) {
2698                redo FIND_EXT_NIC;
2699            }
2700        }
2701        elsif(-f '/testmode') {
2702            open (TEST,'</bccd_boot_flags') or croak "$!";
2703            my  @command = grep (/BCCD_NIC/, <TEST>);
2704            if ($command[0] =~ m/export BCCD_NIC=(.*)$/){
2705                $self->{bccd_nic} = $1;
2706            }
2707            print STDERR "$self->{bccd_nic} selected for BCCD network\n"
2708        }
2709        # Copy iptables template regardless of NAT Status
2710        open(my $IPT, '>', $IPTABLES_UP) or
2711            $self->log_and_die("ERROR",$sub,
2712                               "Couldn't open $IPTABLES_UP for appending: $!");
2713        foreach my $LINE (
2714            q{*filter},
2715            q{:INPUT ACCEPT [6562:602865]},
2716            q{:FORWARD ACCEPT [100:8276]},
2717            q{:OUTPUT ACCEPT [5836:748341]},
2718            q{COMMIT},
2719            ) {
2720            print $IPT "$LINE\n";
2721        }
2722        # Setup NAT in iptables on the BCCD NIC
2723        if(defined($self->{bccd_nic}) && !$self->check_bccd_net($self->{nic_conf})) {
2724            if($self->is_log($DEBUG)) {
2725                $self->log_and_cont('DEBUG',$sub,"Setting $self->{bccd_nic} to be BCCD net NIC");
2726            }
2727            # Preserve other settings not in BCCD_NET
2728            foreach my $key (keys(%{$BCCD_NET})) {
2729                $self->{nic_conf}->{$self->{bccd_nic}}->{$key} = $BCCD_NET->{$key};
2730            }
2731            foreach my $LINE (
2732                q{*nat},
2733                q{:PREROUTING ACCEPT [145:21906]},
2734                q{:POSTROUTING ACCEPT [8:630]},
2735                q{:OUTPUT ACCEPT [27:2202]},
2736                q{COMMIT},
2737                ) {
2738                print $IPT "$LINE\n";
2739            }
2740        }
2741        close($IPT);
2742
2743        # Ignore NIC aliases
2744        if($self->is_log($DEBUG)) {
2745            $self->log_and_cont('DEBUG',$sub,"Processing nic_conf ".Dumper($self->{nic_conf}));
2746        }
2747      NIC_CONF:
2748        foreach my $nic (grep {!/:1$/} sort keys %{$self->{nic_conf}}) {
2749            # If $nic has an IP address, and it came from a BCCD DHCP
2750            # server
2751            if(defined($self->{nic_conf}->{$nic}->{'ipaddr'})
2752                                && defined($self->{nic_conf}->{$nic}->{'dhcp_source'})
2753                                && $self->{nic_conf}->{$nic}->{'dhcp_source'} eq 'BCCD') {
2754                # Only for NICs that pickup a response from a non-BCCD DHCP server
2755                if(!$self->parse_cmdline('standalone')) {
2756                    $self->log_and_cont('DEBUG',$sub,"$nic has DHCP response from $self->{nic_conf}->{$nic}->{'dhcp_source'}, taking $self->{nic_conf}->{$nic}->{'ipaddr'} and setting dhcp flag");
2757                    $self->{nic_conf}->{$nic}->{'dhcp'} = 1;
2758                }
2759            }
2760            # If $nic has a response from a non-BCCD DHCP server
2761            elsif((defined($self->{nic_conf}->{$nic}->{'dhcp_source'})
2762                && (($d->yesno(text=>"$nic has an IP address "
2763                                    ."$self->{nic_conf}->{$nic}->{'ipaddr'} from "
2764                                    ."$self->{nic_conf}->{$nic}->{'dhcp_source'}. Take this address?")
2765                                )
2766                    || (-e '/testmode'))
2767            )) {
2768                $self->log_and_cont('DEBUG',$sub,"$nic has DHCP response from $self->{nic_conf}->{$nic}->{'dhcp_source'}, taking $self->{nic_conf}->{$nic}->{'ipaddr'} and setting dhcp flag");
2769                $self->{nic_conf}->{$nic}->{'dhcp'} = 1;
2770            }
2771            # If no DHCP response were received...
2772            else {
2773                $self->log_and_cont('DEBUG',$sub,"$nic has no DHCP, unsetting dhcp flag");
2774                $self->{nic_conf}->{$nic}->{'dhcp'} = 0;
2775                # If we have no DHCP response and no IP address, then prompt
2776                # whether to skip this NIC. If not, then we assign an address
2777                # in a later section.
2778                $msg_string = "No DHCP found for network on $nic, "
2779                ."do you wish to accept auto-configuration?";
2780                if($self->get_stage() eq 'LIBERATED') {
2781                    $msg_string .= " (Say NO to configure PXE/diskless booting.)";
2782                }
2783                $temp = $d->yesno(text => $msg_string);
2784                if(($self->{nic_conf}->{$nic}->{'dhcp'} == 0)
2785                    && !defined($self->{nic_conf}->{$nic}->{'ipaddr'})
2786                    && ! -e '/testmode'
2787                    && (!defined($self->{nic_conf}->{$nic}->{bccdnet}) || $self->{nic_conf}->{$nic}->{bccdnet} == 1)
2788                    && $temp == 0) {
2789                    $self->log_and_cont('DEBUG',$sub,"Disabling $nic DHCP flag");
2790                    $self->{nic_conf}->{$nic}->{'dhcp'} = 0;
2791                }
2792                elsif($temp == 1) {
2793                    $self->log_and_cont('DEBUG',$sub,"Enabling $nic DHCP flag");
2794                    $self->{nic_conf}->{$nic}->{'dhcp'} = 1;
2795                }
2796            }
2797
2798            if($self->{nic_conf}->{$nic}->{'dhcp'} == 0) {
2799              FIND_CUR_NIC:
2800                do {
2801                    # Setup a PXE network if liberated and requested
2802                    if(!defined($gotpxe)
2803                                                && $self->get_stage() eq 'LIBERATED'
2804                        && $d->yesno(text=>"Make $nic the PXE-capable NIC?")
2805                        && $self->{nic_conf}->{$nic}->{'dhcp'} == 0
2806                    ) {
2807                        $gotpxe = 1;
2808                        $self->{nic_conf}->{$nic}->{'pxenic'}  = $nic;
2809                        $self->{nic_conf}->{$nic}->{'ipaddr'}  = $BCCD_NET->{'ipaddr'};
2810                        $self->{nic_conf}->{$nic}->{'bcast'}   = $BCCD_NET->{'bcast'};
2811                        $self->{nic_conf}->{$nic}->{'mask'}    = $BCCD_NET->{'mask'};
2812                        $self->{nic_conf}->{$nic}->{'bccdnet'} = $BCCD_NET->{'bccdnet'};
2813                        if($self->is_log($DEBUG)) {
2814                            $self->log_and_cont('DEBUG',$sub,"Set $nic to ".Dumper($self->{nic_conf}->{$nic}));
2815                        }
2816DELETE_VIRTUAL_NIC:
2817                        foreach my $x (keys(%{$self->{nic_conf}})) {
2818                            if($self->is_log($DEBUG)) {
2819                                $self->log_and_cont('DEBUG',$sub,"Testing $x for virtual");
2820                            }
2821                        }
2822                    }
2823                    else{
2824                        # If no PXE, then allow the user to set network information manually
2825                        if (-e '/testmode'){
2826                            $self->{nic_conf}->{$nic}->{'ipaddr'} = '192.168.0.*';
2827                        }
2828                        elsif($nic eq $self->{bccd_nic}) {
2829                            $self->{nic_conf}->{$nic} = $BCCD_NET;
2830                        }
2831                        else{
2832                            $self->{nic_conf}->{$nic}->{'ipaddr'} =
2833                                ($temp = $d->inputbox(text=>
2834                                                      "$nic IP address (mandatory)")) ? $temp : undef;
2835                           
2836                            # Repeat on typos
2837                            if(!$self->is_dialog_ok($d)) {
2838                                redo FIND_EXT_NIC;
2839                            }
2840                            elsif($self->{nic_conf}->{$nic}->{'ipaddr'} eq $BCCD_NET->{'ipaddr'}
2841                                && $nic ne $self->{bccd_nic})
2842                            {
2843                                $d->msgbox(text =>
2844                                           "IP address cannot be the BCCD virtual IP ($BCCD_NET->{'ipaddr'}).");
2845                                goto FIND_CUR_NIC;
2846                            }
2847                        }
2848                       
2849                        if (-e '/testmode'){
2850                            $self->{nic_conf}->{$nic}->{'mask'} = "255.255.255.0";
2851                        } else {
2852                            $self->{nic_conf}->{$nic}->{'mask'} =
2853                                ($temp = $d->inputbox(text=>
2854                                                      "$nic Subnet mask (mandatory)")) ? $temp : undef;
2855                           
2856                            if(!$self->is_dialog_ok($d)) {
2857                                redo FIND_EXT_NIC;
2858                            }
2859                        }
2860                       
2861                        $self->{nic_conf}->{$nic}->{'gw'}
2862                                                        = ($temp = $d->inputbox(text=>"$nic Gateway (optional)")) ? $temp : undef;
2863                        if(!$self->is_dialog_ok($d)) {
2864                            redo FIND_EXT_NIC;
2865                        }
2866                    }
2867                } while(!defined($self->{nic_conf}->{$nic}->{'ipaddr'})
2868                                        || !defined($self->{nic_conf}->{$nic}->{'mask'}));
2869            }
2870        }
2871    }
2872
2873    if($self->is_log($DEBUG)) {
2874        $self->log_and_cont('DEBUG',$sub,"Dialog got NICs "
2875            .Dumper($self->{nic_conf}));
2876    }
2877   
2878    return 1;
2879}
2880
2881sub get_nic_ip( $$ ) {
2882    my($self,$nic) = @_;
2883    my($sub,$cmd,$rc,$out,$ip);
2884    $sub = 'get_nic_ip';
2885    $self->enter_sub($sub);
2886   
2887    if(!defined($nic)) {
2888        return;
2889    }
2890   
2891    $cmd = [
2892        '/sbin/ifconfig',
2893        $nic,
2894    ];
2895    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
2896        $self->log_and_cont("INFO",$sub,"Running @{$cmd}.");
2897    }
2898    ($rc,$out) = $self->exec_system($cmd);
2899    if($rc) {
2900        $self->log_and_die("ERROR",$sub,"@{$cmd} failed with rc $rc, out $out.")
2901    }
2902    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
2903        $self->log_and_cont('DEBUG',$sub,"@{$cmd} returned $out");
2904    }
2905    if($out =~ m/inet\s+((?:\d{0,3}\.){3}\d{0,3})/) {
2906        $ip = $1;
2907        if($self->is_log($INFO) || $self->is_log($DEBUG)) {
2908            $self->log_and_cont('INFO',$sub,"$nic has $ip");
2909        }
2910    }
2911    else {
2912        undef $ip;
2913        $self->log_and_cont('INFO',$sub,"$nic has no IP address");
2914    }
2915   
2916    $self->leave_sub($sub);
2917    return $ip;
2918}
2919
2920sub get_nic_mask( $$ ) {
2921    my($self,$nic) = @_;
2922    my($sub,$cmd,$rc,$out,$mask);
2923    $sub = 'get_nic_mask';
2924    $self->enter_sub($sub);
2925   
2926    $cmd = [
2927        '/sbin/ifconfig',
2928        $nic,
2929    ];
2930    if($self->is_log($INFO) || $self->is_log($DEBUG)) {
2931        $self->log_and_cont("INFO",$sub,"Running @{$cmd}.");
2932    }
2933    ($rc,$out) = $self->exec_system($cmd);
2934    if($rc) {
2935        $self->log_and_die("ERROR",$sub,"@{$cmd} failed with rc $rc, out $out.");
2936    }
2937    if($out =~ m/netmask\s+((?:\d{0,3}\.){3}\d{0,3})/) {
2938        $mask = $1;
2939    }
2940    else {
2941        undef $mask;
2942    }
2943
2944    $self->leave_sub($sub);
2945    return $mask;
2946}
2947
2948# Detect other BCCD systems and set DHCP accordingly
2949sub set_dhcp_stance {
2950    my($self,$nic) = @_;
2951    my($response,$sub);
2952    $sub = 'set_dhcp_stance';
2953
2954    # Response is a hash ref of ipaddr and subnet mask
2955    $response
2956        = $self->run_nic_dhcp($nic,'/etc/dhcp/dhclient.conf-bccd');
2957    if(defined($response)) {
2958        $self->{nic_conf}->{$nic} = $response;
2959        $self->{nic_conf}->{$nic}->{'dhcp_source'} = 'BCCD';
2960    }
2961    else {
2962        $response
2963            = $self->run_nic_dhcp($nic,'/etc/dhcp/dhclient.conf-any');
2964        if(defined($response)) {
2965            $self->{nic_conf}->{$nic} = $response;
2966            $self->{nic_conf}->{$nic}->{'dhcp_source'} = 'OTHER';
2967        }
2968    }
2969    # Fall through for interfaces with no DHCP
2970    if(!defined($response)) {
2971        $self->{nic_conf}->{$nic}{'dhcp'} = 0;
2972    }
2973
2974    return 1;
2975}
2976
2977sub run_nic_dhcp {
2978    my($self,$nic,$cfg) = @_;
2979    my($cmd,$ip_info,$out,$rc,$sub,$DHLEASE,$lease_file);
2980    $sub = 'run_nic_dhcp';
2981   
2982    $cmd = [
2983        'killall',
2984        'dhclient',
2985    ];
2986    ($out,$rc) = $self->exec_system($cmd);
2987   
2988    foreach $lease_file ( </var/lib/dhcp/dhclient*leases*> ) {
2989        if(!$self->run_test('unlink','',"Removing $lease_file.",$lease_file)) {
2990            $self->log_and_die("ERROR",$sub,"Couldn't remove $lease_file.");
2991        }
2992    }
2993   
2994    $cmd = [
2995        'dhclient',
2996        '-cf',
2997        $cfg,
2998        '-1',
2999        $nic,
3000        '-v',
3001    ];
3002    ($out,$rc) = $self->run_test('system','',"Running @{$cmd}.",$cmd);
3003
3004        # Lease file comes under a variety of names
3005        # Return undef if none can be found
3006        if( -f "/var/lib/dhcp/dhclient.$nic.leases") {
3007                $lease_file = "/var/lib/dhcp/dhclient.$nic.leases";
3008        }
3009        elsif( -f "/var/lib/dhcp/dhclient.leases" ) {
3010                $lease_file = "/var/lib/dhcp/dhclient.leases";
3011        }
3012        else {
3013                return;
3014        }
3015
3016        if(!defined(open($DHLEASE, '<', $lease_file))) {
3017                $self->log_and_die("ERROR",$sub,"Couldn't parse lease file: $!\n");
3018        }
3019   
3020        while(my $line = <$DHLEASE>) {
3021                chomp $line;
3022                if($line =~ m{^\s+fixed-address\s+((?:\d{1,3}\.){3}\d{1,3});$}) {
3023                        $ip_info->{'ipaddr'} = $1;
3024                }
3025                elsif($line =~ m{^\s+option subnet-mask\s+((?:\d{1,3}\.){3}\d{1,3});$}) {
3026                        $ip_info->{'mask'} = $1;
3027                }
3028        }
3029
3030        if(!defined(close($DHLEASE))) {
3031                $self->log_and_cont("ERROR",$sub,"Couldn't close lease file: $!\n");
3032        }
3033
3034        if(defined($ip_info->{'ipaddr'})
3035                && defined($ip_info->{'mask'})
3036        ) {
3037                return $ip_info;
3038        }
3039
3040    return;
3041}
3042
3043sub read_passwd {
3044    my($self) = @_;
3045    my($passwd,$confirm,$empty);
3046    do {
3047        print "Please enter your password: ";
3048        ReadMode('noecho');
3049        $passwd = <STDIN>;
3050        if ($passwd){
3051                chomp $passwd;
3052        }
3053        print "\n";
3054        ReadMode('restore');
3055       
3056        print "Please confirm your password: ";
3057        ReadMode('noecho');
3058        $confirm = <STDIN>;
3059        if ($confirm){
3060                chomp $confirm;
3061        }
3062        print "\n";
3063        ReadMode('restore');
3064        if (not $passwd){
3065                $passwd = "";
3066        }
3067        if (not $confirm){
3068                $confirm = "";
3069        }
3070    } while($passwd ne $confirm);
3071    return $passwd;
3072}
3073
3074
3075sub get_boot_flags_from_NIC{
3076    my ($self,$request) = @_;
3077    my @custom_macs;
3078    my @custom_nics;
3079    my @boot_strings;
3080    my $boot_string;
3081   
3082   
3083    my @mac_addresses =
3084        split(/\n/,`$IFCONFIG | awk '/HWaddr/ {print \$1 " " \$5}'`);
3085    @custom_macs = grep {/ 02:/} @mac_addresses;
3086   
3087    for(my $i = 0; $i <= $#custom_macs; ++$i){
3088        if($custom_macs[$i] =~ m/^(.*?) /) {
3089            $custom_nics[$i] = $1;
3090        }
3091       
3092        my $open_hex;
3093        if ($custom_macs[$i] =~ m/([0-9a-fA-F]):([0-9a-fA-F][0-9a-fA-F])$/){
3094            $open_hex = $1.$2;
3095        } else {
3096            die "Error in detecting last three hexes in MAC $!";
3097        }
3098       
3099        $boot_strings[$i] = sprintf "%012b", hex( $open_hex );
3100       
3101        if (
3102            substr($boot_strings[$i],
3103                   $IS_BCCD_NETWORK_NIC,1)
3104            eq '1'
3105            )
3106        {
3107            $self->{bccd_nic} = $custom_nics[$i];
3108            $boot_string = $boot_strings[$i];
3109        }
3110    }
3111   
3112    # Only process NIC if it has the test flags
3113    if(defined($self->{bccd_nic})) {
3114        my $boot_flags = "#!/bin/sh\nexport BCCD_NIC=$self->{bccd_nic}\n";     
3115       
3116        foreach my $key(keys %{$request}){
3117            my $value;
3118            my $pointer = $request->{$key};
3119            my ($index,$length) = split(/,/,$pointer);
3120           
3121            unless($length){
3122                $length = 1;
3123            }
3124           
3125            $value = substr($boot_string,$index,$length);
3126            $value = oct ("0b$value");
3127           
3128            $boot_flags .= "export $key=$value\n";     
3129        }
3130       
3131        if ($boot_flags){
3132            open(BOOTFLAGS, ">/bccd_boot_flags")
3133                or die "Could not open /bccd_boot_flags:$!";
3134            print BOOTFLAGS $boot_flags;
3135            close(BOOTFLAGS);
3136            chmod 0755, '/bccd_boot_flags';
3137        }
3138    }
3139}
31401;
3141
3142__END__
3143
3144=head1 NAME
3145
3146Bccd.pm
3147
3148=head1 DESCRIPTION
3149
3150This is the Perl module common to all BCCD scripts except for the testing database. What follows
3151is a description of all the subroutines available in the module. The signature below includes
3152the reference to the module, but only extra parameters are explicitly mentioned.
3153
3154=head2 GENERAL SUBROUTINES
3155
3156These functions all take a reference to the parent module, along with whatever other
3157parameters that are passed in.
3158
3159=head3 cmd_num_die($@)
3160
3161This is the subroutine called when another subroutine does not have the proper number of
3162arguments. Takes an array.
3163
3164=head3 print_array($@)
3165
3166This prints an array with line counters. Takes an array.
3167
3168=head3 get_vginfo($)
3169
3170This subroutine returns the LVM volume group information in colon-delimited format.
3171
3172=head3 get_pvinfo($)
3173
3174Returns the LVM physical volume information in colon delimited format.
3175
3176=head3 get_free_pe_count($)
3177
3178Returns the number of available physical extents in the volume groups present.
3179
3180=head3 snarf_file($$)
3181
3182Takes a path to a file and reads it in as one string.
3183
3184=head2 TESTING SUBROUTINES
3185
3186These functions all take a refernce to the parent module, the test type, the success return
3187code to be expected (required but can be blank for a safe default), a message to print out,
3188and whatever other parameters the specific test requires. In this documentation, only extra
3189parameters are explicitly mentioned. Unless otherwise noted, this returns the exit code as a
3190Perl truth value (0 == failure, anything else is OK).
3191
3192=head3 test_system($$$$$)
3193
3194Takes a command and runs it.
3195
3196=head3 test_chdir($$$$$)
3197
3198Takes a directory and changes the present directory to it.
3199
3200=head3 test_mkpath($$$$$)
3201
3202Takes a directory and makes it.
3203
3204=head3 test_wwwmech($$$$$$)
3205
3206Takes a URL and a destination file, and fetches the URL to the file. For subversion
3207access, see test_revfetch and test_recrevfetch.
3208
3209=head3 test_chmod($$$$$$)
3210
3211Takes an octal permission mode and a file, and sets the permissions on the file to the given
3212mode. Make sure not to represent the octal permissions as text (i.e. don't use quotes).
3213
3214=head3 test_unlink($$$$$)
3215
3216Takes a directory entry and removes it.
3217
3218=head3 test_symlink($$$$$$)
3219
3220Takes a source file and destination, and symbolically links the source to the destination.
3221
3222=head3 test_fcopy($$$$$$)
3223
3224Takes a source file and destination file, and copies the source to the destination.
3225
3226=head3 test_fmove($$$$$$)
3227
3228Takes a source file and destination, and moves the source file to the destination.
3229
3230=head3 test_getsvnrev($$$$$)
3231
3232Gets the current subversion revision from the given URL. Returns the subversion revision.
3233
3234=head3 test_fwrite($$$$$$$)
3235
3236Takes a mode, file, and a text string, and writes the text to the file. Valid modes are "w"
3237for replacing the file, and "a" for appending to an existing file.
3238
3239=head3 test_revfetch($$$$$$$)
3240
3241Takes a subversion revision, URL in a subversion repository, and a destination file. Fetches
3242the file in the URL at the given revision to the destination file.
3243
3244=head3 test_rename($$$$$$)
3245
3246Takes a source file and destination file and renames the source to the destination. Functionally
3247equivalent to test_fmove.
3248
3249=head3 test_recrevfetch($$$$$$)
3250
3251Takes a subversion revision and URL, and fetches all files underneath the URL to the present
3252directory.
3253
3254=head3 test_rmtree($$$$$)
3255
3256Takes a directory tree and recursively removes it.
3257
3258=head3 test_getuseruid($$$$$)
3259
3260Takes a username and return the UID.
3261
3262=head3 test_getusergid($$$$$)
3263
3264Takes a username and returns the primary GID.
3265
3266=head3 test_lsofkill($$$$$)
3267
3268Takes a directory name and kills all processes with open files in that directory.
3269
3270=head3 test_chown($$$$$$$)
3271
3272Takes a file, user, and group and changes ownership of the file to that user and group.
3273
3274=head3 test_rsync($$$$$$)
3275
3276Takes a source and destination path and rsync's the source to the destination.
3277
3278=head2 MISCELLANEOUS SUBROUTINES
3279
3280These do not take any standardized arguments
3281
3282=head3 get_boot_flags_from_NIC(%)
3283
3284Takes data from the NIC's MAC address and populates /bccd_boot_flags
3285according to key-position hash.
3286
3287Splits the last three hexes of the bccd network's custom NIC
3288into a 12 digit binary string. Takes a hash of keys and
3289positions in that binary string. Key translates directly into
3290the name of the environment variable into which the information
3291is stored, and the position is a comma-separated-value list
3292with an index (starting at 0) and optionally a bit length (default 1).
3293so ('BUILD_CONTROL' => 1) takes the second bit in the last
3294three digits of the MAC and writes "export BUILD_CONTROL=<value>" to
3295/bccd_boot_flags
3296
3297The first entry in /bccd_boot_flags is always "export BCCD_NIC=<BCCD NIC>"
3298
3299For a list of the official automated test bootflags
3300and their corresponding locations, check the BCCD Wiki
3301
3302=cut
Note: See TracBrowser for help on using the repository browser.