source: /cluster/svnroot/bccd-ng/branches/skylar-devel/trees/usr/local/lib/site_perl/5.10.0/Bccd.pm @ 3196

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

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