source: /cluster/svnroot/bccd-ng/trunk/trees/usr/local/lib/site_perl/5.10.0/Bccd.pm @ 3236

Last change on this file since 3236 was 3236, checked in by skylar, 10 years ago

appears to be bad merge (#639)

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