commit e74b648989b549c654ee2f9dda86b9f4e78c0237 Author: Cor Legemaat Date: Mon Jun 30 16:15:39 2025 +0200 Initial commit. diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..2e29a0b --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,4 @@ +((nil . ((eval . (add-hook 'before-save-hook 'copyright-update)))) + (scheme-mode . ((tab-width . 2) + (indent-tabs-mode . t) + (geiser-scheme-implementation . guile)))) diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c1452cb --- /dev/null +++ b/.gitignore @@ -0,0 +1,72 @@ +### Autotools ### +Makefile.in +Makefile + +# http://www.gnu.org/software/autoconf +autom4te.cache +/autoscan.log +/autoscan-*.log +/aclocal.m4 +/compile +/config.gues +/config.h.in +/config.log +/config.status +/config.sub +/config.guess +/config.rpath +/configure +/config.scan +/depcomp +/install-sh +/missing +/stamp-h1 +/stamp-h +/config.h +/ABOUT-NLS +/INSTALL +/timestamp +/AUTHORS +/ChangeLog + +# Libtool. +/ltmain.sh +libtool + +# temp files. +*~ + +# http://www.gnu.org/software/m4/ +m4/build-to-host.m4 +m4/gettext.m4 +m4/host-cpu-c-abi.m4 +m4/iconv.m4 +m4/intlmacosx.m4 +m4/lib-ld.m4 +m4/lib-link.m4 +m4/lib-prefix.m4 +m4/libtool.m4 +m4/lt~obsolete.m4 +m4/ltoptions.m4 +m4/ltsugar.m4 +m4/ltversion.m4 +m4/nls.m4 +m4/po.m4 +m4/progtest.m4 + +# Executables +*.go + +# gettext autogenerated files. +po/*sed +po/*.header +po/*.sin +po/Rules-quot +po/Makevars.template +po/POTFILES +po/Makefile.in.in +*.pot + +# Custom autogenerated. +/ebuild/version.scm +/ebuild/ebuild-autogen diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..be3f7b2 --- /dev/null +++ b/COPYING @@ -0,0 +1,661 @@ + GNU AFFERO GENERAL PUBLIC LICENSE + Version 3, 19 November 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 Affero General Public License is a free, copyleft license for +software and other kinds of works, specifically designed to ensure +cooperation with the community in the case of network server software. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +our General Public Licenses are 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. + + 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. + + Developers that use our General Public Licenses protect your rights +with two steps: (1) assert copyright on the software, and (2) offer +you this License which gives you legal permission to copy, distribute +and/or modify the software. + + A secondary benefit of defending all users' freedom is that +improvements made in alternate versions of the program, if they +receive widespread use, become available for other developers to +incorporate. Many developers of free software are heartened and +encouraged by the resulting cooperation. However, in the case of +software used on network servers, this result may fail to come about. +The GNU General Public License permits making a modified version and +letting the public access it on a server without ever releasing its +source code to the public. + + The GNU Affero General Public License is designed specifically to +ensure that, in such cases, the modified source code becomes available +to the community. It requires the operator of a network server to +provide the source code of the modified version running there to the +users of that server. Therefore, public use of a modified version, on +a publicly accessible server, gives the public access to the source +code of the modified version. + + An older license, called the Affero General Public License and +published by Affero, was designed to accomplish similar goals. This is +a different license, not a version of the Affero GPL, but Affero has +released a new version of the Affero GPL which permits relicensing under +this license. + + 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 Affero 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. Remote Network Interaction; Use with the GNU General Public License. + + Notwithstanding any other provision of this License, if you modify the +Program, your modified version must prominently offer all users +interacting with it remotely through a computer network (if your version +supports such interaction) an opportunity to receive the Corresponding +Source of your version by providing access to the Corresponding Source +from a network server at no charge, through some standard or customary +means of facilitating copying of software. This Corresponding Source +shall include the Corresponding Source for any work covered by version 3 +of the GNU General Public License that is incorporated pursuant to the +following paragraph. + + 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 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 work with which it is combined will remain governed by version +3 of the GNU General Public License. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU Affero 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 Affero 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 Affero 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 Affero 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 Affero 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 Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If your software can interact with users remotely through a computer +network, you should also make sure that it provides a way for users to +get its source. For example, if your program is a web application, its +interface could display a "Source" link that leads users to an archive +of the code. There are many ways you could offer source, and different +solutions will be better for different programs; see section 13 for the +specific requirements. + + 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 AGPL, see +. diff --git a/Makefile.am b/Makefile.am new file mode 100644 index 0000000..c8903fe --- /dev/null +++ b/Makefile.am @@ -0,0 +1,51 @@ +################################################################################ +# Makefile.am +# Copyright (C) 2025 Cor Legemaat +# +# This file is part of ebuild-autogen: you can redistribute it and/or modify it +# under the terms of the GNU Affero General Public License as published by the +# Free Software Foundation, version 3 of the License. + +# ebuild-autogen 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 +# ebuild-autogen. If not, see . +################################################################################ + +ACLOCAL_AMFLAGS=-I m4 + +SUBDIRS = po ebuild doc + +dist_doc_DATA = \ + README.org \ + COPYING \ + AUTHORS \ + INSTALL \ + NEWS + +# To use README.org instead of README. +README: README.org + +AUTHORS: + $(file >AUTHORS,$(shell git --no-pager shortlog -sn --email HEAD)) +.PHONY: AUTHORS + +ChangeLog: + $(file >ChangeLog,$(shell git log --oneline --graph)) +.PHONY: ChangeLog + +release-tag: + $(shell git tag -a "v$(VERSION)" -m "Release v$(VERSION)") + $(shell git push origin "v$(VERSION)") + +live: + mkdir -p /usr/share/guile/site/ebuild + mount --bind -o ro ebuild /usr/share/guile/site/ebuild/ + +# Remove doc directory on uninstall +uninstall-local: + -rm -r $(docdir) + +# End of Makefile.am diff --git a/NEWS b/NEWS new file mode 100644 index 0000000..e69de29 diff --git a/README.org b/README.org new file mode 100644 index 0000000..a3bd18a --- /dev/null +++ b/README.org @@ -0,0 +1,49 @@ +* ebuild-autogen +An application to fetch the latest releases of packages and auto-generate +ebuilds for them according to the ~autogen.scm~ definition and the +~.tmpl~ template in a git based portage overlay repository. + +** License +You can redistribute and/or modify [[https://www.cor.za.net/code/ebuild-autogen][ebuild-autogen]] under the terms of the GNU +Affero General Public License as published by the Free Software Foundation, +version 3 of the License. Please see =COPYING= file for the terms of GNU Affero +General Public License. + +** Repository structure +- ~/autogen/~ the subtree with the autogen sources for the repo. +- ~/autogen///autogen.scm~ The definition for the pkg. +- ~/autogen///.tmpl~ The template for the pkg. +- ~/autogen/repo-local/settings.scm~ The parameters for the repo. + +** example +#+begin_src scheme file: autogen.scm +;; Copyright (C) , distributed under the +;; terms of the GNU Affero General Public License version 3. +(define-module ( autogen)) + +(define-public setup-package + (lambda (parms) + '())) + +(define-public get-releases + (lambda (parms) + '())) + +(define-public generate-ebuilds + (lambda (parms releases) + '())) +#+end_src +- If ~autogen.scm~ does not exist or ~setup-packages~ is not defined in it, + the ~setup-pkg~ function in the module ~(ebuild repo)~ will be called to setup + the package folder and symbolic links. +- If ~get-releases~ exist in ~autogen.scm~ it will be called and should return the + list with all the releases otherwise an empty list will be used. +- If ~generate-ebuilds~ exist in ~autogen.scm~ it will be called to generate the + ebuild's, if not ~ebuild-gen~ will be called from ~(ebuild gen)~ to generate the + ebuilds. + +** execution +The executable is called ~ebuild-autogen~ and will update the ebuilds for all +the packages below the current working directory, so running it within the root +of the repository will update all the packages in the repository. +~ebuild-autogen --help~ should list all the options. diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..def0b35 --- /dev/null +++ b/configure.ac @@ -0,0 +1,102 @@ +define(EBUILD_AUTOGEN_CONFIGURE_COPYRIGHT, [[ +Copyright (C) 2025 Cor Legemaat + +This file is part of ebuild-autogen: you can redistribute it and/or modify it +under the terms of the GNU Affero General Public License as published by the +Free Software Foundation, version 3 of the License. + +ebuild-autogen 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 +ebuild-autogen. If not, see . +]]) + +m4_define([version_major], [0]) +m4_define([version_minor], [0]) +m4_define([version_revision], [0]) + +AC_PACKAGE_URL([http://www.cor.za.net/code/ebuild-autogen]) +AC_INIT(ebuild-autogen, + [version_major.version_minor.version_revision], + [mailto:cor@cor.za.net], + [], + [http://www.cor.za.net/code/ebuild-autogen]) +AC_COPYRIGHT(EBUILD_AUTOGEN_CONFIGURE_COPYRIGHT) +AM_INIT_AUTOMAKE([1.16 gnu]) + +AC_CONFIG_MACRO_DIR([m4]) + +dnl **************************************************************************** +dnl Add version detail to config.h and makefile.am +dnl **************************************************************************** +AC_DEFINE([VERSION_MAJOR], [version_major], [Major section of version]) +AC_DEFINE([VERSION_MINOR], [version_minor], [Minor section of version]) +AC_DEFINE([VERSION_REVISION], [version_revision], [Revision section of version]) + +dnl Push version detail to makefile.am +VERSION=[version_major.version_minor.version_revision] +AC_SUBST(VERSION,[version_major.version_minor.version_revision]) +VERSION_MAJOR=[version_major] +AC_SUBST(VERSION_MAJOR,[version_major]) +VERSION_MINOR=[version_minor] +AC_SUBST(VERSION_MINOR,[version_minor]) +VERSION_REVISION=[version_revision] +AC_SUBST(VERSION_REVISION,[version_revision]) + +dnl **************************************************************************** +dnl Check for the required guile dependency's. +dnl **************************************************************************** +m4_pattern_forbid([^GUILE_PKG$]) +m4_pattern_forbid([^GUILE_PROGS$]) + +GUILE_PKG([3.0 2.0 2.2]) + +GUILE_PROGS +GUILE_FLAGS +GUILE_SITE_DIR + +GUILE_MODULE_REQUIRED([srfi srfi-1]) +GUILE_MODULE_REQUIRED([srfi srfi-43]) +GUILE_MODULE_REQUIRED([ice-9 pretty-print]) +GUILE_MODULE_REQUIRED([oop goops]) +GUILE_MODULE_REQUIRED([config]) +GUILE_MODULE_REQUIRED([rx irregex]) +GUILE_MODULE_REQUIRED([dql dql]) +GUILE_MODULE_REQUIRED([curl]) +GUILE_MODULE_REQUIRED([json]) + +dnl Guile prefix and libdir. +GUILE_PREFIX=`$PKG_CONFIG --print-errors --variable=prefix guile-$GUILE_EFFECTIVE_VERSION` +GUILE_LIBDIR=`$PKG_CONFIG --print-errors --variable=libdir guile-$GUILE_EFFECTIVE_VERSION` +AC_SUBST(GUILE_PREFIX) +AC_SUBST(GUILE_LIBDIR) + +if test "$cross_compiling" != no; then + GUILE_TARGET="--target=$host_alias" + AC_SUBST([GUILE_TARGET]) +fi + +dnl *************************************************************************** +dnl Internationalization +dnl *************************************************************************** +AM_GNU_GETTEXT_REQUIRE_VERSION(0.20) +dnl AM_GNU_GETTEXT_VERSION(0.20) +AM_GNU_GETTEXT([external]) + +dnl *************************************************************************** + +AM_EXTRA_RECURSIVE_TARGETS([doc]) + +AC_CONFIG_FILES([Makefile +po/Makefile.in +ebuild/Makefile +ebuild/fetchers/Makefile +doc/Makefile]) +AC_CONFIG_COMMANDS([timestamp], [date >timestamp]) + +AC_OUTPUT + +# End the configure script. + diff --git a/doc/Makefile.am b/doc/Makefile.am new file mode 100644 index 0000000..e69de29 diff --git a/ebuild/Makefile.am b/ebuild/Makefile.am new file mode 100644 index 0000000..e417700 --- /dev/null +++ b/ebuild/Makefile.am @@ -0,0 +1,61 @@ +################################################################################ +# Makefile.am +# Copyright (C) 2025 Cor Legemaat +# +# This file is part of ebuild-autogen: you can redistribute it and/or modify it +# under the terms of the GNU Affero General Public License as published by the +# Free Software Foundation, version 3 of the License. + +# ebuild-autogen 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 +# ebuild-autogen. If not, see . +################################################################################ +SUBDIRS = fetchers + +moddir=$(datadir)/guile/site/$(GUILE_EFFECTIVE_VERSION)/ebuild +objdir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache/ebuild + +#https://www.gnu.org/software/automake/manual/html_node/Scripts.html +bin_SCRIPTS=ebuild-autogen +SOURCES = \ + bash-utils.scm \ + cli.scm \ + defs.scm \ + gen.scm \ + repo.scm \ + utils.scm \ + version.scm + +GOBJECTS = $(SOURCES:%.scm=%.go) + +nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) +nobase_obj_DATA = $(GOBJECTS) + +# Make sure source files are installed first, so that the mtime of +# installed compiled files is greater than that of installed source +# files. See +# +# for details. +guile_install_obj_files = install-nobase_obj_DATA +$(guile_install_obj_files): install-nobase_mod_DATA + +EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) \ + version.scm.in + +CLEANFILES = $(GOBJECTS) ${bin_SCRIPTS} + +GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat +GUILE_OPTS = -L $(abs_top_builddir) +SUFFIXES = .scm .go .in + +version.scm: version.scm.in + $(file >$@,$(subst {{version}},$(VERSION),$(file <$<))) + +ebuild-autogen: ebuild-autogen.in + $(file >$@,$(subst {{guile-bin}},$(GUILE),$(file <$<))) + +.scm.go: + $(GUILD) compile $(GUILE_TARGET) $(GUILE_OPTS) $(GUILE_WARNINGS) -o "$@" "$<" diff --git a/ebuild/bash-utils.scm b/ebuild/bash-utils.scm new file mode 100644 index 0000000..2764da0 --- /dev/null +++ b/ebuild/bash-utils.scm @@ -0,0 +1,61 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; bash-utils.scm +;; Copyright (C) 2025 Cor Legemaat +;; +;; This file is part of ebuild-autogen: you can redistribute it and/or modify it +;; under the terms of the GNU Affero General Public License as published by the +;; Free Software Foundation, version 3 of the License. +;; +;; ebuild-autogen 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 +;; ebuild-autogen. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-module (ebuild bash-utils) + #:use-module (rnrs io ports) + #:use-module (ice-9 expect) + #:use-module (ice-9 popen) + #:use-module (ice-9 rdelim)) + +(define-public bash-source-vars + (lambda (source var-list) + (let* ((in-pipe (pipe)) + (out-pipe (pipe O_NONBLOCK)) + (pid (spawn "bash" '("bash") + #:input (car in-pipe) + #:output (cdr out-pipe))) + (answ '()) + (expect-port (car out-pipe)) + (expect-timeout 1)) + ;; Make line buffered. + (setvbuf (cdr in-pipe) 'line) + (setvbuf (cdr out-pipe) 'line) + ;; Do the sourcing stuff. + (write-line source (cdr in-pipe)) + ;; Eliminate extra data to stdout from sourcing. + (write-line "echo \"Done sourcing!\"" (cdr in-pipe)) + (expect ((lambda (s eof?) + (string=? s "Done sourcing!\n")) + (lambda () #t))) + ;; Read the variables. + (set! answ + (map (lambda (var) + (write-line (string-append "echo \"${" + var + "}\"") (cdr in-pipe)) + (cons var (get-line (car out-pipe)))) + var-list)) + ;; Tel bash to exit. + (write-line "exit 0" (cdr in-pipe)) + ;; Close my side of the pipes + (close-port (car in-pipe)) + (close-port (cdr out-pipe)) + ;; Close bash's side of the pipes. + (close-port (cdr in-pipe)) + (close-port (car out-pipe)) + ;; Finish. + (waitpid pid) + answ))) diff --git a/ebuild/cli.scm b/ebuild/cli.scm new file mode 100644 index 0000000..e39a504 --- /dev/null +++ b/ebuild/cli.scm @@ -0,0 +1,277 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; cli.scm +;; Copyright (C) 2025 Cor Legemaat +;; +;; This file is part of ebuild-autogen: you can redistribute it and/or modify it +;; under the terms of the GNU Affero General Public License as published by the +;; Free Software Foundation, version 3 of the License. +;; +;; ebuild-autogen 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 +;; ebuild-autogen. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-module (ebuild cli) + #:use-module (ice-9 exceptions) + #:use-module (ice-9 format) + #:use-module (ice-9 pretty-print) + #:use-module (srfi srfi-1) + #:use-module (dql dql) + #:use-module (ebuild defs) + #:use-module (ebuild repo) + #:use-module (ebuild gen) + #:use-module (ebuild version) + #:use-module (config) + #:use-module (config api) + #:use-module (config parser sexp)) + +(define config + ;; Define our root configuration + (configuration + (name 'ebuild-autogen) + (keywords + (list + ;; Switch to force writing non-eager configuration files + (switch + (name 'write) (default #f) (test boolean?) (character #f) + (synopsis "Write configuration file in local dir.")) + (switch + (name 'verbosity) (default 3) (example "3") + (handler string->number) (test integer?) + (synopsis "The verbosity level.")) + (switch + (name 'subtree-update) (default #false) (test boolean?) + (synopsis "Fetch update subtree source repo")) + (switch + (name 'pkg-clean) (default #false) (test boolean?) + (synopsis "Remove packages from repo that's not in autogen subtree.")) + (switch + (name 'ebuild-clean) (default #false) (test boolean?) + (synopsis "Remove ebuilds no more active.")) + (switch + (name 'cache-clean) (default #false) (test boolean?) + (synopsis "Remove files from cache no more needed in tree gen.")) + (switch + (name 'remote-push) (default #false) (test boolean?) + (synopsis "Commit and push updated tree to remote.")) + (switch + (name 'init-from) (default "") (test string?) + (example "https://www.cor.za.net/code/portage-overlay") + (synopsis "An url to initialize the repo from scratch")) + ;; A setting in the configuration file, if it exists. + (setting + (name 'github-token) (default "") + (handler identity) (test string?) + (synopsis "The github authentication token.") + (description "The github authentication token as a string for +authentication when pulling package updates from github.")) + (setting + (name 'filecache-path) + (default (if (getenv "XDG_CACHE_HOME") + (getenv "XDG_CACHE_HOME") + (string-append (getenv "HOME") + "/.cache/ebuild-autogen"))) + (example (string-append (getenv "HOME") + "/.cache/ebuild-autogen")) + (handler identity) (test string?) + (synopsis "Cache files path.") + (description "Full path to the folder where to store the file cache.")) + (setting + (name 'tmp-path) (default "/tmp/ebuild-autogen/") + (example "/tmp/ebuild-autogen/") + (handler identity) (test string?) + (synopsis "Temporary files path.") + (description "Full path to the folder for the temporary files.")))) + (synopsis "Auto generate Gentoo ebuild's") + (description "ebuild-autogen is a Guile scheme application to auto generate +gentoo ebuild package definitions from the \"autogen.scm\" specification for +the package from the subtree source residing in the autogen folder of the +git repository.") + (parser sexp-parser) + ;; Specify where we want to install configuration files + (directory (list (if (getenv "XDG_CONFIG_HOME") + (path (given (getenv "XDG_CONFIG_HOME")) + (eager? #f)) + (in-home ".config/" #:wait?)))) + (version version-str) + (copyright (list 2025)) + (license agpl3) + (author "Cor Legemaat"))) + +(define-public main + (lambda (cmd-line) + (let ((options (getopt-config-auto cmd-line config))) + (when (option-ref options 'write) + (options-write options)) + (let* ((folder (getcwd)) + (repo (repo-root-for folder (option-ref options 'verbosity))) + (parms (list (cons 'repo repo) + (cons 'verbosity (option-ref options 'verbosity)) + (cons 'cache-path (option-ref options + 'filecache-path)) + (cons 'tmp-path (option-ref options 'tmp-path))))) + ;; Init repo from url if requested. + ;; TODO. + + ;; Add our repository to the load path. + (add-to-load-path (string-append repo "/autogen")) + + ;; Add optional parameters if exist. + (if (not (string-null? (option-ref options 'github-token))) + (set! parms + (assoc-set! parms + 'github-token + (option-ref options 'github-token)))) + (with-exception-handler + (lambda (exception) + (if (>= (option-ref options 'verbosity) + verbosity-warn) + (begin + (display "Failed to read the repo parameters with ") + (if (exception-with-message? exception) + (display + (simple-format + #f " exception-message: \"~a\"" + (exception-message exception)))) + (if (and (exception-with-message? exception) + (exception-with-irritants? exception)) + (display " and")) + (if (exception-with-irritants? exception) + (display + (simple-format + #f " exception-irritants: \"~a\"" + (exception-irritants exception)))) + (newline))) + '()) + (lambda () + (let ((repo-mod (resolve-module `(repo-local settings)))) + (if (module-variable repo-mod 'parms) + (set! parms (append parms + (module-ref repo-mod 'parms)))))) + #:unwind? #t) + + ;; Update the source repository if requested. + (if (option-ref options 'subtree-update) + (repo-update-src)) + + ;; Test the repo definition symlinks. + (test-symlink repo + "README.org" + "autogen/README-repo.org" + (option-ref options 'verbosity)) + (test-symlink repo + "metadata" + "autogen/metadata" + (option-ref options 'verbosity)) + (test-symlink repo + "profiles" + "autogen/profiles" + (option-ref options 'verbosity)) + (test-symlink repo + "repositories.xml" + "autogen/repositories.xml" + (option-ref options 'verbosity)) + (test-symlink repo + ".gitignore" + "autogen/.gitignore-repo" + (option-ref options 'verbosity)) + + ;; Preform ebuild generation. + (let ((pkg-list (build-pkg-list repo folder #t))) + (display "package-list:") (newline) + (pretty-print pkg-list) + (let ((cache-files-used + (map (lambda (pkg) + (let ((name (string->symbol (assoc-ref pkg 'name))) + (cat (string->symbol (assoc-ref pkg 'category)))) + (display "pkg:") (newline) + (pretty-print (append parms pkg)) + (with-exception-handler + (lambda (exception) + (if (>= (option-ref options 'verbosity) + verbosity-error) + (begin + (display "Failed to update the package ") + (display (assoc-ref pkg 'category)) + (display "/") + (display (assoc-ref pkg 'name)) + (display " with") + (if (exception-with-message? exception) + (display + (simple-format + #f " exception-message: \"~a\"" + (exception-message exception)))) + (if (and (exception-with-message? exception) + (exception-with-irritants? exception)) + (display " and")) + (if (exception-with-irritants? exception) + (display + (simple-format + #f " exception-irritants: \"~a\"" + (exception-irritants exception)))) + (newline))) + '()) + (lambda () + (let ((pkg-mod (resolve-module `(,cat ,name autogen))) + (pkg-parms (append parms pkg))) + (if pkg-mod + (let ((releases + (if (module-variable pkg-mod 'get-releases) + ((module-ref pkg-mod 'get-releases) + (append parms pkg)) + '()))) + ;; Setup the folder and links for the package. + (if (module-variable pkg-mod 'setup-package) + ((module-ref pkg-mod 'setup-package) + pkg-parms) + (setup-pkg pkg-parms)) + ;; Generate the ebuilds. + (if (module-variable pkg-mod 'generate-ebuilds) + ((module-ref pkg-mod 'generate-ebuilds) + pkg-parms + releases) + (ebuild-gen pkg-parms + releases))) + (setup-pkg pkg-parms)) + (display "Done with package: ") + (display (assoc-ref pkg 'category)) + (display "/") + (display (assoc-ref pkg 'name)) + (newline))) + #:unwind? (< 1 (length pkg-list))))) + pkg-list))) + ;; Clean deprecated cache files if requested. + (display "distfiles-used:") (newline) + (pretty-print cache-files-used)) + + ;; The extra folders in repo not in src. + (let ((repo-pkgs (build-pkg-list repo folder #f))) + ;;(display "repo-pkgs:") (newline) (pretty-print repo-pkgs) + (map (lambda (pkg) + (if (null? ((dql (filter (where (lambda (val) + (string=? val + (assoc-ref pkg 'category))) + 'category) + (where (lambda (val) + (string=? val + (assoc-ref pkg 'name))) + 'name))) + pkg-list)) + (if (>= (option-ref options 'verbosity) + verbosity-warn) + (begin (display "Obsolete pkg ") + (display (assoc-ref pkg 'category)) + (display "/") + (display (assoc-ref pkg 'name)) + (display " found.") + (newline))))) + repo-pkgs))) + + ;; Commit and push the updates to master if requested. + (if (option-ref options 'repo-push) + (repo-push-master)) + + (display "Completed successfully ...") (newline))))) diff --git a/ebuild/defs.scm b/ebuild/defs.scm new file mode 100644 index 0000000..fd37774 --- /dev/null +++ b/ebuild/defs.scm @@ -0,0 +1,37 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; defs.scm +;; Copyright (C) 2025 Cor Legemaat +;; +;; This file is part of ebuild-autogen: you can redistribute it and/or modify it +;; under the terms of the GNU Affero General Public License as published by the +;; Free Software Foundation, version 3 of the License. +;; +;; ebuild-autogen 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 +;; ebuild-autogen. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-module (ebuild defs)) + +(define-public version-major 0) +(define-public version-minor 0) +(define-public version-release 0) + +(define-public curl-useragent + (string-append "ebuild-autogen/" + (number->string version-major) + "." + (number->string version-minor))) + +;; The verbosity level definitions. +(define-public verbosity-emergency 0) +(define-public verbosity-alert 1) +(define-public verbosity-critical 2) +(define-public verbosity-error 3) +(define-public verbosity-warn 4) +(define-public verbosity-notice 5) +(define-public verbosity-info 6) +(define-public verbosity-debug 7) diff --git a/ebuild/ebuild-autogen.in b/ebuild/ebuild-autogen.in new file mode 100755 index 0000000..6b74b43 --- /dev/null +++ b/ebuild/ebuild-autogen.in @@ -0,0 +1,6 @@ +#!{{guile-bin}} \ +-e main -s +!# + +(add-to-load-path "/home/cor/local/share/guile/") +(use-modules (ebuild cli)) diff --git a/ebuild/fetchers/Makefile.am b/ebuild/fetchers/Makefile.am new file mode 100644 index 0000000..ef9034e --- /dev/null +++ b/ebuild/fetchers/Makefile.am @@ -0,0 +1,48 @@ +################################################################################ +# Makefile.am +# Copyright (C) 2025 Cor Legemaat +# +# This file is part of ebuild-autogen: you can redistribute it and/or modify it +# under the terms of the GNU Affero General Public License as published by the +# Free Software Foundation, version 3 of the License. + +# ebuild-autogen 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 +# ebuild-autogen. If not, see . +################################################################################ + +moddir=$(datadir)/guile/site/$(GUILE_EFFECTIVE_VERSION)/dql +objdir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache/dql + +SOURCES = \ + ebuild.scm \ + forgejo.scm \ + github.scm \ + pypi.scm \ + raw.scm + +GOBJECTS = $(SOURCES:%.scm=%.go) + +nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) +nobase_obj_DATA = $(GOBJECTS) + +# Make sure source files are installed first, so that the mtime of +# installed compiled files is greater than that of installed source +# files. See +# +# for details. +guile_install_obj_files = install-nobase_obj_DATA +$(guile_install_obj_files): install-nobase_mod_DATA + +EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) + +CLEANFILES = $(GOBJECTS) + +GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat +GUILE_OPTS = -L $(abs_top_builddir) +SUFFIXES = .scm .go +.scm.go: + $(GUILD) compile $(GUILE_TARGET) $(GUILE_OPTS) $(GUILE_WARNINGS) -o "$@" "$<" diff --git a/ebuild/fetchers/ebuild.scm b/ebuild/fetchers/ebuild.scm new file mode 100644 index 0000000..1fe0328 --- /dev/null +++ b/ebuild/fetchers/ebuild.scm @@ -0,0 +1,66 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ebuild.scm +;; Copyright (C) 2025 Cor Legemaat +;; +;; This file is part of ebuild-autogen: you can redistribute it and/or modify it +;; under the terms of the GNU Affero General Public License as published by the +;; Free Software Foundation, version 3 of the License. +;; +;; ebuild-autogen 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 +;; ebuild-autogen. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-module (ebuild fetchers ebuild) + #:use-module (ice-9 textual-ports) + #:use-module (oop goops) + #:use-module (rx irregex)) + +(define-public fetch-ebuilds + (lambda* (repo category package #:key + (version-filter (lambda (version) version)) + (version-alter (lambda (version) version)) + . extract-vars) + (let ((dir (opendir (string-append repo "/" category "/" package))) + (releases '())) + (do ((entry (readdir dir) (readdir dir))) + ((eof-object? entry)) + ;;(display "file=") (display entry)(newline) + (let* ((ebuild-file (open-input-file (string-append repo "/" + category "/" + package "/" + entry))) + (version-match (irregex-search + `(seq (look-behind ,(string-append package "-")) + (+ (or alphanumeric "." "-")) + (look-ahead ".ebuild")) + entry)) + (ebuild-data (if version-match + (get-string-all ebuild-file) + #f)) + (release '())) + ;; Get the keywords. + (if version-match + (begin (set! release (list (cons "version" (irregex-match-substring version-match)))) + (map (lambda (var) + (let* ((var-match (irregex-search + `(seq (look-behind ,(string-append var "=\"")) + (+ (& (or printing num) (~ "\""))) + (look-ahead "\"")) + ebuild-data))) + (if var-match + (begin ;; (display (string-append var "=")) + ;; (display (irregex-match-substring var-match)) + ;; (newline) + (append! release (list (cons var (irregex-match-substring var-match)))))))) + extract-vars) + (set! releases (append releases (list release))))) + ;;(display "relese = ") (display release) (newline) + ;;(display "releses = ") (display releases) (newline) + (close ebuild-file))) + (closedir dir) + releases))) + diff --git a/ebuild/fetchers/forgejo.scm b/ebuild/fetchers/forgejo.scm new file mode 100644 index 0000000..ecb4e43 --- /dev/null +++ b/ebuild/fetchers/forgejo.scm @@ -0,0 +1,299 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; forgejo.scm +;; Copyright (C) 2025 Cor Legemaat +;; +;; This file is part of ebuild-autogen: you can redistribute it and/or modify it +;; under the terms of the GNU Affero General Public License as published by the +;; Free Software Foundation, version 3 of the License. +;; +;; ebuild-autogen 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 +;; ebuild-autogen. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-module (ebuild fetchers forgejo) + #:use-module (ebuild defs) + #:use-module (ebuild fetchers raw) + #:use-module (ebuild utils) + #:use-module (curl) + #:use-module (json) + #:use-module (ice-9 pretty-print) + #:use-module (oop goops) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-43) + #:use-module (rx irregex) + #:use-module (dql dql)) + +(define api-base-url "/api/v1/repos/") + +(define check-forgejo-errors + (lambda (responce) + "" + ;; TODO + '())) + +(define fetch-forgejo-pages + (lambda* (url auth-token verbosity #:optional (page 1)) + "" + (let ((curl-handle (curl-easy-init))) + (if (>= verbosity verbosity-info) + (begin (display "src-url: ") (display url) (newline))) + (curl-easy-setopt curl-handle + 'url + (string-append url + "?limit=100&page=" + (number->string page))) + (curl-easy-setopt curl-handle 'useragent curl-useragent) + (if (string<> auth-token "") + (curl-easy-setopt curl-handle + 'httpheader + (list (string-append "Authorization: token " + auth-token)))) + (let* ((responce (curl-easy-perform curl-handle))) + (if (>= verbosity verbosity-debug) + (begin (display "json = ") (display responce) (newline))) + (if responce + (begin (check-forgejo-errors responce) + (let ((scm-responce (json-string->scm responce))) + (if (< 100 (vector-length scm-responce)) + (vector-append (fetch-forgejo-pages url + auth-token + verbosity + (+1 page))) + (begin (if (>= verbosity verbosity-info) + (pretty-print scm-responce)) + scm-responce)))) + (error (string-append "Forgejo fetch failed with error " + (curl-error-string) + "\n"))))))) + +(define get-releases + (lambda (host user repo auth-token version-filter verbosity) + "" + ((dql (select (filter (where version-filter + "tag_name")) + (parm-as "version" "tag_name") + (parm-as "date" "created_at"))) + (fetch-forgejo-pages (string-append host + api-base-url + user + "/" + repo + "/releases") + auth-token + verbosity)))) + +(define get-tags + (lambda (host user repo auth-token version-filter verbosity) + "" + ((dql (select (filter (where version-filter + "name")) + (parm-as "version" "name") + (parm "commit" "sha"))) + (fetch-forgejo-pages (string-append host + api-base-url + user + "/" + repo + "/tags") + auth-token + verbosity)))) + +(define get-rel-assets + (lambda (host user repo auth-token name-prefix version-alter releases) + "TODO Won't work!!!" + ;; (display "for-releases:") (newline) + ;; (pretty-print releases) + (map (lambda (release) + ;; (display "for-release:") (newline) + ;; (pretty-print release) + (let* ((version (assoc-ref release "version")) + (version-final (version-alter version)) + (base-asset-url (string-append host "/" user "/" repo)) + (curl-handle (curl-easy-init)) + (json "") + (scm "")) + (curl-easy-setopt curl-handle + 'url + (string-append host api-base-url + user + "/" + repo + "/releases/" + version)) + (curl-easy-setopt curl-handle 'useragent curl-useragent) + (if (string<> auth-token "") + (curl-easy-setopt curl-handle + 'httpheader + (list (string-append "Authorization: token " + auth-token)))) + ;;(curl-easy-setopt curl-handle 'max-time 120) + ;;(curl-easy-setopt curl-handle 'connect-timeout 30) + (set! json (curl-easy-perform curl-handle)) + ;; (display "json=") (display json) (newline) + (if (not json) + (error (string-append "GitHub release asset fetch " + "failed with error " + (curl-error-string) + "\n"))) + (check-forgejo-errors json) + (set! scm (json-string->scm json)) + (assoc-set! release "version" version-final) + (append release + (list (cons "repo-user" user)) + (list (cons "repo-repo" repo)) + ;;TODO append this with list of custom assets. + (list + (list "assets" + (list (cons "uri" (string-append base-asset-url + "/archive/" + version + ".tar.gz")) + (cons "name" (string-append name-prefix + "-" + version-final + ".tar.gz")) + (cons "type" "tar.gz")) + (list (cons "uri" (string-append base-asset-url + "/archive/" + version + ".tar.gz")) + (cons "name" (string-append name-prefix + "-" + version-final + ".zip")) + (cons "type" "zip"))))))) + releases))) + +(define get-tag-assets + (lambda (host user repo name-prefix version-alter tags) + ;; (display "tags = ") + ;; (pretty-print tags) + (map (lambda (tag) + (let* ((version-final (version-alter (assoc-ref tag "version"))) + (version-name (assoc-ref tag "version")) + (base-asset-url (string-append host "/" user "/" repo))) + (assoc-set! tag "version" version-final) + (append tag + (list (cons "repo-user" user)) + (list (cons "repo-name" repo)) + (list + (list "assets" + (list (cons "uri" (string-append base-asset-url + "/archive/" + version-name + ".tar.gz")) + (cons "name" (string-append name-prefix + "-" + version-final + ".tar.gz")) + (cons "type" "tar.gz")) + (list (cons "uri" (string-append base-asset-url + "/archive/" + version-name + ".tar.gz")) + (cons "name" (string-append name-prefix + "-" + version-final + ".zip")) + (cons "type" "zip"))))))) + tags))) + +(define-public fetch-forgejo + (lambda* (host user repo querry verbosity #:key + (auth-token "") + (version-filter (lambda (version) + (irregex-search + '(seq bos + (+ num) + (* (seq "." (+ num)))) + version))) + (version-alter (lambda (version) + (let ((my-match (irregex-search + '(seq (+ num) + (* (seq "." (+ num)))) + version))) + (if my-match + (irregex-match-substring my-match) + #f)))) + (file-prefix repo)) + "" + (display "Fetching forgejo repo ") + (display repo) + (display " from ") + (display user) + (display " at ") + (display host) + (newline) + (letrec* ((releases + (case querry + ((releases) (get-releases host + user + repo + auth-token + version-filter + verbosity)) + ((tags) (get-tags host + user + repo + auth-token + version-filter + verbosity)) + (else (error (string-append "Error github can only " + "querry tags or releases."))))) + (assets (case querry + ((releases) (get-rel-assets host user repo auth-token + file-prefix version-alter + releases)) + ((tags) (get-tag-assets host user repo + file-prefix version-alter + releases)) + (else '())))) + assets))) + +(define-public extract-forgejo-release + (lambda (release tmp-path) + (let* ((sha7 (assoc-ref release "sha7")) + (extracted-path (string-append tmp-path + "/" + (assoc-ref release "github-user") + "-" + (assoc-ref release "github-repo") + "-" sha7)) + (file-path (fetch-raw-release release "tar.gz"))) + (if (access? extracted-path F_OK) + (system* "/bin/rm" "-r" extracted-path)) + (mkpath tmp-path) + (system* "/bin/tar" + "-xf" file-path "--directory" + tmp-path) + extracted-path))) + +(define-public fetch-forgejo-prefixed + (lambda* (host user repo querry verbosity prefix #:key + (auth-token "") + (file-prefix repo)) + "" + (fetch-forgejo host user repo querry verbosity + #:auth-token auth-token + #:version-filter + (lambda (version) + (irregex-search + `(seq ,prefix + (+ num) + (* (seq "." (+ num)))) + version)) + #:version-alter + (lambda (version) + (let ((my-match (irregex-search + `(seq (look-behind ,prefix) + (+ num) + (* (seq "." (+ num)))) + version))) + (if my-match + (irregex-match-substring my-match) + #f))) + #:file-prefix file-prefix))) diff --git a/ebuild/fetchers/github.scm b/ebuild/fetchers/github.scm new file mode 100644 index 0000000..eba39ae --- /dev/null +++ b/ebuild/fetchers/github.scm @@ -0,0 +1,315 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; github.scm +;; Copyright (C) 2025 Cor Legemaat +;; +;; This file is part of ebuild-autogen: you can redistribute it and/or modify it +;; under the terms of the GNU Affero General Public License as published by the +;; Free Software Foundation, version 3 of the License. +;; +;; ebuild-autogen 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 +;; ebuild-autogen. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-module (ebuild fetchers github) + #:use-module (ebuild defs) + #:use-module (ebuild fetchers raw) + #:use-module (ebuild utils) + #:use-module (curl) + #:use-module (json) + #:use-module (ice-9 pretty-print) + #:use-module (oop goops) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-43) + #:use-module (rx irregex) + #:use-module (dql dql)) + +(define api-base-url "https://api.github.com/repos/") + +(define check-github-errors + (lambda (responce) + "" + (cond ((string-contains responce "API rate limit exceeded for") + (error (string-append "error: GitHub API rate limit exceeded, " + "please setup a token."))) + ((string-contains responce + (string-append "Request forbidden by administrative" + " rules. Please make sure your " + "request has a User-Agent header")) + (error (string-append "error: GitHub API requires a user agent, " + "should have been supplied!")))))) + +(define fetch-github-pages + (lambda* (url token verbosity #:optional (page 1)) + "" + (let ((curl-handle (curl-easy-init))) + (curl-easy-setopt curl-handle + 'url + (string-append url + "?per_page=100&page=" + (number->string page))) + (curl-easy-setopt curl-handle 'useragent curl-useragent) + (if (string<> token "") + (curl-easy-setopt curl-handle + 'httpheader + (list (string-append "Authorization: token " + token)))) + (let* ((responce (curl-easy-perform curl-handle))) + (if (>= verbosity verbosity-debug) + (begin (display "json = ") (display responce) (newline))) + (if responce + (begin (check-github-errors responce) + (let ((scm-responce (json-string->scm responce))) + (if (< 100 (vector-length scm-responce)) + (vector-append (fetch-github-pages url + verbosity + (+1 page))) + (begin (if (>= verbosity verbosity-info) + (pretty-print scm-responce)) + scm-responce)))) + (error (string-append "GitHub fetch failed with error " + (curl-error-string) + "\n"))))))) + +(define get-releases + (lambda (user repo token version-filter verbosity) + "" + ((dql (select (filter (where version-filter + "tag_name")) + (parm-as "version" "tag_name") + (parm-as "date" "created_at"))) + (fetch-github-pages (string-append api-base-url + user + "/" + repo + "/releases") + token + verbosity)))) + +(define get-tags + (lambda (user repo token version-filter verbosity) + "" + ((dql (select (filter (where version-filter + "name")) + (parm-as "version" "name") + (parm "commit" "sha"))) + (fetch-github-pages (string-append api-base-url + user + "/" + repo + "/tags") + token + verbosity)))) + +(define get-rel-assets + (lambda (user repo token name-prefix version-alter releases) + "" + ;; (display "for-releases:") (newline) + ;; (pretty-print releases) + (map (lambda (release) + ;; (display "for-release:") (newline) + ;; (pretty-print release) + (let* ((version (assoc-ref release "version")) + (version-final (version-alter version)) + (curl-handle (curl-easy-init)) + (base-asset-url (string-append "https://github.com/" + user + "/" + repo)) + (sha "") + (sha7 "") + (json "") + (scm "")) + (curl-easy-setopt curl-handle + 'url + (string-append api-base-url + user + "/" + repo + "/git/refs/tags/" + version)) + (curl-easy-setopt curl-handle 'useragent curl-useragent) + (if (string<> token "") + (curl-easy-setopt curl-handle + 'httpheader + (list (string-append "Authorization: token " + token)))) + ;;(curl-easy-setopt curl-handle 'max-time 120) + ;;(curl-easy-setopt curl-handle 'connect-timeout 30) + (set! json (curl-easy-perform curl-handle)) + ;; (display "json=") (display json) (newline) + (if (not json) + (error (string-append "GitHub release asset fetch " + "failed with error " + (curl-error-string) + "\n"))) + (check-github-errors json) + (set! scm (json-string->scm json)) + (display "scm:") (newline) (pretty-print scm) + (set! sha (assoc-ref (car ((dql (select (parm "object" "sha"))) + (list scm))) + "sha")) + (display "sha=") (display sha) (newline) + (set! sha7 (string-take sha 7)) + (assoc-set! release "version" version-final) + (append release + (list (cons "sha" sha)) + (list (cons "github-user" user)) + (list (cons "github-repo" repo)) + (list (cons "sha7" sha7)) + ;;TODO append this with list of custom assets. + (list + (list "assets" + (list (cons "uri" (string-append base-asset-url + "/tarball/" + sha7)) + (cons "name" (string-append name-prefix + "-" + version-final + "-" + sha7 + ".tar.gz")) + (cons "type" "tar.gz")) + (list (cons "uri" (string-append base-asset-url + "/zipball/" + sha7)) + (cons "name" (string-append name-prefix + "-" + version-final + "-" + sha7 + ".zip")) + (cons "type" "zip"))))))) + releases))) + +(define get-tag-assets + (lambda (user repo name-prefix version-alter tags) + ;; (display "tags = ") + ;; (pretty-print tags) + (map (lambda (tag) + (let* ((sha (assoc-ref tag "sha")) + (sha7 (string-take sha 7)) + (version (assoc-ref tag "version")) + (version-final (version-alter version)) + (base-asset-url (string-append "https://github.com/" + user + "/" + repo))) + (assoc-set! tag "version" version-final) + (append tag + (list (cons "github-user" user)) + (list (cons "github-repo" repo)) + (list (cons "sha7" sha7)) + (list + (list "assets" + (list (cons "uri" (string-append base-asset-url + "/tarball/" + sha7)) + (cons "name" (string-append name-prefix + "-" + version-final + "-" + sha7 + ".tar.gz")) + (cons "type" "tar.gz")) + (list (cons "uri" (string-append base-asset-url + "/zipball/" + sha7)) + (cons "name" (string-append name-prefix + "-" + version-final + "-" + sha7 + ".zip")) + (cons "type" "zip"))))))) + tags))) + +(define-public fetch-github + (lambda* (user repo token querry verbosity #:key + (version-filter (lambda (version) + (irregex-search + '(seq bos + (+ num) + (* (seq "." (+ num)))) + version))) + (version-alter (lambda (version) + (let ((my-match (irregex-search + '(seq (+ num) + (* (seq "." (+ num)))) + version))) + (if my-match + (irregex-match-substring my-match) + #f)))) + (file-prefix repo)) + "" + (display "Fetching ") + (display repo) + (display " from ") + (display user) + (display " at github.") + (newline) + (letrec* ((releases + (case querry + ((releases) (get-releases user + repo + token + version-filter + verbosity)) + ((tags) (get-tags user repo token version-filter verbosity)) + (else (error (string-append "Error github can only " + "querry tags or releases."))))) + (assets (case querry + ((releases) (get-rel-assets user repo token + file-prefix version-alter + releases)) + ((tags) (get-tag-assets user repo + file-prefix version-alter + releases)) + (else '())))) + assets))) + +(define-public extract-github-release + (lambda (release) + (let* ((sha7 (assoc-ref release "sha7")) + (extracted-path (string-append (assoc-ref release 'tmp-path) + "/" + (assoc-ref release "github-user") + "-" + (assoc-ref release "github-repo") + "-" sha7)) + (file-path (fetch-raw-release release "tar.gz"))) + (if (access? extracted-path F_OK) + (system* "/bin/rm" "-r" extracted-path)) + (mkpath (assoc-ref release 'tmp-path)) + (system* "/bin/tar" + "-xf" file-path "--directory" + (assoc-ref release 'tmp-path)) + extracted-path))) + +(define-public fetch-github-prefixed + (lambda* (user repo token querry verbosity prefix #:key + (file-prefix repo) + (display-data #f)) + "" + (fetch-github user repo token querry verbosity + #:version-filter + (lambda (version) + (irregex-search + `(seq ,prefix + (+ num) + (* (seq "." (+ num)))) + version)) + #:version-alter + (lambda (version) + (let ((my-match (irregex-search + `(seq (look-behind ,prefix) + (+ num) + (* (seq "." (+ num)))) + version))) + (if my-match + (irregex-match-substring my-match) + #f))) + #:file-prefix file-prefix))) diff --git a/ebuild/fetchers/pypi.scm b/ebuild/fetchers/pypi.scm new file mode 100644 index 0000000..87f2d2c --- /dev/null +++ b/ebuild/fetchers/pypi.scm @@ -0,0 +1,91 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; pypi.scm +;; Copyright (C) 2025 Cor Legemaat +;; +;; This file is part of ebuild-autogen: you can redistribute it and/or modify it +;; under the terms of the GNU Affero General Public License as published by the +;; Free Software Foundation, version 3 of the License. +;; +;; ebuild-autogen 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 +;; ebuild-autogen. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-module (ebuild fetchers pypi) + #:use-module (ebuild defs) + #:use-module (ebuild fetchers raw) + #:use-module (ebuild utils) + #:use-module (curl) + #:use-module (json) + #:use-module (ice-9 pretty-print) + #:use-module (oop goops) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-43) + #:use-module (rx irregex) + #:use-module (dql dql)) + +(define fetch-pypi-pkg + (lambda (pkg display-data) + "" + (let ((curl-handle (curl-easy-init))) + (curl-easy-setopt curl-handle + 'url + (string-append "https://pypi.org/simple/" + pkg + "/")) + (curl-easy-setopt curl-handle 'useragent curl-useragent) + (curl-easy-setopt curl-handle + 'httpheader + (list (string-append "Accept: " + "application/vnd.pypi.simple.v1+json"))) + (let* ((responce (curl-easy-perform curl-handle))) + ;;(display "json = ") (display responce) (newline) + (if responce + (let ((scm-responce (json-string->scm responce))) + (begin (if display-data + (pretty-print scm-responce)) + scm-responce)) + (error (string-append "PyPI fetch failed with error " + (curl-error-string) + "\n"))))))) + +(define-public fetch-pypi + (lambda* (pkg #:key (file-types (list "tar.gz")) (display-data #f)) + "" + (let* ((data (fetch-pypi-pkg pkg display-data)) + (versions (vector->list (assoc-ref data "versions"))) + (files (assoc-ref data "files"))) + (map (lambda (version) + (list (cons "version" version) + (car (car ((dql (select (filter (where (lambda (file-name) + (if (string? file-name) + (string-contains file-name + (string-append "-" + version + "." + (car file-types))) + #f)) + "filename")) + (parm-as "date" "upload-time"))) + files))) + (cons "assets" + (map (lambda (type) + (append (car ((dql (select (filter (where (lambda (file-name) + (if (string? file-name) + (string-contains file-name + (string-append "-" + version + "." + type)) + #f)) + "filename")) + (parm-as "uri" "url") + (parm-as "name" "filename") + (parm "hashes" "sha256"))) + files)) + (list (cons "type" type)))) + file-types)))) + versions)))) diff --git a/ebuild/fetchers/raw.scm b/ebuild/fetchers/raw.scm new file mode 100644 index 0000000..a58ca93 --- /dev/null +++ b/ebuild/fetchers/raw.scm @@ -0,0 +1,123 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; raw.scm +;; Copyright (C) 2025 Cor Legemaat +;; +;; This file is part of ebuild-autogen: you can redistribute it and/or modify it +;; under the terms of the GNU Affero General Public License as published by the +;; Free Software Foundation, version 3 of the License. +;; +;; ebuild-autogen 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 +;; ebuild-autogen. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-module (ebuild fetchers raw) + #:use-module (ebuild defs) + #:use-module (ebuild utils) + #:use-module (curl) + #:use-module (rx irregex) + #:use-module (ice-9 pretty-print) + #:use-module (ice-9 regex) + #:use-module (ice-9 string-fun) + #:use-module (srfi srfi-1) + #:use-module (dql dql)) + +(define-public fetch-raw + (lambda* (url extract-file extract-version asset-types #:key + (uri-prefix "") + (version-filter (lambda (version) #t)) + (version-alter (lambda (version) version))) + "extract-file should extract the file name till the dot before the type." + (let ((curl-handle (curl-easy-init))) + (curl-easy-setopt curl-handle 'url url) + (curl-easy-setopt curl-handle 'useragent curl-useragent) + (let ((responce (curl-easy-perform curl-handle))) + (let ((releases (extract-file responce))) + (filter-map + (lambda (release) + (let ((version (version-alter (extract-version release)))) + (if (version-filter version) + (list (cons "version" version) + (cons "assets" + (map + (lambda (type) + (list + (cons "uri" + (string-append + (if (string=? uri-prefix "") + (if (string-match + "^(http://|https://|ftp://)" + release) + "" url) + uri-prefix) + release type)) + (cons "name" (string-append release type)) + (cons "type" type))) + asset-types))) + #f))) + releases)))))) + +(define-public fetch-raw-html + (lambda* (url file-prefix + asset-types #:key + (uri-prefix "") + (version-filter (lambda (version) #t)) + (version-alter (lambda (version) version)) + (extract-version + (lambda (file) + (let ((my-match (irregex-search `(seq (+ num) "." + (+ num) "." + (+ num)) + file))) + (if my-match + (irregex-match-substring my-match))))) + (file-postfix (car asset-types))) + "" + (fetch-raw url + (lambda (responce) + ;; Break up in lines, otherwise rx extremely expensive. + (filter-map + (lambda (line) + (let ((rx-match + (irregex-search + `(seq (look-behind ""))) + line))) + (if rx-match + (irregex-match-substring rx-match) + #f))) + (string-split responce #\newline))) + extract-version + asset-types + #:uri-prefix uri-prefix + #:version-filter version-filter + #:version-alter version-alter))) + +(define-public fetch-raw-release + (lambda (release type) + "" + (let* ((my-file-data + (car ((dql (select (filter (select (parm-val "assets")) + (where (lambda (x) + (string=? x type)) + "type")) + (parm "uri") + (parm "name"))) + release))) + (uri (assoc-ref my-file-data "uri")) + (name (assoc-ref my-file-data "name")) + (file-path (string-append (assoc-ref release 'cache-path) + "/" + name))) + (mkpath (assoc-ref release 'cache-path)) + (if (access? file-path F_OK) + (display "File already downloaded.\n") + (system* "/usr/bin/wget" "-O" file-path uri)) + file-path))) diff --git a/ebuild/gen.scm b/ebuild/gen.scm new file mode 100644 index 0000000..3097e5d --- /dev/null +++ b/ebuild/gen.scm @@ -0,0 +1,261 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; gen.scm +;; Copyright (C) 2025 Cor Legemaat +;; +;; This file is part of ebuild-autogen: you can redistribute it and/or modify it +;; under the terms of the GNU Affero General Public License as published by the +;; Free Software Foundation, version 3 of the License. +;; +;; ebuild-autogen 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 +;; ebuild-autogen. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-module (ebuild gen) + #:use-module (ebuild utils) + #:use-module (ebuild defs) + #:use-module (dql dql) + #:use-module (rx irregex) + #:use-module (ice-9 pretty-print) + #:use-module (ice-9 string-fun) + #:use-module (ice-9 textual-ports) + #:use-module (srfi srfi-1)) + +;;Function to generate template from ebuild with variable substitution. +(define-public ebuild-from-tmpl + (lambda (tmpl vars out verbosity) + "" + (letrec* + ((input-port (open-input-file tmpl)) + (output-port (open-output-file out)) + (data (string-split (get-string-all input-port) #\lf)) + (traverse-list + (lambda (pre no data) + (traverse (string-append (if (symbol? pre) + (symbol->string pre) + pre) + "[" + (number->string no) + "]") + (car data)) + (if (not (null? (cdr data))) + (traverse-list pre (1+ no) (cdr data))))) + (traverse-alist + (lambda (pre data) + (for-each (lambda (var) + (if (and (string? (car var)) + (string? (cdr var))) + (replace (if (eq? (string-length pre) 0) + (car var) + (string-append pre + "." + (car var))) + (cdr var)) + (traverse (if (eq? (string-length pre) 0) + (car var) + (string-append pre + "." + (car var))) + (cdr var)))) + data))) + (traverse (lambda (pre data) + (cond ((alist? data) + (traverse-alist pre data)) + ((list? data) + (traverse-list pre 0 data)) + ((number? data) + (replace pre (number->string data))) + ((string? data) (replace pre data)) + (else (error (string-append "Error! Don't know how " + "to process \"" + (object->string data) + "\" data type.")))))) + (replace + (lambda (var val) + (let ((var-str (string-append "{{" + (if (symbol? var) + (symbol->string var) + var) + "}}"))) + (if (>= verbosity verbosity-info) + (begin (display "Replacing \"") (display var-str) + (display "\" with \"") (display val) + (display "\"") (newline))) + (set! data (map (lambda (line) + (string-replace-substring line + var-str + val)) + data)))))) + (if (irregex-search '(seq (+ "#") (+ space) "-*-" (+ space)) + (car data)) + (set! data (cdr data))) + (traverse "" vars) + (display "# Auto generated from autogen.scm" output-port) + (newline output-port) + (display (string-join data "\n") output-port) + (close output-port) + out))) + +(define-public ebuild-fkc + (lambda (vlist-in comps-in) + "" + (letrec* + ((base (lambda (vlist comps) + (if (null? comps) + (cdr (car vlist)) + (let ((clist (sort (delete-duplicates + (map (lambda (vers) + (if (null? (car vers)) + -1 + (car (car vers)))) + vlist)) + <))) + (map (lambda (vcomp) + (append-map + (lambda (sts) + (cond ((string? sts) + (list (list vcomp) sts)) + ((null? (car sts)) + (append (list vcomp) (cdr sts))) + ((not (list? (car (car sts)))) + (list (list (append (list vcomp) + (car sts)) + (second sts)))) + (else + (map (lambda (tst) + (list (append (list vcomp) + (car tst)) + (second tst))) + sts)))) + (base (map (lambda (ver) + (list (if (null? (car ver)) + '() + (cdr (car ver))) + (car (cdr ver)))) + (filter (lambda (vers) + (= vcomp + (if (null? (car vers)) + -1 + (car (car vers))))) + vlist)) + (cdr comps)))) + (take-right clist + (min (length clist) + ;; 0=all. + (if (zero? (car comps)) + (length clist) + (car comps)))))))))) + ;;Works, but probably only for 3 components so shit solution. + (append-map (lambda (vmaj) + vmaj) + (base vlist-in comps-in))))) + +(define default-version-components + (lambda (version) + "" + (map (lambda (component) + (string->number component)) + (irregex-split #\. + (irregex-match-substring + (irregex-search '(seq (+ num) (+ (seq "." (+ num)))) + version)))))) + +(define-public ebuild-version-filter + (lambda* (releases #:key + (keep-components (if (assoc-ref releases 'keep-vers-comps) + (assoc-ref releases 'keep-vers-comps) + (list 1 1 1))) + (version-components default-version-components) + (keep (lambda (version) #f)) + (drop (lambda (version) #f))) + "" + (let* ((vlist (map (lambda (release) + (list (version-components (assoc-ref release + "version")) + (assoc-ref release "version"))) + releases)) + (vlist-filtered + (append (filter (lambda (vers) + (if (keep (second vers)) vers #f)) + vlist) + (filter (lambda (vers) + (if (drop (second vers)) #f vers)) + (ebuild-fkc vlist keep-components))))) + (filter-map (lambda (rel) + (if (any (lambda (vers) + (string= (assoc-ref rel "version") + (second vers))) + vlist-filtered) + (append (list (cons "version-components" + (version-components + (assoc-ref rel + "version")))) + rel) + #f)) + releases)))) + +;;Procedure to generate the required ebuild from the given releases. +(define-public ebuild-gen + (lambda* (parms releases #:key + (version-components (lambda (version) + (map (lambda (component) + (string->number component)) + (string-split version #\.)))) + (keep-components (list 1 1 2)) + (keep (lambda (version) #f)) + (drop (lambda (version) #f)) + (template (string-join (list (assoc-ref parms 'repo) + "autogen" + (assoc-ref parms 'category) + (assoc-ref parms 'name) + (string-append (assoc-ref parms 'name) + ".tmpl")) + file-name-separator-string)) + (post-hook (lambda (ebuild-path vars) + (system* "ebuild" + ebuild-path + "manifest")))) + "" + (if (>= (assoc-ref parms 'verbosity) verbosity-notice) + (begin (display "Releases:\n") + (pretty-print releases))) + (letrec* ((version-list + (map (lambda (release) + (list (version-components (assoc-ref release "version")) + (assoc-ref release "version"))) + releases))) + (let ((selected-versions (ebuild-fkc version-list keep-components))) + (filter-map + (lambda (vers) + (let ((path (string-join (list (assoc-ref parms 'repo) + (assoc-ref parms 'category) + (assoc-ref parms 'name) + (string-append (assoc-ref parms 'name) + "-" + (second vers) + ".ebuild")) + file-name-separator-string))) + (if (and (not (access? path F_OK)) + (not (drop (second vers))) + (or (find (lambda (test-vers) + (string= (second test-vers) + (second vers))) + selected-versions) + (keep (second vers)))) + (let* ((vars (car (filter (lambda (rel) + (string= (assoc-ref rel "version") + (second vers))) + releases))) + (ebuild-created (ebuild-from-tmpl + template + (append vars parms) + path + (assoc-ref parms 'verbosity)))) + (post-hook ebuild-created (append parms vars)) + (append vars + (list (cons "ebuild" path)))) + #f))) + version-list))))) diff --git a/ebuild/repo.scm b/ebuild/repo.scm new file mode 100644 index 0000000..d3f5172 --- /dev/null +++ b/ebuild/repo.scm @@ -0,0 +1,225 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; repo.scm +;; Copyright (C) 2025 Cor Legemaat +;; +;; This file is part of ebuild-autogen: you can redistribute it and/or modify it +;; under the terms of the GNU Affero General Public License as published by the +;; Free Software Foundation, version 3 of the License. +;; +;; ebuild-autogen 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 +;; ebuild-autogen. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-module (ebuild repo) + #:use-module (ebuild defs) + #:use-module (ebuild utils) + #:use-module (ice-9 exceptions) + #:use-module (ice-9 ftw) + #:use-module (srfi srfi-1) + #:use-module (git bindings) + #:use-module (git repository) + #:use-module (rx irregex)) + +;; Required initialization call. +(libgit2-init!) + +(define-public repo-root-for + (lambda (path verbosity) + (let ((repo-orig + (with-exception-handler + (lambda (exception) + (display exception) (newline) + (display "error: Failed to find the repository root for \"") + (display path) + (display "\", ebuild-autogen is designed to work with ") + (display "portage overlay repositories in git!") (newline) + (display "If you are testing and don't have a git repository ") + (display "yet for your overlay, make it one by running ") + (display "'git init' in the root of the repository.") + (newline)) + (lambda () + (repository-discover path))))) + (let ((repo-root (dirname repo-orig))) + (if (>= verbosity verbosity-notice) + (begin (display "Using repository: ") + (display repo-root) + (newline))) + (if (not (file-exists? (string-append repo-root + "/autogen/"))) + (raise-exception + (make-exception + (make-external-error) + (make-exception-with-message + "Can't find the \"autogen\" folder in repository root") + (make-exception-with-irritants repo-root)))) + repo-root)))) + +;;(repo-root-for "/home/cor/Projects/portage-overlay" verbosity-notice) + +(define-public repo-update-src + (lambda () + (display "Willing to update src subtree...") (newline) + #t)) + +(define-public repo-push-master + (lambda () + (display "Willing to push updates to master...") (newline) + #t)) + +(define-public test-symlink + (lambda (repo src dst verbosity) + "" + (let ((port (open-file repo "r"))) + (if (false-if-exception (statat port src AT_SYMLINK_NOFOLLOW)) + ;;Check if src is a symlink. + (if (eq? (stat:type (statat port src AT_SYMLINK_NOFOLLOW)) 'symlink) + (if (string=? (readlink (string-append repo "/" src)) dst) + (if (>= verbosity verbosity-notice) + (begin (display "Symlink \"") + (display src) + (display "\" ok.") + (newline))) + (if (>= verbosity verbosity-critical) + (begin (display "warning: symlink from \"") + (display src) + (display "\" not pointing to \"") + (display dst) + (display "\" but to \"") + (display (readlink (string-append repo "/" src))) + (display "\" and might deliver unexpected results!") + (newline)))) + (if (>= verbosity verbosity-critical) + (begin (display "warning: \"") + (display src) + (display "\" not a symbolic link and won't ") + (display "represent autogen source data!") + (newline)))) + (begin (symlinkat port dst src) + (if (>= verbosity verbosity-warn) + (begin (display "Symlink \"") + (display src) + (display "\" created.") + (newline))))) + (close-port port)))) + +(define-public folder-list + (lambda (path ignore-meta) + "" + ;;(display "path=\"") (display path) (display "\"") (newline) + (filter-map (lambda (entry) + (if (eq? 'directory + (stat:type (stat (string-append path "/" entry)))) + (if (and ignore-meta + (or (string=? entry "metadata") + (string=? entry "profiles"))) + #f + (if (char=? (car (string->list entry)) #\.) + #f entry)) + #f)) + (scandir path)))) + +(define-public build-pkg-list + (lambda (repo folder in-autogen) + (let* ((file-seperator (car (string->list file-name-separator-string))) + (repo-list (string-split repo file-seperator)) + (repo-path-len (length repo-list)) + (fpl (let ((folder-list (string-split folder file-seperator))) + (if in-autogen + ;; In autogen folder, aka the source pkgs. + (if (> (length folder-list) repo-path-len) + (if (string=? (car (take-right folder-list + (- (length folder-list) + repo-path-len))) + "autogen") + folder-list + (append repo-list + (list "autogen") + (take-right folder-list + (- (length folder-list) + repo-path-len)))) + (append folder-list (list "autogen"))) + ;; Outside autogen folder, the generated pkgs. + (if (> (length folder-list) repo-path-len) + (if (string=? (car (take-right folder-list + (- (length folder-list) + repo-path-len))) + "autogen") + (append repo-list + (take-right folder-list + (- (length folder-list) + (1+ repo-path-len)))) + folder-list) + folder-list)))) + (depth (- (length fpl) + repo-path-len + (if in-autogen 1 0)))) + ;;(display "fpl=\"") (display fpl) (display "\"") (newline) + ;;(display "folder-list:") (display (folder-list (string-join fpl "/") #t)) (newline) + (cond ((= depth 2) + (list (list (cons 'category (first (take-right fpl 2))) + (cons 'name (last fpl))))) + ((= depth 1) + (map (lambda (pkg) + (list (cons 'category (last fpl)) + (cons 'name pkg))) + (folder-list (string-join fpl file-name-separator-string) + #t))) + ((= depth 0) + (if (null? (folder-list (string-join fpl file-name-separator-string) + #t)) + (list (list)) + (append-map (lambda (cat) + (map (lambda (pkg) + (list (cons 'category cat) + (cons 'name pkg))) + (folder-list (string-join (append fpl + (list cat)) + file-name-separator-string) + #f))) + (folder-list (string-join fpl file-name-separator-string) #t)))) + (else ""))))) + +(define-public setup-pkg + (lambda (parms) + "" + (let ((src-path (string-join (list (assoc-ref parms 'repo) + "autogen" + (assoc-ref parms 'category) + (assoc-ref parms 'name)) + file-name-separator-string)) + (dst-path (string-join (list (assoc-ref parms 'repo) + (assoc-ref parms 'category) + (assoc-ref parms 'name)) + file-name-separator-string))) + ;;Check folder exists. + (display "SRC-path=") (display src-path) (newline) + (if (file-exists? dst-path) + (if (>= (assoc-ref parms 'verbosity)) + (begin (display "Folder for ") + (display (assoc-ref parms 'category)) + (display "/") + (display (assoc-ref parms 'name)) + (display " already exist.") + (newline))) + (mkpath dst-path)) + ;;symlink each ebuild and the files folder. + (for-each + (lambda (file) + (test-symlink (assoc-ref parms 'repo) + (string-join (list dst-path file) + file-name-separator-string) + (string-join (list src-path file) + file-name-separator-string) + (assoc-ref parms 'verbosity))) + (filter-map + (lambda (file) + (if (irregex-search '(or (seq bos "files" eos) + (seq ".ebuild" eos )) + file) + file + #f)) + (scandir src-path)))))) diff --git a/ebuild/utils.scm b/ebuild/utils.scm new file mode 100644 index 0000000..2907eb8 --- /dev/null +++ b/ebuild/utils.scm @@ -0,0 +1,71 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; utils.scm +;; Copyright (C) 2025 Cor Legemaat +;; +;; This file is part of ebuild-autogen: you can redistribute it and/or modify it +;; under the terms of the GNU Affero General Public License as published by the +;; Free Software Foundation, version 3 of the License. +;; +;; ebuild-autogen 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 +;; ebuild-autogen. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-module (ebuild utils) + #:use-module (srfi srfi-1)) + +(define-public list->str-list + (lambda* (in-list glue #:key (pre "") (post "")) + "" + ;;(display "in-list=") (display in-list) (newline) + (if (null? in-list) + "" + (string-concatenate + (append (list pre) + (cdr (append-map (lambda (item) + (append (list glue) + (list item))) + in-list)) + (list post)))))) + +(define-public any-str-list + (lambda (test-list val) + "" + (any (lambda (test-val) + (if (string=? test-val val) + #t #f)) + test-list))) + +(define-public mkpath + (lambda (path) + (let* ((split-path (filter-map (lambda (str) + (if (string<> str "") str #f)) + (string-split path + (car (string->list + file-name-separator-string))))) + (fixed-path (string-append (string-concatenate (map (lambda (folder) + (string-append "/" folder)) + split-path)) + "/")) + (path-1up (string-concatenate (map (lambda (folder) + (string-append "/" folder)) + (reverse (cdr (reverse split-path))))))) + (if (not (access? fixed-path F_OK)) + (if (access? path-1up F_OK) + (if (access? path-1up W_OK) + (mkdir fixed-path) + (error (string-append "Error no write permission in \"" + path-1up + "\" to create \"" + (car (reverse split-path)) + "\" folder!"))) + (begin (mkpath path-1up) + (mkdir path))))))) + +(define-public cmp-str-lists + (lambda (list1 list2) + "" + (every string=? list1 list2))) diff --git a/ebuild/version.scm.in b/ebuild/version.scm.in new file mode 100644 index 0000000..a7909e3 --- /dev/null +++ b/ebuild/version.scm.in @@ -0,0 +1,29 @@ +;; -*- Mode: Scheme; geiser-scheme-implementation: guile; tab-width: 2 -*- +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; version.scm +;; Copyright (C) 2025 Cor Legemaat +;; +;; This file is part of ebuild-autogen: you can redistribute it and/or modify it +;; under the terms of the GNU Affero General Public License as published by the +;; Free Software Foundation, version 3 of the License. +;; +;; ebuild-autogen 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 +;; ebuild-autogen. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-module (ebuild version)) + +(define-public version-str "{{version}}") + +(define-public version (map string->number + (string-split version-str #\.))) + +(define-public version-major (list-ref version 0)) +(define-public version-minor (list-ref version 1)) +(define-public version-release (list-ref version 2)) + diff --git a/po/ChangeLog b/po/ChangeLog new file mode 100644 index 0000000..7b1b102 --- /dev/null +++ b/po/ChangeLog @@ -0,0 +1,4 @@ +2025-06-28 gettextize + + * POTFILES.in: New file. + diff --git a/po/Makevars b/po/Makevars new file mode 100644 index 0000000..86a11f1 --- /dev/null +++ b/po/Makevars @@ -0,0 +1,82 @@ +# Makefile variables for PO directory in any package using GNU gettext. +# +# Copyright (C) 2003-2019 Free Software Foundation, Inc. +# This file is free software; the Free Software Foundation gives +# unlimited permission to use, copy, distribute, and modify it. + +# Usually the message domain is the same as the package name. +DOMAIN = $(PACKAGE) + +# These two variables depend on the location of this directory. +subdir = po +top_builddir = .. + +# These options get passed to xgettext. +XGETTEXT_OPTIONS = --keyword=_ --keyword=N_ + +# This is the copyright holder that gets inserted into the header of the +# $(DOMAIN).pot file. Set this to the copyright holder of the surrounding +# package. (Note that the msgstr strings, extracted from the package's +# sources, belong to the copyright holder of the package.) Translators are +# expected to transfer the copyright for their translations to this person +# or entity, or to disclaim their copyright. The empty string stands for +# the public domain; in this case the translators are expected to disclaim +# their copyright. +COPYRIGHT_HOLDER = Free Software Foundation, Inc. + +# This tells whether or not to prepend "GNU " prefix to the package +# name that gets inserted into the header of the $(DOMAIN).pot file. +# Possible values are "yes", "no", or empty. If it is empty, try to +# detect it automatically by scanning the files in $(top_srcdir) for +# "GNU packagename" string. +PACKAGE_GNU = + +# This is the email address or URL to which the translators shall report +# bugs in the untranslated strings: +# - Strings which are not entire sentences, see the maintainer guidelines +# in the GNU gettext documentation, section 'Preparing Strings'. +# - Strings which use unclear terms or require additional context to be +# understood. +# - Strings which make invalid assumptions about notation of date, time or +# money. +# - Pluralisation problems. +# - Incorrect English spelling. +# - Incorrect formatting. +# It can be your email address, or a mailing list address where translators +# can write to without being subscribed, or the URL of a web page through +# which the translators can contact you. +MSGID_BUGS_ADDRESS = + +# This is the list of locale categories, beyond LC_MESSAGES, for which the +# message catalogs shall be used. It is usually empty. +EXTRA_LOCALE_CATEGORIES = + +# This tells whether the $(DOMAIN).pot file contains messages with an 'msgctxt' +# context. Possible values are "yes" and "no". Set this to yes if the +# package uses functions taking also a message context, like pgettext(), or +# if in $(XGETTEXT_OPTIONS) you define keywords with a context argument. +USE_MSGCTXT = no + +# These options get passed to msgmerge. +# Useful options are in particular: +# --previous to keep previous msgids of translated messages, +# --quiet to reduce the verbosity. +MSGMERGE_OPTIONS = + +# These options get passed to msginit. +# If you want to disable line wrapping when writing PO files, add +# --no-wrap to MSGMERGE_OPTIONS, XGETTEXT_OPTIONS, and +# MSGINIT_OPTIONS. +MSGINIT_OPTIONS = + +# This tells whether or not to regenerate a PO file when $(DOMAIN).pot +# has changed. Possible values are "yes" and "no". Set this to no if +# the POT file is checked in the repository and the version control +# program ignores timestamps. +PO_DEPENDS_ON_POT = yes + +# This tells whether or not to forcibly update $(DOMAIN).pot and +# regenerate PO files on "make dist". Possible values are "yes" and +# "no". Set this to no if the POT file and PO files are maintained +# externally. +DIST_DEPENDS_ON_UPDATE_PO = yes diff --git a/po/POTFILES.in b/po/POTFILES.in new file mode 100644 index 0000000..667e27c --- /dev/null +++ b/po/POTFILES.in @@ -0,0 +1 @@ +# List of source files which contain translatable strings.