source: /cluster/svnroot/bccd-ng/branches/skylar/bccd-3.4.0/trees/usr/local/lib/site_perl/Bccd.pm @ 5227

Last change on this file since 5227 was 5227, checked in by skylar, 5 years ago

fixing prompts and logic for DHCP/PXE detection re #950

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