From 4e734105c9247a11dd076c047a85cff36248fbc3 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 5 May 2017 12:38:36 -0700 Subject: [PATCH] New plugin: devops. --- src/devops/AUTHORS | 5 + src/devops/COPYING | 674 ++++++++++++++++++++++++++++++ src/devops/ChangeLog | 9 + src/devops/Makefile.am | 90 ++++ src/devops/NEWS | 26 ++ src/devops/README | 14 + src/devops/autogen.sh | 4 + src/devops/build.scm | 351 ++++++++++++++++ src/devops/build.texi | 247 +++++++++++ src/devops/compile.sh | 19 + src/devops/configure.ac | 53 +++ src/devops/debian/changelog | 5 + src/devops/debian/compat | 1 + src/devops/debian/control | 18 + src/devops/debian/copyright | 30 ++ src/devops/debian/doc-base | 15 + src/devops/debian/docs | 2 + src/devops/debian/postinst.in | 11 + src/devops/debian/prerm.in | 11 + src/devops/debian/rules | 15 + src/devops/debian/source/format | 1 + src/devops/debian/watch | 2 + src/devops/devops.pkg | 39 ++ src/devops/devops.scm | 718 ++++++++++++++++++++++++++++++++ src/devops/devops.texi | 100 +++++ src/devops/gfdl.texi | 444 ++++++++++++++++++++ src/devops/make.scm | 8 + src/devops/optiondb.scm | 14 + src/devops/pucked.texi | 108 +++++ 29 files changed, 3034 insertions(+) create mode 100644 src/devops/AUTHORS create mode 100644 src/devops/COPYING create mode 100644 src/devops/ChangeLog create mode 100644 src/devops/Makefile.am create mode 100644 src/devops/NEWS create mode 100644 src/devops/README create mode 100755 src/devops/autogen.sh create mode 100644 src/devops/build.scm create mode 100644 src/devops/build.texi create mode 100755 src/devops/compile.sh create mode 100644 src/devops/configure.ac create mode 100644 src/devops/debian/changelog create mode 100644 src/devops/debian/compat create mode 100644 src/devops/debian/control create mode 100644 src/devops/debian/copyright create mode 100644 src/devops/debian/doc-base create mode 100644 src/devops/debian/docs create mode 100755 src/devops/debian/postinst.in create mode 100755 src/devops/debian/prerm.in create mode 100755 src/devops/debian/rules create mode 100644 src/devops/debian/source/format create mode 100644 src/devops/debian/watch create mode 100644 src/devops/devops.pkg create mode 100644 src/devops/devops.scm create mode 100644 src/devops/devops.texi create mode 100644 src/devops/gfdl.texi create mode 100644 src/devops/make.scm create mode 100644 src/devops/optiondb.scm create mode 100644 src/devops/pucked.texi diff --git a/src/devops/AUTHORS b/src/devops/AUTHORS new file mode 100644 index 000000000..9b2186d9b --- /dev/null +++ b/src/devops/AUTHORS @@ -0,0 +1,5 @@ +To find out what should go in this file, see "Information For +Maintainers of GNU Software" (maintain.texi), the section called +"Recording Changes". + +Matt Birkholz Everything. diff --git a/src/devops/COPYING b/src/devops/COPYING new file mode 100644 index 000000000..94a9ed024 --- /dev/null +++ b/src/devops/COPYING @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + 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. + + + Copyright (C) + + 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 . + +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: + + Copyright (C) + 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 +. + + 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 +. diff --git a/src/devops/ChangeLog b/src/devops/ChangeLog new file mode 100644 index 000000000..43aa67b63 --- /dev/null +++ b/src/devops/ChangeLog @@ -0,0 +1,9 @@ +-*-Text-*- + +Please see the git commit log: + +$ git clone git://git.savannah.gnu.org/mit-scheme.git whatever +$ cd whatever/ +$ git remote add puck git://birchwood-abbey.net/~matt/mit-scheme.git +$ git fetch puck pucked +$ git log puck/pucked -- src/devops/ | more diff --git a/src/devops/Makefile.am b/src/devops/Makefile.am new file mode 100644 index 000000000..9046a6040 --- /dev/null +++ b/src/devops/Makefile.am @@ -0,0 +1,90 @@ +## Process this file with automake to produce Makefile.in +## +## Copyright (C) 2016, 2017 Matthew Birkholz +## +## This file is part of a Developer Operations plugin for MIT/GNU +## Scheme Pucked. +## +## This plugin is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published +## by the Free Software Foundation; either version 2 of the License, +## or (at your option) any later version. +## +## This plugin 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 plugin; if not, write to the Free Software +## Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA +## 02110-1301, USA. + +EXTRA_DIST = autogen.sh + +MIT_SCHEME_EXE = @MIT_SCHEME_EXE@ +scmlibdir = @MIT_SCHEME_LIBDIR@ +scmlib_subdir = $(scmlibdir)devops +scmdocdir = $(datarootdir)/doc/@MIT_SCHEME_PROJECT@ +scminfodir = $(scmdocdir)/info + +sources = devops.scm build.scm + +binaries = devops.bin devops.bci devops.com +binaries += build.bin build.bci build.com + +scmlib_sub_DATA = $(sources) $(binaries) +scmlib_sub_DATA += make.scm devops-@MIT_SCHEME_OS_SUFFIX@.pkd + +scminfo_DATA = devops.info +info_TEXINFOS = devops.texi +devops_TEXINFOS = pucked.texi build.texi gfdl.texi +AM_MAKEINFOHTMLFLAGS = --no-split --css-ref=style.css +AM_UPDATE_INFO_DIR = no + +devops.bin: stamp-scheme +devops.bci: stamp-scheme +devops.com: stamp-scheme +build.bin: stamp-scheme +build.bci: stamp-scheme +build.com: stamp-scheme +devops-@MIT_SCHEME_OS_SUFFIX@.pkd: stamp-scheme +stamp-scheme: $(sources) devops.pkg + touch stamp-scheme + if ! ./compile.sh; then rm stamp-scheme; exit 1; fi + +CLEANFILES = *.bin *.ext *.com *.bci *.moc *.fni *.crf *.fre *.pkd +CLEANFILES += stamp-scheme + +ETAGS_ARGS = $(sources) +TAGS_DEPENDENCIES = $(sources) + +EXTRA_DIST += $(sources) compile.sh devops.pkg +EXTRA_DIST += make.scm optiondb.scm debian + +install-data-hook: + ( echo '(add-plugin "devops" "@MIT_SCHEME_PROJECT@"'; \ + echo ' "$(DESTDIR)$(infodir)"'; \ + echo ' "$(DESTDIR)$(scmlibdir)"'; \ + echo ' "$(DESTDIR)$(scmdocdir)")' ) \ + | $(MIT_SCHEME_EXE) --batch-mode + +install-html: install-html-am + ( echo '(add-plugin "devops" "@MIT_SCHEME_PROJECT@"'; \ + echo ' "$(DESTDIR)$(infodir)"'; \ + echo ' "$(DESTDIR)$(scmlibdir)"'; \ + echo ' "$(DESTDIR)$(scmdocdir)")' ) \ + | $(MIT_SCHEME_EXE) --batch-mode + +install-info-am: + +uninstall-info-am: + +uninstall-hook: + ( echo '(remove-plugin "devops" "@MIT_SCHEME_PROJECT@"'; \ + echo ' "$(DESTDIR)$(infodir)"'; \ + echo ' "$(DESTDIR)$(scmlibdir)"'; \ + echo ' "$(DESTDIR)$(scmdocdir)")' ) \ + | $(MIT_SCHEME_EXE) --batch-mode + [ -d "$(DESTDIR)$(scmlib_subdir)" ] \ + && rmdir "$(DESTDIR)$(scmlib_subdir)" diff --git a/src/devops/NEWS b/src/devops/NEWS new file mode 100644 index 000000000..629685089 --- /dev/null +++ b/src/devops/NEWS @@ -0,0 +1,26 @@ +mit-scheme-pucked-devops NEWS -- history of user-visible changes. + +Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, + 2016, 2017 Matthew Birkholz + +This file is part of a Developer Operations plugin for MIT/GNU Scheme +Pucked. + +This plugin is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2 of the License, or (at your +option) any later version. + +This plugin 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 plugin; if not, write to the Free Software Foundation, +Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +mit-scheme-pucked-devops 0.1 - Matt Birkholz, 2017-02-27 +======================================================== + +* Created from a random collection of scripts. diff --git a/src/devops/README b/src/devops/README new file mode 100644 index 000000000..8c7a372d4 --- /dev/null +++ b/src/devops/README @@ -0,0 +1,14 @@ +The DEVOPS plugin. + +This plugin provides tools for developers who want to release an +experimental MIT/GNU Scheme or GNU standard plugins. It is used at +Birchwood Abbey to release new versions of MIT/GNU Scheme Pucked and +its plugins. + +The plugin is built and installed in the customary GNU way: + + ./configure + make + make install + +For more information see the accompanying manual. diff --git a/src/devops/autogen.sh b/src/devops/autogen.sh new file mode 100755 index 000000000..70bd51f82 --- /dev/null +++ b/src/devops/autogen.sh @@ -0,0 +1,4 @@ +#!/bin/sh + +set -e +autoreconf --force --install diff --git a/src/devops/build.scm b/src/devops/build.scm new file mode 100644 index 000000000..35314319e --- /dev/null +++ b/src/devops/build.scm @@ -0,0 +1,351 @@ +#| -*-Scheme-*- + +Copyright (C) 2016, 2017 Matthew Birkholz + +This file is part of a devops plugin for MIT/GNU Scheme Pucked. + +This plugin is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2 of the License, or (at your +option) any later version. + +This plugin 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 plugin; if not, write to the Free Software Foundation, +Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +|# + +;;;; Developer Operations + +;;; See devops.texi for complete details. + +;;; package: (devops build) +;;; package: (user) when downloaded to a build host. + +(define project-name) +(define build-dir) +(define build-scheme-architecture) +(define build-debian-architecture) +(define build-ubuntu?) + +(define (build) + (in-batch + (lambda () + (let loop () + (let ((todo (find-work))) + (log (number->string (length todo) 10) + " binaries to build.\n") + (flush-output) + (if (null? todo) + 'done + (begin + (dynamic-wind grab-lock-file + (lambda () (for-each (lambda (work) (work)) todo)) + release-lock-file) + (log "Looking for more work.\n") + (flush-output) + (loop)))))))) + +(define (find-work) + (let ((srcs (available-sources build-dir))) + (log "Available sources:\n") + (for-each (lambda (src) + (let ((name (car src)) + (vers (cdr src))) + (log " "name" "vers"\n"))) + srcs) + (append-map! + (lambda (name.vers) + (let ((name (car name.vers)) + (vers (cdr name.vers))) + (if (string=? project-name name) + (append + (work-todo name vers build-scheme-architecture "pkg" + (lambda () (build-core-pkg name vers))) + (if build-ubuntu? + (work-todo name vers build-debian-architecture "dpkg" + (lambda () (build-core-dpkg name vers))) + '())) + (append + (work-todo name vers build-scheme-architecture "pkg" + (lambda () (build-plugin-pkg name vers))) + (if build-ubuntu? + (work-todo name vers build-debian-architecture "dpkg" + (lambda () (build-plugin-dpkg name vers))) + '()))))) + srcs))) + +(define (work-todo name vers arch type work) + (let ((elogfile (string build-dir"/"name"-"vers"-"arch"-"type"-error.log")) + (logfile (string build-dir"/"name"-"vers"-"arch"-"type".log"))) + (if (file-exists? elogfile) + (error "Failed or in progress:" elogfile)) + (if (file-exists? logfile) + '() + (list (lambda () + (log-timestamp) + (log "Building "name" "vers" "arch" "type"\n") + (with-output-log + elogfile + (lambda () + (log-timestamp) + (work) + (log-timestamp))) + (rename-file elogfile logfile)))))) + +(define (build-core-pkg name vers) + (let ((sarch build-scheme-architecture) + (pkgdir (string build-dir"/"name"-"vers))) + (run "rm -rf "pkgdir) + (run "cd "build-dir" && tar xzf "name"-"vers".tar.gz") + (run "cd "pkgdir"/src && ./configure --enable-native-code="sarch) + (run "cd "pkgdir"/src && make") + (run "cd "pkgdir"/src/microcode && make distclean") + (run "chmod -R go-w "pkgdir) + (run "cd "build-dir" && tar czf "name"-"vers"-"sarch".tar.gz "name"-"vers) + (run "chmod 444 "pkgdir"-"sarch".tar.gz") + (run "rm -rf "pkgdir) + (run "cd "build-dir" && tar xzf "name"-"vers"-"sarch".tar.gz") + (run "cd "pkgdir"/src && ./configure") + (run "cd "pkgdir"/src && make compile-microcode") + (run "cd "pkgdir"/src && make install") + (run "cd "pkgdir"/doc && ./configure") + (run "cd "pkgdir"/doc && make install-info install-html install-pdf") + (run "rm -rf "pkgdir))) + +(define (build-core-dpkg name vers) + (let ((pkgdir (string build-dir"/"name"-"vers))) + (run "rm -rf "pkgdir) + (run "cd "build-dir" && tar xJf "name"_"vers".tar.xz") + (run "cd "pkgdir" && dpkg-buildpackage -b -uc") + (let ((darch build-debian-architecture)) + (run "chmod 444 "build-dir"/"name"_"vers"_"darch".deb") + (run "chmod 444 "build-dir"/"name"_"vers"_"darch".changes") + (run "rm -rf "pkgdir) + (run "sudo "project-name"-install "name"_"vers"_"darch".deb")))) + +(define (build-plugin-pkg name vers) + (let ((pkgdir (string build-dir"/"name"-"vers))) + (run "rm -rf "pkgdir) + (run "cd "build-dir" && tar xzf "name"-"vers".tar.gz") + (with-subprocess-environment-variable + "MIT_SCHEME_EXE" (string "/usr/local/bin/"project-name) + (lambda () + (run "cd "pkgdir" && ./configure") + (run "cd "pkgdir" && make all check") + (run "cd "pkgdir" && make install install-html install-pdf"))) + (run "rm -rf "pkgdir))) + +(define (build-plugin-dpkg name vers) + (let ((pkgdir (string build-dir"/"name"-"vers))) + (run "rm -rf "pkgdir) + (run "cd "build-dir" && tar xJf "name"_"vers".tar.xz") + (with-subprocess-environment-variable + "MIT_SCHEME_EXE" (string "/usr/bin/"project-name) + (lambda () + (run "cd "pkgdir" && dpkg-buildpackage -b -uc"))) + (let ((darch build-debian-architecture)) + (run "chmod 444 "build-dir"/"name"_"vers"_"darch".deb") + (run "rm -rf "pkgdir) + (run "sudo "project-name"-install "name"_"vers"_"darch".deb")))) + +(define (grab-lock-file) + (let ((filename (string build-dir"/lock"))) + (log filename(if (file-exists? filename) + " locked\n" + " free\n")) + (call-with-exclusive-output-file + filename + (lambda (out) + (write (unix/current-pid) out))) + (log "Lock grabbed.\n"))) + +(define (release-lock-file) + (log-timestamp) + (delete-file (string build-dir"/lock")) + (log "Lock released.\n")) + +;;;; Common procedures +;;; +;;; These are not dependent on the build environment (i.e. build-dir, +;;; etc.) and are shared with the rest of devops. + +(define (ubuntu?) + (and (file-exists? "/etc/lsb-release") + (find (lambda (line) (string=? "DISTRIB_ID=Ubuntu" line)) + (file-lines "/etc/lsb-release")))) + +(define (debian-architecture) + (car (shell-lines "dpkg-architecture -qDEB_TARGET_ARCH"))) + +(load-option 'regular-expression) + +(define (available-sources dir) + (map cdr + (sort + (append-map! + (lambda (name) + (let ((regs (re-string-match + "\\(.*\\)-\\([0-9]+[.][0-9.]+\\)[.]tar[.]gz$" + name))) + (if regs + (list (cons* (file-modification-time (string dir"/"name)) + (re-match-extract name regs 1) + (re-match-extract name regs 2))) + '()))) + (directory-file-names dir #f)) + (lambda (a b) (< (car a) (car b)))))) + +(define (in-batch thunk) + (fresh-line) + (write-string "OK\n") + (flush-output) + (%exit + (with-output-to-file (string build-dir"/daemon.log") + (lambda () + (call-with-current-continuation + (lambda (abort-batch-job) + (log-timestamp) + (flush-output) + (with-restart + 'ABORT "Abort the Scheme batch job." + (lambda (message) + (log-timestamp) + (log "Abort! "message"\n") + (abort-batch-job 7)) + #f + (lambda () + (log "Batch job started.\n") + (flush-output) + (bind-condition-handler '() + (named-lambda (batch-condition-handler condition) + (fresh-line) + (log-timestamp) + (write-condition-report condition (current-output-port)) + (newline) + (flush-output) + (abort->top-level "Error in Scheme batch job.")) + (lambda () + (environment-assign! + (->environment '(runtime interrupt-handler)) + 'hook/^G-interrupt + (named-lambda (batch-^G-interrupt) + (fresh-line) + (log-timestamp) + (log "Interrupt!\n") + (flush-output) + (abort->top-level "Scheme batch job interrupted."))) + (thunk) + (log "Batch job succeeded.\n") + (flush-output) + 0)))))))))) + +(define (with-output-log filename thunk) + (call-with-output-file filename + (lambda (out) + (dynamic-wind + (lambda () unspecific) + (lambda () (with-output-to-port out thunk)) + (lambda () + (flush-output out) + (set-file-modes! filename #o444)))))) + +(define (log-timestamp) + (log "# "(universal-time->local-time-string (get-universal-time))"\n")) + +(define (log . strings) + (for-each write-string strings)) + +(define (run . strings) + (let ((cmdln (apply string strings))) + (log cmdln"\n") + (shell* cmdln))) + +(define (shell-lines . strings) + (call-with-input-string (shell-output (apply string strings)) read-lines)) + +(define (file-lines . strings) + (call-with-input-file (apply string strings) read-lines)) + +(define (file-first-line filename) + (call-with-input-file filename + (lambda (in) + (let ((line (read-line in))) + (and (string? line) + line))))) + +(define (read-lines port) + (let loop ((lines '())) + (let ((line (read-line port))) + (if (eof-object? line) + (reverse! lines) + (loop (cons line lines)))))) + +(define (shell-output . strings) + (let ((cmdln (apply string strings))) + (call-with-output-string + (lambda (port) + (let ((status (shell* cmdln 'output port))) + (if (not (zero? status)) + (error "Non-zero exit status:" cmdln))))))) + +(define (shell . strings) + (shell* (apply string strings))) + +(load-option 'synchronous-subprocess) + +(define (shell* cmdln . options) + (let ((status (apply run-shell-command cmdln + 'environment scheme-subprocess-environment + options))) + (if (not (zero? status)) + (error "Shell command failed:" status cmdln)) + status)) + +(define (with-subprocess-environment-variable name value thunk) + (let* ((outside scheme-subprocess-environment) + (inside (setenv! name value outside))) + (dynamic-wind + (lambda () + (set! scheme-subprocess-environment inside)) + thunk + (lambda () + (set! scheme-subprocess-environment outside))))) + +(define (setenv! name value env) + (let* ((prefix (string name"=")) + (i (let ((end (vector-length env))) + (let loop ((i 0)) + (and (fix:< i end) + (if (string-prefix? prefix (vector-ref env i)) + i + (loop (fix:1+ i)))))))) + (if i + (let ((new (vector-copy env))) + (vector-set! new i (string prefix value)) + new) + (let* ((new-i (vector-length env)) + (new (vector-grow env (fix:1+ new-i)))) + (vector-set! new new-i (string prefix value)) + new)))) + +(let ((len (vector-length scheme-subprocess-environment))) + (let loop ((i 0)) + (if (fix:< i len) + (let ((setting (vector-ref scheme-subprocess-environment i))) + (if (string-prefix? "PATH=" setting) + (vector-set! + scheme-subprocess-environment i + (string "PATH=" + (decorated-string-append + "" ":" "" + (filter (lambda (dir) + (not (string-prefix? "/usr/local" dir))) + (burst-string + (string-tail setting 5) #\: #f))))) + (loop (fix:1+ i))))))) \ No newline at end of file diff --git a/src/devops/build.texi b/src/devops/build.texi new file mode 100644 index 000000000..228fc867b --- /dev/null +++ b/src/devops/build.texi @@ -0,0 +1,247 @@ +@node Build System +@chapter Build System + +The goal of the devops build system is to release from a developer's +git repository lint free source distributions with binaries for +several different machine architectures and operating system versions. +The binaries for each combination of architecture and operating system +are built by a ``build host.'' Ubuntu hosts build Debian packages as +well as the traditional binaries. Both packages and binaries are +installed as they are built, to test their installation and to fulfill +build dependencies between new releases. + +The release process begins in the developer's git repository, in a git +clean, lint free, well tested working directory. The developer +creates the release by creating a tag in the git repository, then +builds a source distribution from the tag using GNU's Autotools. If +the developer is sharing a project repository and download area, the +tag is pushed and the source distribution is uploaded. If the +developer is working alone, the tag stays in the local git repository +and the source distribution stays in the local build area +(@file{devops/} in the top working directory). + +The @emph{build} process begins in the @emph{project} (or developer) +git repository, possibly a bare repository on a shared server, where a +build status report polls each build host using passwordless +@code{ssh} to upload new releases and assess progress on builds. + +@menu +* Project Repository:: +* Project Configuration:: +* Release Process:: +* Build Process:: +* Lint Detection:: +@end menu + +@node Project Repository +@section Project Repository + +The devops build system assumes it runs in the working directory of a +git repository, e.g. a clone of a project repository. The current +branch can contain one or more plugins and/or a core Scheme. + +For example the MIT/GNU Scheme project repository might be cloned and +the @code{pucked} branch (with experimental plugins) fetched from +Birchwood Abbey. Fixes would be commited on a local branch, perhaps +called @code{unpucked}, that tracks @code{pucked}. The following +commands could be used to check out @code{pucked}, then start an +@code{unpucked} tracking branch. + +@smallexample +git clone git://git.savannah.gnu.org/mit-scheme.git +cd mit-scheme/ +git remote add puck git://birchwood-abbey.net/~matt/mit-scheme.git +git fetch puck pucked +git checkout puck/pucked +# Fix, then decide to commit on a local branch named "unpucked". +git checkout -b unpucked --track puck/pucked +git add . +git commit +# Later. +git pull puck pucked +@end smallexample + +@node Project Configuration +@section Project Configuration + +The devops build system is configured by a @file{config.scm} file in +its build area, @file{devops/} (possibly a symbolic link). The +@file{devops/config.scm} file is loaded into the @code{(devops)} +package where it can find procedures to set build system variables and +customize any part of the build processees. + +@deffn Procedure project-name [name] +Returns the project name (a string) after setting it to @var{name} +(when specified). @var{Name} should be a lower case string without +whitespace or punctuation; it is used to create file names. Until it +is set the project name is @code{"new-scheme"}. +@end deffn + +@deffn Procedure plugin name directory +Adds a plugin to the project. @var{Name} should be a string. It will +be concatenated with the project name and a hyphen to create package +file names. @var{Directory} should be a string naming a subdirectory +of the repository, the root of the plugin source tree. + +There is no dependency checking at the moment. Plugins should be +added in an order that satisfies their dependencies. If a plugin +depends on another, it should be added after the other so that new +releases of the other will be built and installed before it. +@end deffn + +@deffn Procedure host name user directory sarch darch ubuntu? +This procedure adds a build host to the project. New sources will be +uploaded to @code{@var{user}@@@var{name}:@var{directory}/} using +passwordless @code{scp}. @var{Sarch} should be the Scheme +architecture (@code{"i386"} or @code{"x86-64"}), @var{darch} the +Debian architecture (from @code{dpkg-architecture -qDEB_TARGET_ARCH}). +@var{Ubuntu?} should be @code{#t} if the host will be building Debian +packages; else @code{#f}. +@end deffn + +@node Release Process +@section Release Process + +The release process runs in a git repository on a developer's machine. +Presumably the working directory is clean, tested and free of lint. +It represents the head of a short chain of commits going back to the +previous release tag. That chain should be reviewed for changes or +enhancements that deserve mention in the NEWS file or documentation. + +Often a chain of commits represents an enhancement that is immediately +put to use in existing code. The core might offer a new service and +several plugins take advantage of it. The release process should tag +a new core version first, update the plugins with the new core +version dependency, then tag the new versions of the plugins. +@c Anything else to help keep dependencies up-to-date? + +To begin the process a developer needs to know whether the working +directory tree is git clean (with all changes committed) and lint +free. Presumably this was the state when the candidate release was +tested. The developer also needs to know if the core has been changed +since its last release, which plugins have changed, and what files +changed. + +@deffn Procedure devops:full-status +Write a status report listing the changed files to be released and +warning of unclean files, lint, or other possible trouble. The +current working directory should be the top of the git repository. +@end deffn + +@deffn Procedure devops:status +Write a short status report warning of unclean files, lint, or other +possible trouble. The current working directory should be the top of +the git repository. +@end deffn + +With the full status report well considered, the developer will create +a release tag and build its source distribution. If a shared server +is in use, the tag is pushed and the source is uploaded. + +@deffn Procedure devops:release [plugin] +Warn of unclean files, lint, or other possible trouble, but tag +@var{plugin} (or core) regardless and build a source distribution. If +@var{plugin} is @code{"snapshot"} create source distributions, but not +git tags, for all changed plugins (or core). +@end deffn + +@node Build Process +@section Build Process + +The @emph{build} process begins in the @emph{project} (or developer) +git repository, possibly a bare repository on a shared server, where a +new release tag and source distribution have recently appeared. +Running the build status report here causes each build host to be +contacted by passwordless @code{ssh}. New source distributions are +uploaded and build daemons spawned. Subsequent status reports show +what the daemons are working on and what remains to be done. + +Rather than track dependencies between releases and order builds +accordingly, the build daemons just work through them sequentially in +the order they were released (by file modification dates). If a build +fails no further builds are attempted until the error log is removed. +Another build status report will spawn a daemon to continue the work. + +@deffn Procedure devops:build-status +Polls each build host. Uploads new releases. Shows what the build +daemon is working on and the work that remains to be done. +@end deffn + +Each build host needs a host Scheme installed, typically the latest +release of MIT/GNU Scheme. It will also need any C headers and +libraries required to build the desired plugins. The core binary +packages are installed in @file{/usr/local/} and the Ubuntu packages +in @file{/usr/}. Each plugin is built by and installed in the core +Scheme(s). For passwordless installation the @file{/usr/local/} +directory tree should be writable by the builder. + +On an Ubuntu host the builder must be able to install new packages +using passwordless @code{sudo}. This might be arranged with an +entry in @file{/etc/sudoers}, e.g. +@example +puck ALL=(root) NOPASSWD: /usr/local/bin/mit-scheme-pucked-install +@end example +and a short script, e.g. +@example +#!/bin/bash +set -e +exec dpkg --install "/home/puck/mit-scheme/$1" +@end example + +@emph{Temporarily:} the host Scheme must be the unofficial version +9.2.2, recently created from the @code{release-9.2} branch of the +MIT/GNU Scheme project repository on Savannah. Debian packages and +source and binary distributions for 9.2.2 can be found on the pucked +project web site. @uref{http://birchwood-abbey.net/~matt/Scheme/} + +@node Lint Detection +@section Lint Detection + +All of the devops release procedures warn of ``lint'' in the source +code and documentation. This includes out-of-date version numbers, +copyright notices, etc. + +@menu +* Core Lint:: +* Plugin Lint:: +@end menu + +@node Core Lint +@subsection Core Lint + +The following checks are performed on a core Scheme source tree. + +The project version numbers in the documentation (@file{version.texi}) +and source (@file{runtime/version.scm}), and in +@file{debian/changelog} should match. +@c The Debian revision should always be 1? + +If there is a change in any file in the core source, the +project version should have been incremented. + +All files should contain a header with the same copyright notice and +the notice should include the current year. +@c Unless no file has changed since the last year in the notice? + +@node Plugin Lint +@subsection Plugin Lint + +The following checks are performed on a plugin source tree. + +The plugin version numbers in the documentation (@file{version.texi}) +and source (@file{make.scm}), in @file{NEWS} and +@file{src/configure.ac} and @file{debian/changelog} all match. + +If there is a change in any file in the plugin source, the plugin +version should have been incremented. + +All files should contain a header with the same copyright notice and +the notice should include the current year. +@c Unless no file has changed since the last year in the notice? + +The source includes all GNU standard files, @file{README}, +@file{ChangeLog}, @file{AUTHORS}, @file{COPYING} and @file{NEWS} are +present in the customary format. + +The plugin should have a manual containing a @code{@@deffn} section +for every binding it exports to the global environment. diff --git a/src/devops/compile.sh b/src/devops/compile.sh new file mode 100755 index 000000000..20ff61114 --- /dev/null +++ b/src/devops/compile.sh @@ -0,0 +1,19 @@ +#!/bin/sh +# -*-Scheme-*- + +# Compile the Developer Operations plugin. + +set -e +: ${MIT_SCHEME_EXE=mit-scheme} +${MIT_SCHEME_EXE} --batch-mode <<\EOF +(begin + (compile-file "build") + (compile-file "devops") + (load-option 'cref) + (cref/generate-constructors "devops") + ) +EOF +suffix=`echo "(display (microcode-id/operating-system-suffix))" \ + | ${MIT_SCHEME_EXE} --batch-mode` +report=devops-$suffix.crf +if [ -s "$report" ]; then echo "$report:1: warning: not empty"; fi diff --git a/src/devops/configure.ac b/src/devops/configure.ac new file mode 100644 index 000000000..076a5f57b --- /dev/null +++ b/src/devops/configure.ac @@ -0,0 +1,53 @@ +dnl Process this file with autoconf to produce a configure script. + +AC_INIT([MIT/GNU Scheme Pucked Developer Operations plugin], + [0.1], + [matt@birchwood-abbey.net], + [mit-scheme-pucked-devops]) +AC_CONFIG_SRCDIR([devops.pkg]) + +AC_COPYRIGHT( +[Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, + 2016, 2017 Matthew Birkholz + +This file is part of a Developer Operations plugin for MIT/GNU Scheme +Pucked. + +This plugin is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2 of the License, or (at your +option) any later version. + +This plugin 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 plugin; if not, write to the Free Software Foundation, +Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. +]) + +AM_INIT_AUTOMAKE + +AC_PROG_INSTALL + +MIT_SCHEME_PROJECT=mit-scheme-pucked +: ${MIT_SCHEME_EXE=mit-scheme} +MIT_SCHEME_LIBDIR=`( echo "(display (->namestring" ;\ + echo " (system-library-directory-pathname)))" ) \ + | ${MIT_SCHEME_EXE} --batch-mode` + +MIT_SCHEME_OS_SUFFIX=`echo "(display (microcode-id/operating-system-suffix))" \ + | ${MIT_SCHEME_EXE} --batch-mode` + +# Install plugin docs in Scheme's docdir subdirectories. +htmldir='$(datarootdir)/doc/$(MIT_SCHEME_PROJECT)/html' +pdfdir='$(datarootdir)/doc/$(MIT_SCHEME_PROJECT)/pdf' + +AC_SUBST([MIT_SCHEME_PROJECT]) +AC_SUBST([MIT_SCHEME_EXE]) +AC_SUBST([MIT_SCHEME_LIBDIR]) +AC_SUBST([MIT_SCHEME_OS_SUFFIX]) +AC_CONFIG_FILES([Makefile]) +AC_OUTPUT diff --git a/src/devops/debian/changelog b/src/devops/debian/changelog new file mode 100644 index 000000000..c08e79942 --- /dev/null +++ b/src/devops/debian/changelog @@ -0,0 +1,5 @@ +mit-scheme-pucked-devops (0.1) experimental; urgency=low + + * New package created from a random collection of scripts. + + -- Matt Birkholz Mon, 30 Apr 2017 00:00:00 -0700 diff --git a/src/devops/debian/compat b/src/devops/debian/compat new file mode 100644 index 000000000..ec635144f --- /dev/null +++ b/src/devops/debian/compat @@ -0,0 +1 @@ +9 diff --git a/src/devops/debian/control b/src/devops/debian/control new file mode 100644 index 000000000..5d623ca0c --- /dev/null +++ b/src/devops/debian/control @@ -0,0 +1,18 @@ +Source: mit-scheme-pucked-devops +Section: lisp +Priority: optional +Maintainer: Matt Birkholz +Build-Depends: debhelper (>= 9), + mit-scheme-pucked, + texinfo, texlive +Standards-Version: 3.9.4 +Homepage: http://birchwood-abbey.net/~matt/Scheme/ +Vcs-Git: git://birchwood-abbey.net/~matt/mit-scheme.git +Vcs-Browser: http://birchwood-abbey.net/gitweb/?p=mit-scheme.git;a=summary + +Package: mit-scheme-pucked-devops +Architecture: any +Depends: mit-scheme-pucked +Description: Developer Operations plugin for MIT/GNU Scheme Pucked + Tools to help create source releases and manage build hosts producing + binaries for them. diff --git a/src/devops/debian/copyright b/src/devops/debian/copyright new file mode 100644 index 000000000..16ebdaa56 --- /dev/null +++ b/src/devops/debian/copyright @@ -0,0 +1,30 @@ +Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Upstream-Name: mit-scheme-pucked-devops +Source: http://birchwood-abbey.net/~matt/Scheme/ + +Files: * +Copyright: +Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, + 2016, 2017 Matthew Birkholz +License: GPL-2+ + This package is a developer operations plugin for MIT/GNU Scheme + Pucked, an experimental version of MIT/GNU Scheme. + . + This package is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or (at + your option) any later version. + . + This package 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 package; if not, write to the Free Software + Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, + USA. + . + On Debian systems, the complete text of the GNU General + Public License version 2 can be found in + "/usr/share/common-licenses/GPL-2". diff --git a/src/devops/debian/doc-base b/src/devops/debian/doc-base new file mode 100644 index 000000000..4998e1135 --- /dev/null +++ b/src/devops/debian/doc-base @@ -0,0 +1,15 @@ +Document: mit-scheme-pucked-devops +Title: MIT/GNU Scheme Pucked Developer Operations Manual +Author: Matt Birkholz + +Abstract: The Developer Operations plugin for MIT/GNU Scheme Pucked + contains tools for creating lint free source releases and managing + build hosts producing binaries for them +Section: Programming + +Format: HTML +Index: /usr/share/doc/mit-scheme-pucked/html/devops.html +Files: /usr/share/doc/mit-scheme-pucked/html/devops.html + +Format: PDF +Files: /usr/share/doc/mit-scheme-pucked/pdf/devops.pdf.gz diff --git a/src/devops/debian/docs b/src/devops/debian/docs new file mode 100644 index 000000000..50bd824bb --- /dev/null +++ b/src/devops/debian/docs @@ -0,0 +1,2 @@ +NEWS +README diff --git a/src/devops/debian/postinst.in b/src/devops/debian/postinst.in new file mode 100755 index 000000000..5518a995e --- /dev/null +++ b/src/devops/debian/postinst.in @@ -0,0 +1,11 @@ +#!/bin/sh + +set -e + +( echo '(add-plugin "@PLUGIN@" "@PROJECT@"'; \ + echo ' "@INFODIR@"'; \ + echo ' (system-library-directory-pathname)'; \ + echo ' "@SCMDOCDIR@")' ) \ +| /usr/bin/mit-scheme-pucked --batch-mode + +exit 0 diff --git a/src/devops/debian/prerm.in b/src/devops/debian/prerm.in new file mode 100755 index 000000000..9a5caedd3 --- /dev/null +++ b/src/devops/debian/prerm.in @@ -0,0 +1,11 @@ +#!/bin/sh + +set -e + +( echo '(remove-plugin "@PLUGIN@" "@PROJECT@"'; \ + echo ' "@INFODIR@"'; \ + echo ' (system-library-directory-pathname)'; \ + echo ' "@SCMDOCDIR@")' ) \ +| mit-scheme-pucked --batch-mode + +exit 0 diff --git a/src/devops/debian/rules b/src/devops/debian/rules new file mode 100755 index 000000000..3b1945de8 --- /dev/null +++ b/src/devops/debian/rules @@ -0,0 +1,15 @@ +#!/usr/bin/make -f + +export MIT_SCHEME_EXE=mit-scheme-pucked + +%: debian/postinst debian/prerm + dh $@ + +override_dh_auto_install: debian/postinst debian/prerm + dh_auto_install -- install-html install-pdf + +debian/%: debian/%.in + sed -e 's|@SCMDOCDIR@|/usr/share/doc/mit-scheme-pucked|g' \ + -e 's|@INFODIR@|/usr/share/info|g' \ + -e 's|@PROJECT@|mit-scheme-pucked|g' \ + -e 's|@PLUGIN@|devops|g' < $< > $@ diff --git a/src/devops/debian/source/format b/src/devops/debian/source/format new file mode 100644 index 000000000..89ae9db8f --- /dev/null +++ b/src/devops/debian/source/format @@ -0,0 +1 @@ +3.0 (native) diff --git a/src/devops/debian/watch b/src/devops/debian/watch new file mode 100644 index 000000000..fb618e228 --- /dev/null +++ b/src/devops/debian/watch @@ -0,0 +1,2 @@ +version=3 +http://birchwood-abbey.net/~matt/Scheme/mit-scheme-pucked-devops-([0-9.]+)\.tar\.gz debian uupdate diff --git a/src/devops/devops.pkg b/src/devops/devops.pkg new file mode 100644 index 000000000..c04725aec --- /dev/null +++ b/src/devops/devops.pkg @@ -0,0 +1,39 @@ +#| -*-Scheme-*- + +Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, + 2016, 2017 Matthew Birkholz + +This file is part of a Developer Operations plugin for MIT/GNU Scheme Pucked. + +This plugin is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2 of the License, or (at your +option) any later version. + +This plugin 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 plugin; if not, write to the Free Software Foundation, +Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +|# + +;;;; Developer Operations System Packaging + +(global-definitions runtime/) + +(define-package (devops build) + (parent ()) + (files "build")) + +(define-package (devops) + (parent (devops build)) + (files "devops") + (export () + devops:status + devops:full-status + devops:release + devops:build-status)) \ No newline at end of file diff --git a/src/devops/devops.scm b/src/devops/devops.scm new file mode 100644 index 000000000..b1ad3d931 --- /dev/null +++ b/src/devops/devops.scm @@ -0,0 +1,718 @@ +#| -*-Scheme-*- + +Copyright (C) 2016, 2017 Matthew Birkholz + +This file is part of a devops plugin for MIT/GNU Scheme Pucked. + +This plugin is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2 of the License, or (at your +option) any later version. + +This plugin 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 plugin; if not, write to the Free Software Foundation, +Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +|# + +;;;; Developer Operations + +;;; See devops.texi for complete details. + +(define (devops:full-status) (status #t)) + +(define (devops:status) (status #f)) + +(define (status full?) + (let ((dirt (shell-lines "git status --porcelain --untracked-files=no"))) + (if (file-exists? "src/runtime/version.scm") + (core-status full? dirt)) + (let ((ps (plugins))) + (if (pair? ps) + (for-each (lambda (p) (plugin-status p full? dirt)) ps) + (log "no plugins\n"))))) + +(define (core-status full? dirt) + (let ((version (core-version)) + (changed (core-changed-files))) + (let ((lint (core-lint version changed dirt))) + (if (or (not (null? lint)) + full?) + (begin + (log "# "(project-name)" "version":\n") + (write-lint lint) + (if full? + (write-changed-files changed))))))) + +(define (plugin-status plugin full? dirt) + (let ((changed (plugin-changed-files plugin))) + (let ((lint (plugin-lint plugin changed dirt))) + (if (or (not (null? lint)) + full?) + (let ((name (plugin-name plugin)) + (vers (plugin-version plugin))) + (log "# "name" "vers":\n") + (write-lint lint) + (if full? + (write-changed-files changed))))))) + +(define (write-lint lint) + (for-each (lambda (line) + (write-string line) + (newline)) + lint)) + +(define (write-changed-files changed) + (if (pair? changed) + (begin + (log "Changed files:\n") + (for-each (lambda (filename) + (log " "filename"\n")) + changed)))) + +(define core-lint-hook #f) +(define plugin-lint-hook #f) + +(define (core-lint version changed dirt) + (let ((dversion (debian-version ".")) + (released (released-version (project-name)))) + (append + (dirt->core-lint dirt) + (debian-version-lint version dversion) + (released-version-lint version released changed) + (if core-lint-hook + (core-lint-hook) + '())))) + +(define (plugin-lint plugin changed dirt) + (let ((version (plugin-version plugin)) + (dversion (debian-version (plugin-directory plugin))) + (released (released-version (plugin-project-name plugin)))) + (append + (dirt->plugin-lint plugin dirt) + (debian-version-lint version dversion) + (released-version-lint version released changed) + (if plugin-lint-hook + (plugin-lint-hook plugin changed dirt) + '())))) + +(define (debian-version dir) + (let* ((changelog (string dir"/debian/changelog")) + (line (and (file-exists? changelog) + (file-first-line changelog))) + (regs (and line + (re-string-match ".* +(\\([^)]+\\))" line)))) + (if regs + (re-match-extract line regs 1) + (error "could not find Debian version:" line)))) + +(define (debian-version-lint version dversion) + (append + (if (not version) + (list "Package version not found.") + '()) + (if (not dversion) + (list "Debian version not found.") + '()) + (if (and version dversion + (not (string=? version dversion))) + (list (string "Debian version ("dversion") does not match.")) + '()))) + +(define (released-version-lint version released changed) + (cond ((eq? #f released) + (list "First release!")) + ((and (not (null? changed)) + (not (versionversion released) + (->version version)))) + (list "Version is out-of-date.")) + (else + '()))) + +(define (dirt->core-lint dirt) + (let ((lint + (let ((ps (plugins))) + (filter (lambda (line) + (let ((length (string-length line))) + (not (any (lambda (p) + (plugin-dirt? p line length)) + ps)))) + dirt)))) + (if (not (null? lint)) + (cons "Uncommitted changes:" lint) + lint))) + +(define (dirt->plugin-lint plugin dirt) + (let ((lint + (filter (lambda (line) + (plugin-dirt? plugin line (string-length line))) + dirt))) + (if (not (null? lint)) + (cons "Uncommitted changes:" lint) + lint))) + +(define (plugin-dirt? plugin line line-len) + (let* ((dir (plugin-directory plugin)) + (dir-len (string-length dir)) + (dir-end (fix:+ 3 dir-len))) + (and (fix:>= line-len dir-end) + (string=? dir (substring line 3 dir-end))))) + +(load-option 'regular-expression) + +(define (core-version) + (call-with-input-file "src/runtime/version.scm" + (lambda (in) + (let loop () + (let* ((line (read-line in)) + (patt ".*ubsystem-identification! \"Release\" '(\\([0-9 ]+\\))") + (regs (and (string? line) + (re-string-match patt line)))) + (if regs + (string-replace (re-match-extract line regs 1) #\space #\.) + (if (eof-object? line) + (error "could not find core version") + (loop)))))))) + +(define (released-version name) + (let* ((tags (sorted-tags name)) + (last-tag (and (pair? tags) + (cdar tags))) + (regs (and last-tag + (re-string-match (string name"-\\([0-9.]+\\)$") last-tag)))) + (and regs + (re-match-extract last-tag regs 1)))) + +(define (core-changed-files) + (let ((hash (released-hash (project-name)))) + (and hash + (let ((excluded-dirs (map plugin-directory (plugins)))) + (filter + (lambda (filename) + (not (any (lambda (excluded-dir) + (string-prefix? excluded-dir filename)) + excluded-dirs))) + (shell-lines "git diff --name-only "hash)))))) + +(define (released-hash name) + (let* ((tags (sorted-tags name)) + (last-tag (and (pair? tags) + (cdar tags)))) + (and last-tag + (car (shell-lines "git log --format=%H -1 "last-tag))))) + +(define (plugin-version plugin) + (call-with-input-file (string (plugin-directory plugin)"/configure.ac") + (lambda (in) + (let loop () + (let* ((line (read-line in)) + (regs (and (string? line) + (re-string-match "^AC_INIT" line)))) + (if regs + (let* ((line (read-line in)) + (regs (and (string? line) + (re-string-match "[ \t]*[[]\\([0-9.]+\\)[]]" + line)))) + (if regs + (re-match-extract line regs 1) + (error "no plugin version:" (plugin-name plugin)))) + (if (eof-object? line) + (error "no AC_INIT:" (plugin-name plugin)) + (loop)))))))) + +(define (plugin-changed-files plugin) + (let ((hash (released-hash (plugin-project-name plugin)))) + (and hash + (let ((dir (plugin-directory plugin))) + (filter (lambda (filename) + (string-prefix? dir filename)) + (shell-lines "git diff --name-only "hash)))))) + +;;;; Release + +(define (devops:release #!optional plugin) + + (define (dirt) + (shell-lines "git status --porcelain --untracked-files=no")) + + (cond ((default-object? plugin) + (release-core (dirt) #f)) + ((or (equal? "snapshot" plugin) + (eq? 'snapshot plugin)) + (let ((d (dirt))) + (snapshot-core d) + (for-each (lambda (p) (snapshot-plugin p d)) + (plugins)))) + ((or (string? plugin) (symbol? plugin)) + (let* ((name (string plugin)) + (p (find (lambda (p) (string=? name (plugin-name p))) + (plugins)))) + (release-plugin p (dirt) #f))) + (else + (error "Plugin must be a string or symbol.")))) + +(define (release-core dirt snap?) + (let ((changed (core-changed-files))) + (if (and (null? changed) (not snap?)) + (error "no changed files")) + (let* ((version (core-version)) + (project (project-name)) + (pkg (string project"-"version)) + ;;(topdir (car (shell-lines "/bin/pwd"))) + (lint (core-lint version changed dirt))) + (log "# "pkg":\n") + (write-lint lint) + (write-changed-files changed) + (run "mkdir devops/"pkg) + (if snap? + (run "git archive --prefix="project"/ HEAD" + " | ( cd devops/"pkg" && tar xf - )") + (let ((hash (car (shell-lines "git log --format=%H -1 HEAD"))) + (datime + (universal-time->local-time-string (get-universal-time)))) + (run "git tag -s -m \""datime" "hash"\" "pkg) + (run "git archive --prefix="project"/ "pkg + " | ( cd devops/"pkg" && tar xf - )"))) + (run "cd devops/"pkg" && "project"/dist/make-src-files standard") + (run "chmod 444 devops/"pkg"/"pkg".tar.gz") + (run "mv devops/"pkg"/"pkg".tar.gz devops/") + (run "rm -rf devops/"pkg) + (run "cd devops/ && tar xzf "pkg".tar.gz") + (run "cd devops/ && dpkg-source --build "pkg) + (run "chmod 444 devops/"project"_"version".dsc") + (run "chmod 444 devops/"project"_"version".tar.xz") + (run "rm -rf devops/"pkg)))) + +(define (release-plugin plugin dirt snap?) + (let ((changed (plugin-changed-files plugin)) + (pkg (plugin-package-name plugin)) + (dir (plugin-directory plugin))) + (if (and (null? changed) (not snap?)) + (error "no changed files")) + (let ((lint (plugin-lint plugin changed dirt)) + (logfile (string "devops/"pkg"-src.log"))) + (log "# "pkg":\n") + (write-lint lint) + (write-changed-files changed) + (with-output-log + logfile + (lambda () + (if snap? + (run "git archive --prefix="pkg"/ HEAD -- "dir + " | ( cd devops && tar xf - )") + (let ((hash (car (shell-lines "git log --format=%H -1 HEAD"))) + (datime + (universal-time->local-time-string (get-universal-time)))) + (run "git tag -s -m \""datime" "hash"\" "pkg) + (run "git archive --prefix="pkg"/ "pkg" -- "dir + " | ( cd devops && tar xf - )"))) + (run "cd devops/"pkg"/"dir" && ./autogen.sh") + (run "cd devops/"pkg"/"dir" && ./configure") + (run "cd devops/"pkg"/"dir" && make dist") + (run "mv devops/"pkg"/"dir"/"pkg".tar.gz devops/") + (run "chmod 444 devops/"pkg".tar.gz") + (run "rm -rf devops/"pkg) + (let ((name (plugin-project-name plugin)) + (vers (plugin-version plugin))) + (run "cd devops/ && tar xzf "pkg".tar.gz") + (run "cd devops/ && dpkg-source --build "pkg) + (run "chmod 444 devops/"name"_"vers".dsc") + (run "chmod 444 devops/"name"_"vers".tar.xz") + (run "rm -rf devops/"pkg)))) + (delete-file logfile)))) + +(define (snapshot-core dirt) + (let ((changed (or (core-changed-files) '())) + (version (core-version)) + (released-version (released-version (project-name)))) + (let ((new (->version version)) + (old (->version released-version)) + (source-filename + (string "devops/"(project-name)"-"version".tar.gz"))) + (define (found) (log "# "source-filename":\nAlready done.\n")) + (cond ((and (null? changed) + (version=? old new)) + (if (file-exists? source-filename) + (found) + (release-core dirt #t))) + ((and (pair? changed) + (versionversion version)) + (old (->version released-version)) + (source-filename + (string "devops/" + (plugin-project-name plugin)"-"version".tar.gz"))) + (define (found) (log "# "source-filename":\nAlready done.\n")) + (cond ((and (null? changed) + (version=? old new)) + (if (file-exists? source-filename) + (found) + (release-plugin plugin dirt #t))) + ((and (pair? changed) + (versionlocal-time-string + (file-modification-time ,lockfile))) + i/o) + (flush-output i/o) + (read-until 3000 i/o)))) + (log "Daemon started "start-time"\n")) + (log "No daemon running.\n"))) + +(define (write-pkg-status name vers sarch files host i/o) + (let ((logfile (string name"-"vers"-"sarch"-pkg.log"))) + (if (not (member logfile files)) + (let ((bin (string name"-"vers"-"sarch".tar.gz")) + (elogfile (string name"-"vers"-"sarch"-pkg-error.log"))) + (log bin"\n") + (if (member elogfile files) + (write-minutes-stalled + (string (host-directory host)"/"elogfile) i/o)))))) + +(define (write-ubuntu-status name vers darch files host i/o) + (let ((logfile (string name"-"vers"-"darch"-dpkg.log"))) + (if (not (member logfile files)) + (let ((bin (string name"_"vers"_"darch".deb")) + (elogfile (string name"_"vers"_"darch"-dpkg-error.log"))) + (log bin"\n") + (if (member elogfile files) + (write-minutes-stalled + (string (host-directory host)"/"elogfile) i/o)))))) + +(define (write-minutes-stalled elogpath i/o) + (let ((min (begin + (write-line + `(write-line (- (get-universal-time) + (file-time->universal-time + (file-modification-time ,elogpath)))) + i/o) + (flush-output i/o) + (quotient (read-until 3000 i/o) 60)))) + (cond ((> min 60) + (log " No progress in over an hour!\n")) + ((> min 10) + (log " No progress in "min" minutes.\n")) + (else + (log " Working...\n"))))) + +(define (start-builds host i/o) + (write-file (let ((sys (system-library-pathname "devops/build.scm" #f))) + (if (file-exists? sys) + sys + (let ((repo "src/devops/build.scm")) + (if (file-exists? repo) + repo + (error "could not find build script"))))) + i/o) + + ;;(verify-host-debian-architecture host i/o) + ;;(if (host-ubuntu? host) + ;; (verify-host-ubuntu-ness host i/o)) + + (write-line `(begin + (set! project-name ,(project-name)) + (set! build-dir ,(host-directory host)) + (set! build-scheme-architecture + ,(host-scheme-architecture host)) + (set! build-debian-architecture + ,(host-debian-architecture host)) + (set! build-ubuntu? + ,(host-ubuntu? host)) + (build)) + i/o) + (flush-output i/o) + (let ((lines (read-lines-until "OK" 3000 i/o))) + (if (not lines) + (error "not OK"))) + (close-input-port i/o) + (close-output-port i/o)) + +(define (verify-host-debian-architecture host i/o) + (write-line '(debian-architecture) i/o) + (flush-output i/o) + (let ((darch (read-until 3000 i/o))) + (if (not (string? darch)) + (error "no Debian architecture")) + (if (not (string=? darch (host-debian-architecture host))) + (error "wrong Debian architecture")))) + +(define (verify-host-ubuntu-ness host i/o) + (write-line '(if (ubuntu?) "yes" "no") i/o) + (flush-output i/o) + (let ((str (read-until 3000 i/o))) + (if (not (string? str)) + (error "no Ubuntu-ness")) + (let ((ubu? (string=? "yes" str))) + (if (not (eq? ubu? (host-ubuntu? host))) + (error "wrong Ubuntu-ness"))))) + +(define (call-with-host-i/o host receiver) + (call-with-current-continuation + (lambda (punt) + (bind-condition-handler (list condition-type:serious-condition + condition-type:simple-condition) + (named-lambda (host-condition-handler condition) + (write-condition-report condition (current-output-port)) + (newline) + (punt unspecific)) + (lambda () + (let ((proc #f)) + (dynamic-wind + (lambda () + unspecific) + (lambda () + (set! proc (start-pipe-subprocess + (os/find-program "ssh" #f) + (vector "ssh" (host-login host) + "mit-scheme" "--batch-mode") + #f)) + (receiver (subprocess-i/o-port proc))) + (lambda () + (if (and proc (memq (subprocess-status proc) '(running stopped))) + (ignore-errors (lambda () (subprocess-kill proc)))))))))))) + +(define (read-lines-until match usec in) + (do-until + (lambda () + (let loop ((lines '())) + (let ((line (read-line in))) + (if (eof-object? line) + (reverse! lines) + (if (string=? match line) + (reverse! (cons line lines)) + (loop (cons line lines))))))) + usec + (lambda () #f))) + +(define (read-until usec in) + (do-until (lambda () (read in)) + usec + (lambda () 'timeout))) + +(define (do-until thunk usec timeout) + (call-with-current-continuation + (lambda (return) + (let* ((record + (register-timer-event usec + (named-lambda (timeout-do-until) + (return (timeout))))) + (value (thunk))) + (deregister-timer-event record) + value)))) + +;;;; Configuration + +(define (project-name #!optional name) + (if (default-object? name) + project-name-string + (begin + (if (not (string? name)) + (error "Project name is not a string:" name)) + (set! project-name-string name) + name))) + +(define project-name-string "new-scheme") + +(define (plugin-project-name plugin) + (string (project-name)"-"(plugin-name plugin))) + +(define (plugin-package-name plugin) + (string (plugin-project-name plugin)"-"(plugin-version plugin))) + +(define (plugin name directory) + (let ((duplicate (find (lambda (p) (string=? name (plugin-name p))) + plugin-list))) + (if duplicate + (error (string "Plugin "name" already defined.")))) + (set! plugin-list + (append! plugin-list + (list (make-plugin name directory)))) + unspecific) + +(define (plugins) (list-copy plugin-list)) + +(define plugin-list '()) + +(define-record-type + (make-plugin name directory) + plugin? + (name plugin-name) + (directory plugin-directory)) + +(define (host name user directory sarch darch ubuntu?) + (let ((duplicate (find (lambda (h) (string=? name (host-name h))) + host-list))) + (if duplicate + (error (string "Host "name" already defined.")))) + (set! host-list + (append! host-list + (list (make-host name user directory sarch darch ubuntu?)))) + unspecific) + +(define (hosts) (list-copy host-list)) + +(define host-list '()) + +(define (host-login/dir h) + (string (host-login h)":"(host-directory h))) + +(define (host-login h) + (let ((n (host-name h)) + (u (host-user h))) + (if u + (string u"@"n) + n))) + +(define-record-type + (make-host name user directory sarch darch ubuntu?) + host? + (name host-name) + (user host-user) + (directory host-directory) + (sarch host-scheme-architecture) + (darch host-debian-architecture) + (ubuntu? host-ubuntu?)) + +;;;; Misc + +(define (sorted-tags package-name) + (sort (let ((pattern (string package-name"-\\(.*\\)$"))) + (map (lambda (line) + (let ((regs (re-string-match pattern line))) + (if regs + (cons (->version (re-match-extract line regs 1)) + line) + (error "Bogus line from git tag:" line)))) + (shell-lines "git tag -l '"package-name"-*'"))) + (lambda (a b) (versionversion string) + (and string + (map string->number (burst-string string #\. #f)))) + +(define version=? equal?) + +(define (version (car v1) (car v2)) + #f) + (else + (versionenvironment '(runtime pathname))))))) \ No newline at end of file diff --git a/src/devops/pucked.texi b/src/devops/pucked.texi new file mode 100644 index 000000000..e712b8bb3 --- /dev/null +++ b/src/devops/pucked.texi @@ -0,0 +1,108 @@ +@node Changes +@chapter How so ``pucked?'' + +The user visible differences between MIT/GNU Scheme version 9.2.2 and +MIT/GNU Scheme Pucked version 9.2.7 are detailed in @ref{Release +Notes, , , user, MIT/GNU Scheme Pucked User Manual}. This chapter is +a review of @emph{all} source code changes, with reference to the +output of specific @code{git diff} commands. + +The commands in this chapter assume you have cloned the project git +repository, fetched the experimental branch, and checked it out, +as described in @ref{Project Repository}. + +The following commands can be (have been!)@: used in a clone like the +one described above. They show all differences between the master +branch on Savannah (@code{origin/master}) and the experimental branch +in the repository at Birchwood Abbey, @code{puck/pucked}. The +discussion following each command is a quick summary of the diffs. + +@table @code +@item $cmd="git diff origin/master puck/pucked --" +The command lines in this table assume you have defined @code{cmd} as +above. + +@item $cmd dist/ +@code{PROJECT_NAME} was changed. @file{debian/} was added. All +plugin code was removed from the core source distribution. + +@item $cmd doc/ +The project name, email and version were changed. The manpage and +user's manual were renamed and updated. The Imail manual was moved to +the Imail plugin's source directory. All manuals were changed to fit +inside a new, top-level @file{mit-scheme-pucked.info} file, the only +Info file installed in the system Directory node. Added a +@file{style.css} for @file{htmldir}, a copy of the style sheets used +with online manuals at @indicateurl{gnu.org}. + +@item $cmd etc/ +No changes were made. + +@item $cmd src/microcode/ +Project and executable names, the microcode version and copyright +notice were change. The C code for the microcode modules was removed, +including files @file{prbfish.c}, @file{prgdbm.c}, @file{prmcrypt.c}, +@file{prmd5.c}, @file{prmhash.c} and @file{prpgsql.c}, as well as +@file{x11base.c}, @file{x11color.c}, @file{x11graph.c} and +@file{x11term}. Modified versions of these can be found in the plugin +directories, e.g.@: @file{src/blowfish/}. All mention of the modules +was removed from the makefiles and configure scripts. + +@item $cmd src/runtime/ +The Scheme code that wrapped the microcode modules was removed, +including files @file{berkeley-db.scm}, @file{gdbm.scm}, +@file{pgsql.scm} and @file{x11graph.scm}. The packages @code{(runtime +x-graphics)}, @code{(runtime gdbm)} and @code{(runtime postgresql)} +were removed. The @code{--edit} command line argument handler was +stolen from Edwin as well as the @code{edit}, @code{edwin} and +@code{spawn-edwin} procedures, which now autoload Edwin. Pucked +source is included (installed) so runtime options need not be +installed specially. + +@item $cmd src/edwin/ +A number of Debian/GNU standard files were added to make this a +standalone plugin ready for @code{dpkg-buildpackage}. These include a +@file{Makefile.am} and a @file{configure.ac} as well as @file{NEWS}, +@file{AUTHORS}, @file{COPYING}, etc. Files specific to X11 +(@file{key-x11.scm}, @file{xcom.scm}, @file{xmodef.scm} and +@file{xterm.scm}) were moved into the X11 Screen plugin. The +@code{edit}, @code{edwin} and @code{spawn-edwin} procedures were +stolen by the runtime system. + +Edwin also changed to accommodate a new Gtk Screen plugin. The old +@code{screen} structure type became the abstract SOS class +@code{} and the concrete class @code{}. Most of +the existing, tty-specific screen procedures were renamed with a +@code{tty-} prefix. Many are called only by other tty procedures. +The few (20) that handle @emph{any} type of screen became SOS generic +procedures. + +@item $cmd src/imail/ +A number of Debian/GNU standard files were added and the manual +was moved here from the @file{doc/} directory. The only change to the +Scheme code was the addition of @code{(load-option 'md5)} where the +@code{md5-substring} procedure was used. + +@item $cmd src/etc/ +The Emacs tutorial was moved to the Edwin plugin's source directory. +Both Edwin and Imail were removed from @file{optiondb.scm} and scripts +like @file{build-bands.sh}. + +@item $cmd src/ffi/ +Added new build procedures @code{add-plugin} and @code{remove-plugin}, +which work with Debian package installation scripts +(e.g.@: @code{prerm}) and maintain Info as well as HTML indices of +installed plugins. + +@item $cmd src/compiler/ src/cref/ src/sf/ src/star-parser/ +No changes were made to the rest of the core subsystems except their +@file{Makefile-fragment}s. These now install all source files. + +@item $cmd src/6001/ src/sos/ src/ssp/ src/win32/ src/xdoc/ src/xml/ +No changes were made to the rest of the standard subsystems except +their @file{Makefile-fragment}s. + +@item $cmd tests +No changes were made to the test suite except to enable the FFI test. + +@end table -- 2.25.1