Build.PL100644001750000144 305514502070636 21202 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34# ========================================================================= # THIS FILE IS AUTOMATICALLY GENERATED BY MINILLA. # DO NOT EDIT DIRECTLY. # ========================================================================= use 5.008_001; use strict; use warnings; use utf8; BEGIN { push @INC, '.' } use builder::custom; use File::Basename; use File::Spec; my %args = ( license => 'perl_5', dynamic_config => 0, configure_requires => { 'Module::Build' => '0.4005', }, requires => { 'IPC::SharedMem' => '0', 'Mojolicious' => '9.34', }, recommends => { }, suggests => { }, build_requires => { }, test_requires => { 'Test::Exception' => '0', 'Test::More' => '0', }, name => 'Mojo-IOLoop-ReadWriteProcess', module_name => 'Mojo::IOLoop::ReadWriteProcess', allow_pureperl => 0, script_files => [glob('script/*'), glob('bin/*')], PL_files => {}, test_files => ((-d '.git' || $ENV{RELEASE_TESTING}) && -d 'xt') ? 't/ xt/' : 't/', recursive_test_files => 1, ); if (-d 'share') { $args{share_dir} = 'share'; } my $builder = builder::custom->subclass( class => 'MyBuilder', code => q{ sub ACTION_distmeta { die "Do not run distmeta. Install Minilla and `minil install` instead.\n"; } sub ACTION_installdeps { die "Do not run installdeps. Run `cpanm --installdeps .` instead.\n"; } } )->new(%args); $builder->create_build_script(); Changes100644001750000144 1166414502070636 21226 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34 Revision history for Perl extension Mojo-IOLoop-ReadWriteProcess 0.34 2023-09-18T15:47:18Z - Adapt to deprecation of spurt in upstream Mojolicious - Make git work in github workflow - Turn warnings "Sleeping inside locked section" into notes - Avoid warnings about using undefined value as file handle 0.33 2022-12-12T12:22:13Z - Apply perltidy v20221112 - remove hard-coding of OABI syscall entry point - Fix typos detected by lintian (Debian) (#47) - tests: Check executable, before using it in tests - Fix sporadic 01_run.t failure -- "process is still running" - Fix all .perltidyrc violations - Run perltidy for pull requests - Add test for SIG_CHLD handler in spawned process 0.32 2021-12-09T18:03:02Z - Project moved to https://github.com/openSUSE/Mojo-IOLoop-ReadWriteProcess - Introduce emit_from_sigchld() - CI moved to GitHub Actions 0.31 2021-12-01T15:51:06Z - Fix bad release to cpan - Enable GitHub Actions for the project - Fix ReadWriteProcess::Queue as regression of 1e0addb6 - Fix race on `open3/fork` and `session->register($pid)` call -- second attempt - Fix `args` processing - Fix race of SIG{CHLD} handler setup - Fix _getlines() to avoid extra newline (\n) in scalar context - Session: Do not set SIG{CHLD} handler twice - Match on 'armv7l' as well as 'arm' for prctl detection 0.28 2020-09-30T11:51:40Z - Avoid executing "blocking stop" code when process has already terminated by Martchus 0.27 2020-07-03T00:25:15Z - Fix CircleCI build - Fix perl required version 0.26 2020-07-02T18:21:18Z - Apply tools/tidy with Perl::Tidy 20200110 - Allow stopping the entire process group of the process - Change minimum perl to 5.16 0.25 2020-04-08T14:48:01Z - In "stop" sleep only after sending the first signal to speedup termination by okurz - Various fixups in test suite 0.24 2019-10-15T11:11:50Z - Fix compatibility with Mojolicious 8.23 by kraih 0.23 2018-08-14T07:25:56Z - Add prctl syscall codes for ppc64le and aarch64 - Full test suite now runs only on travis 0.22 2018-08-07T13:29:57Z - Disable experimental shared tests by default 0.21 2018-08-07T12:17:21Z - Add Experimental Mojo::IOLoop::ReadWriteProcess::Shared::* for IPC (Lock, Memory, Sempahores) - Add possibility to turn off channels only - Fix incorrect handling of return in case internal_pipes is disabled - Provide alternative exit status computation for exotic arches/setup 0.20 2018-03-26T13:32:58Z - Add preliminar CGroup support - Add also interface to unshare() syscall - Add mocked test, still needs to be documented in POD 0.19 2018-02-22T13:41:50Z - Minor bugfixes to Session - Make session constructor fixed 0.18 2018-02-21T12:01:07Z - Guard stop() from possible race conditions - Fix typo in Session, it caused orphan processes to not be resolved correctly 0.17 2018-02-20T14:01:59Z - Fix minor issue in tests, stabilize serialize test and events - Reset session and subreaper bit on forked child process 0.16 2018-02-19T13:32:54Z - Fix minor issue in event test that made them unstable 0.15 2018-02-19T10:13:22Z - Fix skipping subreaper tests on unsupported platforms - Reset session before invoking child callback 0.14 2018-02-18T21:08:17Z - Fix race condition in Mojo::IOLoop::ReadWriteProcess::Queue 0.13 2018-02-17T19:34:51Z - Move subreaper and subprocess logics to Mojo::IOLoop::ReadWriteProcess::Session - Use Mojo::IOLoop::ReadWriteProcess::Session as global collector handler 0.12 2018-02-16T12:53:26Z - Enhance tests - Add experimental subreaper and subprocess support 0.11 2018-02-12T09:32:05Z - update cpanfile requirements (requires Module::Build now) - update POD 0.10 2018-02-06T17:52:11Z - Prevent build on unsupported platforms 0.09 2017-10-09T09:19:17Z - Add option to serialize data from forked code 0.08 2017-10-02T13:43:30Z - Maintenance update, fix Mojolicious dependency version 0.07 2017-09-27T17:29:26Z - Add more tests - Skip a test that was hanging on Windows systems (@chorni) - Refactor collect_status event code 0.06 2017-09-25T12:47:15Z - Add Mojo::IOLoop::ReadWriteProcess::Queue - Mojo::IOLoop::ReadWriteProcess now can export queue() - Add tests - Make maximum_processes to be set also per-pool - Cleanup pidfile on shutdown and on collect_status 0.05 2017-09-22T07:51:33Z - Enhance testsuite - If we fail to setup process return pipe, try to send an error message (best-effort) - Check if _status is defined, it might be zero - Small refactorizations 0.04 2017-09-20T13:25:31Z - add maximum process limit to the pool - better handling of pipes in stress conditions - decouple return_status and exit_status 0.03 2017-09-18T09:47:28Z - add more pool functions - make wait() wait just the necessary time - Minor fixes 0.02 2017-09-16T14:54:07Z - Add support for pools and different perl versions 0.01 2017-09-15T15:06:17Z - original version LICENSE100644001750000144 4400114502070636 20727 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34This software is copyright (c) 2017 by Ettore Di Giacinto . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2017 by Ettore Di Giacinto . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the 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 a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE 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. END OF TERMS AND CONDITIONS Appendix: 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 humanity, 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 convey 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) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2017 by Ettore Di Giacinto . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End META.json100644001750000144 1467614502070636 21362 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34{ "abstract" : "Execute external programs or internal code blocks as separate process.", "author" : [ "Ettore Di Giacinto " ], "dynamic_config" : 0, "generated_by" : "Minilla/v3.1.22", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Mojo-IOLoop-ReadWriteProcess", "no_index" : { "directory" : [ "t", "xt", "inc", "share", "eg", "examples", "author", "builder" ] }, "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0.4005", "perl" : "5.016" } }, "develop" : { "requires" : { "Devel::Cover" : "0", "Devel::Cover::Report::Codecovbash" : "0", "Test::CPAN::Meta" : "0", "Test::MinimumVersion::Fast" : "0.04", "Test::PAUSE::Permissions" : "0.07", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "0", "Test::Spellunker" : "v0.2.7" } }, "runtime" : { "requires" : { "IPC::SharedMem" : "0", "Mojolicious" : "9.34" } }, "test" : { "requires" : { "Test::Exception" : "0", "Test::More" : "0" } } }, "provides" : { "Mojo::IOLoop::ReadWriteProcess" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess.pm", "version" : "0.34" }, "Mojo::IOLoop::ReadWriteProcess::CGroup" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v1" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuacct" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/Cpuacct.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/Cpuset.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Devices" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/Devices.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Freezer" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/Freezer.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/Memory.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Netcls" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/Netcls.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Netprio" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/Netprio.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v1::PID" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/PID.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v1::RDMA" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/RDMA.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v2" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v2::CPU" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2/CPU.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v2::IO" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2/IO.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v2::Memory" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2/Memory.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v2::PID" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2/PID.pm" }, "Mojo::IOLoop::ReadWriteProcess::CGroup::v2::RDMA" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2/RDMA.pm" }, "Mojo::IOLoop::ReadWriteProcess::Container" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/Container.pm" }, "Mojo::IOLoop::ReadWriteProcess::Exception" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/Exception.pm" }, "Mojo::IOLoop::ReadWriteProcess::Namespace" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/Namespace.pm" }, "Mojo::IOLoop::ReadWriteProcess::Pool" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/Pool.pm" }, "Mojo::IOLoop::ReadWriteProcess::Queue" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/Queue.pm" }, "Mojo::IOLoop::ReadWriteProcess::Session" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/Session.pm" }, "Mojo::IOLoop::ReadWriteProcess::Shared::Lock" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/Shared/Lock.pm" }, "Mojo::IOLoop::ReadWriteProcess::Shared::Memory" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/Shared/Memory.pm" }, "Mojo::IOLoop::ReadWriteProcess::Shared::Semaphore" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess/Shared/Semaphore.pm" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/openSUSE/Mojo-IOLoop-ReadWriteProcess/issues" }, "homepage" : "https://github.com/openSUSE/Mojo-IOLoop-ReadWriteProcess", "repository" : { "type" : "git", "url" : "https://github.com/openSUSE/Mojo-IOLoop-ReadWriteProcess.git", "web" : "https://github.com/openSUSE/Mojo-IOLoop-ReadWriteProcess" } }, "version" : "0.34", "x_contributors" : [ "Adam Williamson ", "Clemens Famulla-Conrad ", "Ettore Di Giacinto ", "Ettore Di Giacinto ", "Marius Kittler ", "Martchus ", "Mohammad S Anwar ", "Nick Morrott ", "Oliver Kurz ", "Santiago Zarate <229240+foursixnine@users.noreply.github.com>", "Santiago Zarate ", "Santiago Zarate ", "Sebastian Riedel ", "Sebastian Riedel ", "Tina Müller ", "cfconrad <40127946+cfconrad@users.noreply.github.com>", "gregor herrmann " ], "x_serialization_backend" : "JSON::PP version 4.16", "x_static_install" : 0 } README.md100644001750000144 5167614502070636 21221 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34[![Coverage Status](http://codecov.io/github/openSUSE/Mojo-IOLoop-ReadWriteProcess/coverage.svg?branch=master)](https://codecov.io/github/openSUSE/Mojo-IOLoop-ReadWriteProcess?branch=master) [![Actions Status](https://github.com/openSUSE/Mojo-IOLoop-ReadWriteProcess/workflows/linux/badge.svg)](https://github.com/openSUSE/Mojo-IOLoop-ReadWriteProcess/actions) # NAME Mojo::IOLoop::ReadWriteProcess - Execute external programs or internal code blocks as separate process. # SYNOPSIS use Mojo::IOLoop::ReadWriteProcess; # Code fork my $process = Mojo::IOLoop::ReadWriteProcess->new(sub { print "Hello\n" }); $process->start(); print "Running\n" if $process->is_running(); $process->getline(); # Will return "Hello\n" $process->pid(); # Process id $process->stop(); $process->wait_stop(); # if you intend to wait its lifespan # Methods can be chained, thus this is valid: use Mojo::IOLoop::ReadWriteProcess qw(process); my $output = process( sub { print "Hello\n" } )->start()->wait_stop->getline; # Handles seamelessy also external processes: my $process = process(execute=> '/path/to/bin' )->args([qw(foo bar baz)]); $process->start(); my $line_output = $process->getline(); my $pid = $process->pid(); $process->stop(); my @errors = $process->error; # Get process return value $process = process( sub { return "256"; } )->start()->wait_stop; # We need to stop it to retrieve the exit status my $return = $process->return_status; # We can access directly to handlers from the object: my $stdout = $process->read_stream; my $stdin = $process->write_stream; my $stderr = $process->error_stream; # So this works: print $stdin "foo bar\n"; my @lines = <$stdout>; # There is also an alternative channel of communication (just for forked processes): my $channel_in = $process->channel_in; # write to the child process my $channel_out = $process->channel_out; # read from the child process $process->channel_write("PING"); # convenience function # DESCRIPTION Mojo::IOLoop::ReadWriteProcess is yet another process manager. # EVENTS [Mojo::IOLoop::ReadWriteProcess](https://metacpan.org/pod/Mojo%3A%3AIOLoop%3A%3AReadWriteProcess) inherits all events from [Mojo::EventEmitter](https://metacpan.org/pod/Mojo%3A%3AEventEmitter) and can emit the following new ones. ## start $process->on(start => sub { my ($process) = @_; $process->is_running(); }); Emitted when the process starts. ## stop $process->on(stop => sub { my ($process) = @_; $process->restart(); }); Emitted when the process stops. ## process\_error $process->on(process_error => sub { my ($e) = @_; my @errors = @{$e}; }); Emitted when the process produce errors. ## process\_stuck $process->on(process_stuck => sub { my ($self) = @_; ... }); Emitted when `blocking_stop` is set and all attempts for killing the process in `max_kill_attempts` have been exhausted. The event is emitted before attempting to kill it with SIGKILL and becoming blocking. ## SIG\_CHLD $process->on(SIG_CHLD => sub { my ($self) = @_; ... }); Emitted when we receive SIG\_CHLD. ## SIG\_TERM $process->on(SIG_TERM => sub { my ($self) = @_; ... }); Emitted when the child forked process receives SIG\_TERM, before exiting. ## collected $process->on(collected => sub { my ($self) = @_; ... }); Emitted right after status collection. ## collect\_status $process->on(collect_status => sub { my ($self) = @_; ... }); Emitted when on child process waitpid. It is used internally to get the child process status. Note: events attached to it are wiped when process has been stopped. # ATTRIBUTES [Mojo::IOLoop::ReadWriteProcess](https://metacpan.org/pod/Mojo%3A%3AIOLoop%3A%3AReadWriteProcess) inherits all attributes from [Mojo::EventEmitter](https://metacpan.org/pod/Mojo%3A%3AEventEmitter) and implements the following new ones. ## execute use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(execute => "/usr/bin/perl"); $process->start(); $process->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $process->stop(); `execute` should contain the external program that you wish to run. ## code use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { print "Hello" } ); $process->start(); $process->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $process->stop(); It represent the code you want to run in background. You do not need to specify `code`, it is implied if no arguments is given. my $process = Mojo::IOLoop::ReadWriteProcess->new(sub { print "Hello" }); $process->start(); $process->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $process->stop(); ## args use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { print "Hello ".$_[1] }, args => "User" ); $process->start(); $process->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $process->stop(); # The process will print "Hello User" Arguments pass to the external binary or the code block. Use arrayref to pass many. ## blocking\_stop use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { print "Hello" }, blocking_stop => 1 ); $process->start(); $process->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $process->stop(); # Will wait indefinitely until the process is stopped Set it to 1 if you want to do blocking stop of the process. ## channels use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { print "Hello" }, channels => 0 ); $process->start(); $process->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $process->stop(); # Will wait indefinitely until the process is stopped Set it to 0 if you want to disable internal channels. ## session use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(sub { print "Hello" }); my $session = $process->session; $session->enable_subreaper; Returns the current [Mojo::IOLoop::ReadWriteProcess::Session](https://metacpan.org/pod/Mojo%3A%3AIOLoop%3A%3AReadWriteProcess%3A%3ASession) singleton. ## subreaper use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { print "Hello ".$_[1] }, args => "User" ); $process->subreaper(1)->start(); $process->on( stop => sub { shift()->disable_subreaper } ); $process->stop(); # The process will print "Hello User" Mark the current process (not the child) as subreaper on start. It's on invoker behalf to disable subreaper when process stops, as it marks the current process and not the child. ## ioloop my $loop = $process->ioloop; $subprocess = $process->ioloop(Mojo::IOLoop->new); Event loop object to control, defaults to the global [Mojo::IOLoop](https://metacpan.org/pod/Mojo%3A%3AIOLoop) singleton. ## max\_kill\_attempts use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { print "Hello" }, max_kill_attempts => 50 ); $process->start(); $process->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $process->stop(); # It will attempt to send SIGTERM 50 times. Defaults to `5`, is the number of attempts before bailing out. It can be used with blocking\_stop, so if the number of attempts are exhausted, a SIGKILL and waitpid will be tried at the end. ## kill\_whole\_group use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { setpgrp(0, 0); exec(...); }, kill_whole_group => 1 ); $process->start(); $process->send_signal(...); # Will skip the usual check whether $process->pid is running $process->stop(); # Kills the entire process group and waits for all processes in the group to finish Defaults to `0`, whether to send signals (e.g. to stop) to the entire process group. This is useful when the sub process creates further sub processes and creates a new process group as shown in the example. In this case it might be useful to take care of the entire process group when stopping and wait for every process in the group to finish. ## collect\_status Defaults to `1`, If enabled it will automatically collect the status of the children process. Disable it in case you want to manage your process child directly, and do not want to rely on automatic collect status. If you won't overwrite your `SIGCHLD` handler, the `SIG_CHLD` event will be still emitted. ## serialize Defaults to `0`, If enabled data returned from forked process will be serialized with Storable. ## kill\_sleeptime Defaults to `1`, it's the seconds to wait before attempting SIGKILL when blocking\_stop is set to 1. ## separate\_err Defaults to `1`, it will create a separate channel to intercept process STDERR, otherwise it will be redirected to STDOUT. ## verbose Defaults to `1`, it indicates message verbosity. ## set\_pipes Defaults to `1`, If enabled, additional pipes for process communication are automatically set up. ## internal\_pipes Defaults to `1`, If enabled, additional pipes for retreiving process return and errors are set up. Note: If you disable that, the only information provided by the process will be the exit\_status. ## autoflush Defaults to `1`, If enabled autoflush of handlers is enabled automatically. ## error Returns a [Mojo::Collection](https://metacpan.org/pod/Mojo%3A%3ACollection) of errors. Note: errors that can be captured only at the end of the process # METHODS [Mojo::IOLoop::ReadWriteProcess](https://metacpan.org/pod/Mojo%3A%3AIOLoop%3A%3AReadWriteProcess) inherits all methods from [Mojo::EventEmitter](https://metacpan.org/pod/Mojo%3A%3AEventEmitter) and implements the following new ones. ## start() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print STDERR "Boo\n" } )->start; Starts the process ## stop() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process( execute => "/path/to/bin" )->start->stop; Stop the process. Unless you use `wait_stop()`, it will attempt to kill the process without waiting the process to finish. By defaults it send `SIGTERM` to the child. You can change that by defining the internal attribute `_default_kill_signal`. Note, if you want to be \*sure\* that the process gets killed, you can enable the `blocking_stop` attribute, that will attempt to send `SIGKILL` after `max_kill_attempts` is reached. ## restart() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process( execute => "/path/to/bin" )->restart; It restarts the process if stopped, or if already running, it stops it first. ## is\_running() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process( execute => "/path/to/bin" )->start; $p->is_running; Boolean, it inspect if the process is currently running or not. ## exit\_status() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process( execute => "/path/to/bin" )->start; $p->wait_stop->exit_status; Inspect the process exit status, it does the shifting magic, to access to the real value call `_status()`. ## return\_status() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process( sub { return 42 } )->start; my $s = $p->wait_stop->return_status; # 42 Inspect the codeblock return. ## enable\_subreaper() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process()->enable_subreaper; Mark the current process (not the child) as subreaper. This is used typically if you want to mark further children as subreapers inside other forks. my $master_p = process( sub { my $p = shift; $p->enable_subreaper; process(sub { sleep 4; exit 1 })->start(); process( sub { sleep 4; process(sub { sleep 1; })->start(); })->start(); process(sub { sleep 4; exit 0 })->start(); process(sub { sleep 4; die })->start(); my $manager = process(sub { sleep 2 })->subreaper(1)->start(); sleep 1 for (0 .. 10); $manager->stop; return $manager->session->all->size; }); $master_p->subreaper(1); $master_p->on(collected => sub { $status++ }); # On start we setup the current process as subreaper # So it's up on us to disable it after process is done. $master_p->on(stop => sub { shift()->disable_subreaper }); $master_p->start(); ## disable\_subreaper() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process()->disable_subreaper; Unset the current process (not the child) as subreaper. ## prctl() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(); $p->prctl($option, $arg2, $arg3, $arg4, $arg5); Internal function to execute and wrap the prctl syscall, accepts the same arguments as prctl. ## diag() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print "Hello\n" }); $p->on( stop => sub { shift->diag("Done!") } ); $p->start->wait_stop; Internal function to print information to STDERR if verbose attribute is set or either DEBUG mode enabled. You can use it if you wish to display information on the process status. ## to\_ioloop() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print "Hello from first process\n"; sleep 1 }); $p->start(); # Start and sets the handlers my $stream = $p->to_ioloop; # Get the stream and demand to IOLoop my $output; # Hook on Mojo::IOLoop::Stream events $stream->on(read => sub { $output .= pop; $p->is_running ... }); Mojo::IOLoop->singleton->start() unless Mojo::IOLoop->singleton->is_running; Returns a [Mojo::IOLoop::Stream](https://metacpan.org/pod/Mojo%3A%3AIOLoop%3A%3AStream) object and demand the wait operation to [Mojo::IOLoop](https://metacpan.org/pod/Mojo%3A%3AIOLoop). It needs `set_pipes` enabled. Default IOLoop can be overridden in `ioloop()`. ## wait() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print "Hello\n" })->wait; # ... here now you can mangle $p handlers and such Waits until the process finishes, but does not performs cleanup operations (until stop is called). ## wait\_stop() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print "Hello\n" })->start->wait_stop; # $p is not running anymore, and all possible events have been granted to be emitted. Waits until the process finishes, and perform cleanup operations. ## errored() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { die "Nooo" })->start->wait_stop; $p->errored; # will return "1" Returns a boolean indicating if the process had errors or not. ## write\_pidfile() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { die "Nooo" } ); $p->pidfile("foobar"); $p->start(); $p->write_pidfile(); Forces writing PID of process to specified pidfile in the attributes of the object. Useful only if the process have been already started, otherwise if a pidfile it's supplied as attribute, it will be done automatically. ## write\_stdin() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { my $a = ; print STDERR "Hello my name is $a\n"; } )->start; $p->write_stdin("Larry"); $p->read_stderr; # process STDERR will contain: "Hello my name is Larry\n" Write data to process STDIN. ## write\_channel() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { my $self = shift; my $parent_output = $self->channel_out; my $parent_input = $self->channel_in; while(defined(my $line = <$parent_input>)) { print $parent_output "PONG\n" if $line =~ /PING/i; } } )->start; $p->write_channel("PING"); my $out = $p->read_channel; # $out is PONG my $child_output = $p->channel_out; while(defined(my $line = <$child_output>)) { print "Process is replying back with $line!\n"; $p->write_channel("PING"); } Write data to process channel. Note, it's not STDIN, neither STDOUT, it's a complete separate channel dedicated to parent-child communication. In the parent process, you can access to the same pipes (but from the opposite direction): my $child_output = $self->channel_out; my $child_input = $self->channel_in; ## read\_stdout() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print "Boo\n" } )->start; $p->read_stdout; Gets a single line from process STDOUT. ## read\_channel() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { my $self = shift; my $parent_output = $self->channel_out; my $parent_input = $self->channel_in; print $parent_output "PONG\n"; } )->start; $p->read_channel; Gets a single line from process channel. ## read\_stderr() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print STDERR "Boo\n" } )->start; $p->read_stderr; Gets a single line from process STDERR. ## read\_all\_stdout() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print "Boo\n" } )->start; $p->read_all_stdout; Gets all the STDOUT output of the process. ## read\_all\_channel() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { shift->channel_out->write("Ping") } )->start; $p->read_all_channel; Gets all the channel output of the process. ## read\_all\_stderr() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print STDERR "Boo\n" } )->start; $p->read_all_stderr; Gets all the STDERR output of the process. ## send\_signal() use Mojo::IOLoop::ReadWriteProcess qw(process); use POSIX; my $p = process( execute => "/path/to/bin" )->start; $p->send_signal(POSIX::SIGKILL); Send a signal to the process # EXPORTS ## parallel() use Mojo::IOLoop::ReadWriteProcess qw(parallel); my $pool = parallel sub { print "Hello\n" } => 5; $pool->start(); $pool->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $pool->stop(); Returns a [Mojo::IOLoop::ReadWriteProcess::Pool](https://metacpan.org/pod/Mojo%3A%3AIOLoop%3A%3AReadWriteProcess%3A%3APool) object that represent a group of processes. It accepts the same arguments as [Mojo::IOLoop::ReadWriteProcess](https://metacpan.org/pod/Mojo%3A%3AIOLoop%3A%3AReadWriteProcess), and the last one represent the number of processes to generate. ## batch() use Mojo::IOLoop::ReadWriteProcess qw(batch); my $pool = batch; $pool->add(sub { print "Hello\n" }); $pool->on(stop => sub { shift->_diag("Done!") })->start->wait_stop; Returns a [Mojo::IOLoop::ReadWriteProcess::Pool](https://metacpan.org/pod/Mojo%3A%3AIOLoop%3A%3AReadWriteProcess%3A%3APool) object generated from supplied arguments. It accepts as input the same parameter of [Mojo::IOLoop::ReadWriteProcess::Pool](https://metacpan.org/pod/Mojo%3A%3AIOLoop%3A%3AReadWriteProcess%3A%3APool) constructor ( see parallel() ). ## process() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process sub { print "Hello\n" }; $p->start()->wait_stop; or even: process(sub { print "Hello\n" })->start->wait_stop; Returns a [Mojo::IOLoop::ReadWriteProcess](https://metacpan.org/pod/Mojo%3A%3AIOLoop%3A%3AReadWriteProcess) object that represent a process. It accepts the same arguments as [Mojo::IOLoop::ReadWriteProcess](https://metacpan.org/pod/Mojo%3A%3AIOLoop%3A%3AReadWriteProcess). ## queue() use Mojo::IOLoop::ReadWriteProcess qw(queue); my $q = queue; $q->add(sub { return 42 } ); $q->consume; Returns a [Mojo::IOLoop::ReadWriteProcess::Queue](https://metacpan.org/pod/Mojo%3A%3AIOLoop%3A%3AReadWriteProcess%3A%3AQueue) object that represent a queue. # DEBUGGING You can set the MOJO\_EVENTEMITTER\_DEBUG environment variable to get some advanced diagnostics information printed to STDERR. MOJO_EVENTEMITTER_DEBUG=1 Also, you can set MOJO\_PROCESS\_DEBUG environment variable to get diagnostics about the process execution. MOJO_PROCESS_DEBUG=1 # LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. # AUTHOR Ettore Di Giacinto custom.pm100644001750000144 37014502070636 23161 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/builderpackage builder::custom; use strict; use warnings; use warnings FATAL => qw(recursion); use parent qw(Module::Build); sub new { my ($class, %args) = @_; die "OS Unsupported" if ($^O !~ m#(?i)Linux#); return $class->SUPER::new(%args); } 1; codecov.yml100644001750000144 53414502070636 22032 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34codecov: branch: master comment: behavior: default require_changes: true coverage: precision: 2 range: - 60.0 - 95.0 round: down status: changes: default: branches: null project: default: target: 80 threshold: 0.1 branches: null patch: default: branches: null cpanfile100644001750000144 60714502070636 21372 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34requires 'Mojolicious', '>= 9.34'; requires 'IPC::SharedMem'; on configure => sub { requires 'Module::Build'; requires 'perl', '5.016'; }; on test => sub { requires 'Test::More'; requires 'Test::Exception'; }; on develop => sub { requires 'Devel::Cover::Report::Codecovbash'; requires 'Devel::Cover'; requires 'Test::Pod::Coverage'; requires 'Test::Pod'; } ReadWriteProcess.pm100644001750000144 11326114502070636 26345 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLooppackage Mojo::IOLoop::ReadWriteProcess; our $VERSION = '0.34'; use Mojo::Base 'Mojo::EventEmitter'; use Mojo::File 'path'; use Mojo::Util qw(b64_decode b64_encode scope_guard); use Mojo::IOLoop::Stream; use Mojo::IOLoop::ReadWriteProcess::Exception; use Mojo::IOLoop::ReadWriteProcess::Pool; use Mojo::IOLoop::ReadWriteProcess::Queue; use Mojo::IOLoop::ReadWriteProcess::Session; use Mojo::IOLoop::ReadWriteProcess::Shared::Lock; use Mojo::IOLoop::ReadWriteProcess::Shared::Memory; use Mojo::IOLoop::ReadWriteProcess::Shared::Semaphore; use B::Deparse; use Carp 'confess'; use IO::Handle; use IO::Pipe; use IO::Select; use IPC::Open3; use Time::HiRes 'sleep'; use Symbol 'gensym'; use Storable; use POSIX qw( :sys_wait_h :signal_h ); our @EXPORT_OK = (qw(parallel batch process pool queue), qw(shared_memory lock semaphore)); use Exporter 'import'; use constant DEBUG => $ENV{MOJO_PROCESS_DEBUG}; has [ qw(kill_sleeptime sleeptime_during_kill), qw(separate_err autoflush set_pipes verbose), qw(internal_pipes channels) ] => 1; has [qw(blocking_stop serialize quirkiness total_sleeptime_during_kill)] => 0; has [ qw(execute code process_id pidfile return_status), qw(channel_in channel_out write_stream read_stream error_stream), qw(_internal_err _internal_return _status args) ]; has max_kill_attempts => 5; has kill_whole_group => 0; has error => sub { Mojo::Collection->new }; has ioloop => sub { Mojo::IOLoop->singleton }; has session => sub { Mojo::IOLoop::ReadWriteProcess::Session->singleton }; has _deparse => sub { B::Deparse->new } if DEBUG; has _deserialize => sub { \&Storable::thaw }; has _serialize => sub { \&Storable::freeze }; has _default_kill_signal => POSIX::SIGTERM; has _default_blocking_signal => POSIX::SIGKILL; # Override new() just to support sugar syntax # so it is possible to do : process->new(sub{ print "Hello World\n" })->start->stop; and so on. sub new { push(@_, code => splice @_, 1, 1) if ref $_[1] eq "CODE"; return shift->SUPER::new(@_); } sub to_ioloop { my $self = shift; confess 'Pipes needs to be set!' unless $self->read_stream; my $stream = Mojo::IOLoop::Stream->new($self->read_stream)->timeout(0); $self->ioloop->stream($stream); my $me = $$; $stream->on( close => sub { return unless $$ == $me; $self->_collect->stop unless defined $self->_status; }); return $stream; } sub process { __PACKAGE__->new(@_) } sub batch { Mojo::IOLoop::ReadWriteProcess::Pool->new(@_) } sub queue { Mojo::IOLoop::ReadWriteProcess::Queue->new(@_) } sub lock { Mojo::IOLoop::ReadWriteProcess::Shared::Lock->new(@_) } sub semaphore { Mojo::IOLoop::ReadWriteProcess::Shared::Semaphore->new(@_) } sub shared_memory { Mojo::IOLoop::ReadWriteProcess::Shared::Memory->new(@_) } sub parallel { my $c = batch(); $c->add(@_) for 1 .. +pop(); return $c; } sub _diag { my ($self, @messages) = @_; my $caller = (caller(1))[3]; print STDERR ">> ${caller}(): @messages\n" if (DEBUG || $self->verbose); } sub _open_collect_status { my ($self, $pid, $e, $errno) = @_; return unless $self; $self->_status($e // $?) unless defined $self->_status; $self->_diag("Forked code Process Exit status: " . $self->exit_status) if DEBUG; $self->_clean_pidfile; return $self; } # Use open3 to launch external program. sub _open { my ($self, @args) = @_; $self->_diag('Execute: ' . (join ', ', map { "'$_'" } @args)) if DEBUG; $self->on(collect_status => \&_open_collect_status); my ($wtr, $rdr, $err); $err = gensym; my $pid = open3($wtr, $rdr, ($self->separate_err) ? $err : undef, @args); die "Cannot create pipe: $!" unless defined $pid; $self->process_id($pid); # Defered collect of return status and removal of pidfile return $self unless $self->set_pipes(); $self->read_stream(IO::Handle->new_from_fd($rdr, "r")); $self->write_stream(IO::Handle->new_from_fd($wtr, "w")); $self->error_stream(($self->separate_err) ? IO::Handle->new_from_fd($err, "r") : $self->write_stream); return $self; } sub _clean_pidfile { unlink(shift->pidfile) if $_[0]->pidfile } sub _collect { my ($self, $pid) = @_; $pid //= $self->pid; $self->session->consume_collected_info; $self->session->_protect( sub { local $?; waitpid $pid, 0 unless defined $self->_status; return $self->_open_collect_status($pid) if $self->execute; return $self->_fork_collect_status($pid) if $self->code; }); $self; } sub _fork_collect_status { my ($self, $pid, $e, $errno) = @_; return unless $self; my $return_reader; my $internal_err_reader; my $rt; my @result_error; $self->_status($e // $?) unless defined $self->_status; $self->_diag("Forked code Process Exit status: " . $self->exit_status) if DEBUG; if ($self->_internal_return) { $return_reader = $self->_internal_return->isa("IO::Pipe::End") ? $self->_internal_return : $self->_internal_return->reader(); $self->_new_err('Cannot read from return code pipe') && return unless IO::Select->new($return_reader)->can_read(10); $rt = $return_reader->getline(); $self->_diag("Forked code Process Returns: " . ($rt ? $rt : 'nothing')) if DEBUG; $self->return_status( $self->serialize ? eval { $self->_deserialize->(b64_decode($rt)) } : $rt ? $rt : ()); } if ($self->_internal_err) { $internal_err_reader = $self->_internal_err->isa("IO::Pipe::End") ? $self->_internal_err : $self->_internal_err->reader(); $self->_new_err('Cannot read from errors code pipe') && return unless IO::Select->new($internal_err_reader)->can_read(10); @result_error = $internal_err_reader->getlines(); push( @{$self->error}, map { Mojo::IOLoop::ReadWriteProcess::Exception->new($_) } @result_error ) if @result_error; $self->_diag("Forked code Process Errors: " . join("\n", @result_error)) if DEBUG; } $self->_clean_pidfile; return $self; } # Handle forking of code sub _fork { my ($self, $code, @args) = @_; die "Can't spawn child without code" unless ref($code) eq "CODE"; # STDIN/STDOUT/STDERR redirect. my ($input_pipe, $output_pipe, $output_err_pipe); # Separated handles that could be used for internal comunication. my ($channel_in, $channel_out); if ($self->set_pipes) { $input_pipe = IO::Pipe->new() or $self->_new_err('Failed creating input pipe'); $output_pipe = IO::Pipe->new() or $self->_new_err('Failed creating output pipe'); $output_err_pipe = IO::Pipe->new() or $self->_new_err('Failed creating output error pipe'); if ($self->channels) { $channel_in = IO::Pipe->new() or $self->_new_err('Failed creating Channel input pipe'); $channel_out = IO::Pipe->new() or $self->_new_err('Failed creating Channel output pipe'); } } if ($self->internal_pipes) { my $internal_err = IO::Pipe->new() or $self->_new_err('Failed creating internal error pipe'); my $internal_return = IO::Pipe->new() or $self->_new_err('Failed creating internal return pipe'); # Internal pipes to retrieve error/return $self->_internal_err($internal_err); $self->_internal_return($internal_return); } # Defered collect of return status $self->on(collect_status => \&_fork_collect_status); $self->_diag("Fork: " . $self->_deparse->coderef2text($code)) if DEBUG; my $pid = fork; die "Cannot fork: $!" unless defined $pid; if ($pid == 0) { local $SIG{CHLD}; local $SIG{TERM} = sub { $self->emit('SIG_TERM')->_exit(1) }; my $return; my $internal_err; if ($self->internal_pipes) { if ($self->_internal_err) { $internal_err = $self->_internal_err->isa("IO::Pipe::End") ? $self->_internal_err : $self->_internal_err->writer(); $internal_err->autoflush(1); } if ($self->_internal_return) { $return = $self->_internal_return->isa("IO::Pipe::End") ? $self->_internal_return : $self->_internal_return->writer(); $return->autoflush(1); } else { eval { $internal_err->write("Can't setup return status pipe") }; } } # Set pipes to redirect STDIN/STDOUT/STDERR + channels if desired if ($self->set_pipes()) { my $stdout; my $stderr; my $stdin; $stdout = $output_pipe->writer() if $output_pipe; $stderr = (!$self->separate_err) ? $stdout : $output_err_pipe ? $output_err_pipe->writer() : undef; $stdin = $input_pipe->reader() if $input_pipe; open STDERR, ">&", $stderr or !!$internal_err->write($!) or $self->_diag($!) if $stderr; open STDOUT, ">&", $stdout or !!$internal_err->write($!) or $self->_diag($!) if $stdout; open STDIN, ">&", $stdin or !!$internal_err->write($!) or $self->_diag($!) if $stdin; $self->read_stream($stdin); $self->error_stream($stderr); $self->write_stream($stdout); if ($self->channels) { $self->channel_in($channel_in->reader) if $channel_in; $self->channel_out($channel_out->writer) if $channel_out; eval { $self->$_->autoflush($self->autoflush) } for qw( channel_in channel_out ); } eval { $self->$_->autoflush($self->autoflush) } for qw(read_stream error_stream write_stream ); } $self->session->reset; $self->session->subreaper(0); # Subreaper bit does not persist in fork $self->process_id($$); $! = 0; my $rt; eval { $rt = [$code->($self, @args)]; }; if ($internal_err) { $internal_err->write($@) if $@; $internal_err->write($!) if !$@ && $!; } $rt = @$rt[0] if !$self->serialize && ref $rt eq 'ARRAY' && scalar @$rt == 1; $rt = b64_encode(eval { $self->_serialize->($rt) }) if $self->serialize && $return; $return->write($rt) if $return; $self->_exit($@ // $!); } $self->process_id($pid); return $self unless $self->set_pipes(); $self->read_stream($output_pipe->reader) if $output_pipe; $self->error_stream((!$self->separate_err) ? $self->read_stream() : $output_err_pipe ? $output_err_pipe->reader() : undef); $self->write_stream($input_pipe->writer) if $input_pipe; if ($self->set_pipes) { if ($self->channels) { $self->channel_in($channel_in->writer) if $channel_in; $self->channel_out($channel_out->reader) if $channel_out; eval { $self->$_->autoflush($self->autoflush) } for qw( channel_in channel_out ); } eval { $self->$_->autoflush($self->autoflush) } for qw(read_stream error_stream write_stream ); } return $self; } sub _new_err { my $self = shift; my $err = Mojo::IOLoop::ReadWriteProcess::Exception->new(@_); push(@{$self->error}, $err); # XXX: Need to switch, we should emit one error at the time, and _shutdown # should emit just the ones wasn't emitted return $self->emit(process_error => [$err]); } sub _exit { my $code = shift // 0; eval { POSIX::_exit($code); }; exit($code); } sub wait { my $self = shift; sleep $self->sleeptime_during_kill while ($self->is_running); return $self; } sub wait_stop { shift->wait->stop } sub errored { !!@{shift->error} ? 1 : 0 } # PPC64: Treat msb on neg (different cpu/perl interpreter version) sub _st { my $st = shift >> 8; ($st & 0x80) ? (0x100 - ($st & 0xFF)) : $st } sub exit_status { defined $_[0]->_status && $_[0]->quirkiness ? _st(shift->_status) : defined $_[0]->_status ? shift->_status >> 8 : undef; } sub restart { $_[0]->is_running ? $_[0]->stop->start : $_[0]->start; } sub is_running { my ($self) = shift; $self->session->consume_collected_info; $self->process_id ? kill 0 => $self->process_id : 0; } sub write_pidfile { my ($self, $pidfile) = @_; $self->pidfile($pidfile) if $pidfile; return unless $self->pid; return unless $self->pidfile; path($self->pidfile)->spew($self->pid); return $self; } # Convenience functions sub _syswrite { my $stream = shift; return unless $stream; $stream->syswrite($_ . "\n") for @_; } sub _getline { return unless IO::Select->new($_[0])->can_read(10); shift->getline; } sub _getlines { return unless IO::Select->new($_[0])->can_read(10); wantarray ? shift->getlines : join '', @{[shift->getlines]}; } # Write to the controlled-process STDIN sub write_stdin { my ($self, @data) = @_; _syswrite($self->write_stream, @data); return $self; } sub write_channel { my ($self, @data) = @_; _syswrite($self->channel_in, @data); return $self; } # Get all lines from the current process output stream sub read_all_stdout { _getlines(shift->read_stream) } # Get all lines from the process channel sub read_all_channel { _getlines(shift->channel_out); } sub read_stdout { _getline(shift->read_stream) } sub read_channel { _getline(shift->channel_out) } sub read_all_stderr { return $_[0]->getline unless $_[0]->separate_err; _getlines(shift->error_stream); } # Get a line from the current process output stream sub read_stderr { return $_[0]->getline unless $_[0]->separate_err; _getline(shift->error_stream); } sub start { my $self = shift; return $self if $self->is_running; die "Nothing to do" unless !!$self->execute || !!$self->code; my @args = defined($self->args) ? ref($self->args) eq "ARRAY" ? @{$self->args} : $self->args : (); $self->session->enable_subreaper if $self->subreaper; $self->_status(undef); $self->session->enable; { my $old_emit_from_sigchld = $self->session->emit_from_sigchld; $self->session->emit_from_sigchld(0); my $scope_guard = scope_guard sub { $self->session->emit_from_sigchld($old_emit_from_sigchld); $self->session->consume_collected_info if ($old_emit_from_sigchld); }; if ($self->code) { $self->_fork($self->code, @args); } elsif ($self->execute) { $self->_open($self->execute, @args); } $self->write_pidfile; $self->emit('start'); $self->session->register($self->pid() => $self); } return $self; } sub send_signal { my $self = shift; my $signal = shift // $self->_default_kill_signal; my $pid = shift // $self->process_id; return unless $self->kill_whole_group || $self->is_running; $self->_diag("Sending signal '$signal' to $pid") if DEBUG; kill $signal => $pid; return $self; } sub stop { my $self = shift; my $pid = $self->pid; return $self unless defined $pid; return $self->_shutdown(1) unless $self->is_running; $self->_diag("Stopping $pid") if DEBUG; my $ret; my $attempt = 1; my $timeout = $self->total_sleeptime_during_kill // 0; my $sleep_time = $self->sleeptime_during_kill; my $max_attempts = $self->max_kill_attempts; my $signal = $self->_default_kill_signal; $pid = -getpgrp($pid) if $self->kill_whole_group; until ((defined $ret && ($ret == $pid || $ret == -1)) || ($attempt > $max_attempts && $timeout <= 0)) { my $send_signal = $attempt == 1 || $timeout <= 0; $self->_diag( "attempt $attempt/$max_attempts to kill process: $pid, timeout: $timeout") if DEBUG && $send_signal; $self->session->_protect( sub { local $?; if ($send_signal) { $self->send_signal($signal, $pid); ++$attempt; } $ret = waitpid($pid, WNOHANG); $self->_status($?) if $ret == $pid || $ret == -1; }); if ($sleep_time) { sleep $sleep_time; $timeout -= $sleep_time; } } return $self->_shutdown if defined $self->_status; sleep $self->kill_sleeptime if $self->kill_sleeptime; if ($self->blocking_stop) { $self->_diag("Could not kill process id: $pid, blocking attempt") if DEBUG; $self->emit('process_stuck'); ### XXX: avoid to protect on blocking. $self->send_signal($self->_default_blocking_signal, $pid); $ret = waitpid($pid, 0); $self->_status($?) if $ret == $pid || $ret == -1; return $self->_shutdown; } else { $self->_diag("Could not kill process id: $pid") if DEBUG; $self->_new_err('Could not kill process'); } return $self; } sub _shutdown { my ($self, $wait) = @_; return $self unless $self->pid; $self->_diag("Shutdown " . $self->pid) if DEBUG; $self->session->_protect( sub { local $?; waitpid $self->pid, 0; $self->emit('collect_status'); }) if $wait && !defined $self->_status; $self->emit('collect_status') unless defined $self->_status; $self->_clean_pidfile; $self->emit('process_error', $self->error) if $self->error && $self->error->size > 0; $self->unsubscribe('collect_status'); return $self->emit('stop'); } # General alias *pid = \&process_id; *died = \&_errored; *failed = \&_errored; *diag = \&_diag; *pool = \&batch; *signal = \&send_signal; *prctl = \&Mojo::IOLoop::ReadWriteProcess::Session::_prctl; *subreaper = \&Mojo::IOLoop::ReadWriteProcess::Session::subreaper; *enable_subreaper = \&Mojo::IOLoop::ReadWriteProcess::Session::enable_subreaper; *disable_subreaper = \&Mojo::IOLoop::ReadWriteProcess::Session::disable_subreaper; *_get_prctl_syscall = \&Mojo::IOLoop::ReadWriteProcess::Session::_get_prctl_syscall; # Aliases - write *write = \&write_stdin; *stdin = \&write_stdin; *channel_write = \&write_channel; # Aliases - read *read = \&read_stdout; *stdout = \&read_stdout; *getline = \&read_stdout; *stderr = \&read_stderr; *err_getline = \&read_stderr; *channel_read = \&read_channel; *read_all = \&read_all_stdout; *getlines = \&read_all_stdout; *stderr_all = \&read_all_stderr; *err_getlines = \&read_all_stderr; *channel_read_all = \&read_all_channel; # Aliases - IO::Handle *stdin_handle = \&write_stream; *stdout_handle = \&read_stream; *stderr_handle = \&error_stream; *channe_write_handle = \&channel_in; *channel_read_handle = \&channel_out; 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess - Execute external programs or internal code blocks as separate process. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess; # Code fork my $process = Mojo::IOLoop::ReadWriteProcess->new(sub { print "Hello\n" }); $process->start(); print "Running\n" if $process->is_running(); $process->getline(); # Will return "Hello\n" $process->pid(); # Process id $process->stop(); $process->wait_stop(); # if you intend to wait its lifespan # Methods can be chained, thus this is valid: use Mojo::IOLoop::ReadWriteProcess qw(process); my $output = process( sub { print "Hello\n" } )->start()->wait_stop->getline; # Handles seamelessy also external processes: my $process = process(execute=> '/path/to/bin' )->args([qw(foo bar baz)]); $process->start(); my $line_output = $process->getline(); my $pid = $process->pid(); $process->stop(); my @errors = $process->error; # Get process return value $process = process( sub { return "256"; } )->start()->wait_stop; # We need to stop it to retrieve the exit status my $return = $process->return_status; # We can access directly to handlers from the object: my $stdout = $process->read_stream; my $stdin = $process->write_stream; my $stderr = $process->error_stream; # So this works: print $stdin "foo bar\n"; my @lines = <$stdout>; # There is also an alternative channel of communication (just for forked processes): my $channel_in = $process->channel_in; # write to the child process my $channel_out = $process->channel_out; # read from the child process $process->channel_write("PING"); # convenience function =head1 DESCRIPTION Mojo::IOLoop::ReadWriteProcess is yet another process manager. =head1 EVENTS L inherits all events from L and can emit the following new ones. =head2 start $process->on(start => sub { my ($process) = @_; $process->is_running(); }); Emitted when the process starts. =head2 stop $process->on(stop => sub { my ($process) = @_; $process->restart(); }); Emitted when the process stops. =head2 process_error $process->on(process_error => sub { my ($e) = @_; my @errors = @{$e}; }); Emitted when the process produce errors. =head2 process_stuck $process->on(process_stuck => sub { my ($self) = @_; ... }); Emitted when C is set and all attempts for killing the process in C have been exhausted. The event is emitted before attempting to kill it with SIGKILL and becoming blocking. =head2 SIG_CHLD $process->on(SIG_CHLD => sub { my ($self) = @_; ... }); Emitted when we receive SIG_CHLD. =head2 SIG_TERM $process->on(SIG_TERM => sub { my ($self) = @_; ... }); Emitted when the child forked process receives SIG_TERM, before exiting. =head2 collected $process->on(collected => sub { my ($self) = @_; ... }); Emitted right after status collection. =head2 collect_status $process->on(collect_status => sub { my ($self) = @_; ... }); Emitted when on child process waitpid. It is used internally to get the child process status. Note: events attached to it are wiped when process has been stopped. =head1 ATTRIBUTES L inherits all attributes from L and implements the following new ones. =head2 execute use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(execute => "/usr/bin/perl"); $process->start(); $process->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $process->stop(); C should contain the external program that you wish to run. =head2 code use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { print "Hello" } ); $process->start(); $process->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $process->stop(); It represent the code you want to run in background. You do not need to specify C, it is implied if no arguments is given. my $process = Mojo::IOLoop::ReadWriteProcess->new(sub { print "Hello" }); $process->start(); $process->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $process->stop(); =head2 args use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { print "Hello ".$_[1] }, args => "User" ); $process->start(); $process->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $process->stop(); # The process will print "Hello User" Arguments pass to the external binary or the code block. Use arrayref to pass many. =head2 blocking_stop use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { print "Hello" }, blocking_stop => 1 ); $process->start(); $process->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $process->stop(); # Will wait indefinitely until the process is stopped Set it to 1 if you want to do blocking stop of the process. =head2 channels use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { print "Hello" }, channels => 0 ); $process->start(); $process->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $process->stop(); # Will wait indefinitely until the process is stopped Set it to 0 if you want to disable internal channels. =head2 session use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(sub { print "Hello" }); my $session = $process->session; $session->enable_subreaper; Returns the current L singleton. =head2 subreaper use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { print "Hello ".$_[1] }, args => "User" ); $process->subreaper(1)->start(); $process->on( stop => sub { shift()->disable_subreaper } ); $process->stop(); # The process will print "Hello User" Mark the current process (not the child) as subreaper on start. It's on invoker behalf to disable subreaper when process stops, as it marks the current process and not the child. =head2 ioloop my $loop = $process->ioloop; $subprocess = $process->ioloop(Mojo::IOLoop->new); Event loop object to control, defaults to the global L singleton. =head2 max_kill_attempts use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { print "Hello" }, max_kill_attempts => 50 ); $process->start(); $process->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $process->stop(); # It will attempt to send SIGTERM 50 times. Defaults to C<5>, is the number of attempts before bailing out. It can be used with blocking_stop, so if the number of attempts are exhausted, a SIGKILL and waitpid will be tried at the end. =head2 kill_whole_group use Mojo::IOLoop::ReadWriteProcess; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { setpgrp(0, 0); exec(...); }, kill_whole_group => 1 ); $process->start(); $process->send_signal(...); # Will skip the usual check whether $process->pid is running $process->stop(); # Kills the entire process group and waits for all processes in the group to finish Defaults to C<0>, whether to send signals (e.g. to stop) to the entire process group. This is useful when the sub process creates further sub processes and creates a new process group as shown in the example. In this case it might be useful to take care of the entire process group when stopping and wait for every process in the group to finish. =head2 collect_status Defaults to C<1>, If enabled it will automatically collect the status of the children process. Disable it in case you want to manage your process child directly, and do not want to rely on automatic collect status. If you won't overwrite your C handler, the C event will be still emitted. =head2 serialize Defaults to C<0>, If enabled data returned from forked process will be serialized with Storable. =head2 kill_sleeptime Defaults to C<1>, it's the seconds to wait before attempting SIGKILL when blocking_stop is set to 1. =head2 separate_err Defaults to C<1>, it will create a separate channel to intercept process STDERR, otherwise it will be redirected to STDOUT. =head2 verbose Defaults to C<1>, it indicates message verbosity. =head2 set_pipes Defaults to C<1>, If enabled, additional pipes for process communication are automatically set up. =head2 internal_pipes Defaults to C<1>, If enabled, additional pipes for retreiving process return and errors are set up. Note: If you disable that, the only information provided by the process will be the exit_status. =head2 autoflush Defaults to C<1>, If enabled autoflush of handlers is enabled automatically. =head2 error Returns a L of errors. Note: errors that can be captured only at the end of the process =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 start() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print STDERR "Boo\n" } )->start; Starts the process =head2 stop() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process( execute => "/path/to/bin" )->start->stop; Stop the process. Unless you use C, it will attempt to kill the process without waiting the process to finish. By defaults it send C to the child. You can change that by defining the internal attribute C<_default_kill_signal>. Note, if you want to be *sure* that the process gets killed, you can enable the C attribute, that will attempt to send C after C is reached. =head2 restart() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process( execute => "/path/to/bin" )->restart; It restarts the process if stopped, or if already running, it stops it first. =head2 is_running() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process( execute => "/path/to/bin" )->start; $p->is_running; Boolean, it inspect if the process is currently running or not. =head2 exit_status() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process( execute => "/path/to/bin" )->start; $p->wait_stop->exit_status; Inspect the process exit status, it does the shifting magic, to access to the real value call C<_status()>. =head2 return_status() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process( sub { return 42 } )->start; my $s = $p->wait_stop->return_status; # 42 Inspect the codeblock return. =head2 enable_subreaper() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process()->enable_subreaper; Mark the current process (not the child) as subreaper. This is used typically if you want to mark further children as subreapers inside other forks. my $master_p = process( sub { my $p = shift; $p->enable_subreaper; process(sub { sleep 4; exit 1 })->start(); process( sub { sleep 4; process(sub { sleep 1; })->start(); })->start(); process(sub { sleep 4; exit 0 })->start(); process(sub { sleep 4; die })->start(); my $manager = process(sub { sleep 2 })->subreaper(1)->start(); sleep 1 for (0 .. 10); $manager->stop; return $manager->session->all->size; }); $master_p->subreaper(1); $master_p->on(collected => sub { $status++ }); # On start we setup the current process as subreaper # So it's up on us to disable it after process is done. $master_p->on(stop => sub { shift()->disable_subreaper }); $master_p->start(); =head2 disable_subreaper() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process()->disable_subreaper; Unset the current process (not the child) as subreaper. =head2 prctl() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(); $p->prctl($option, $arg2, $arg3, $arg4, $arg5); Internal function to execute and wrap the prctl syscall, accepts the same arguments as prctl. =head2 diag() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print "Hello\n" }); $p->on( stop => sub { shift->diag("Done!") } ); $p->start->wait_stop; Internal function to print information to STDERR if verbose attribute is set or either DEBUG mode enabled. You can use it if you wish to display information on the process status. =head2 to_ioloop() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print "Hello from first process\n"; sleep 1 }); $p->start(); # Start and sets the handlers my $stream = $p->to_ioloop; # Get the stream and demand to IOLoop my $output; # Hook on Mojo::IOLoop::Stream events $stream->on(read => sub { $output .= pop; $p->is_running ... }); Mojo::IOLoop->singleton->start() unless Mojo::IOLoop->singleton->is_running; Returns a L object and demand the wait operation to L. It needs C enabled. Default IOLoop can be overridden in C. =head2 wait() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print "Hello\n" })->wait; # ... here now you can mangle $p handlers and such Waits until the process finishes, but does not performs cleanup operations (until stop is called). =head2 wait_stop() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print "Hello\n" })->start->wait_stop; # $p is not running anymore, and all possible events have been granted to be emitted. Waits until the process finishes, and perform cleanup operations. =head2 errored() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { die "Nooo" })->start->wait_stop; $p->errored; # will return "1" Returns a boolean indicating if the process had errors or not. =head2 write_pidfile() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { die "Nooo" } ); $p->pidfile("foobar"); $p->start(); $p->write_pidfile(); Forces writing PID of process to specified pidfile in the attributes of the object. Useful only if the process have been already started, otherwise if a pidfile it's supplied as attribute, it will be done automatically. =head2 write_stdin() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { my $a = ; print STDERR "Hello my name is $a\n"; } )->start; $p->write_stdin("Larry"); $p->read_stderr; # process STDERR will contain: "Hello my name is Larry\n" Write data to process STDIN. =head2 write_channel() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { my $self = shift; my $parent_output = $self->channel_out; my $parent_input = $self->channel_in; while(defined(my $line = <$parent_input>)) { print $parent_output "PONG\n" if $line =~ /PING/i; } } )->start; $p->write_channel("PING"); my $out = $p->read_channel; # $out is PONG my $child_output = $p->channel_out; while(defined(my $line = <$child_output>)) { print "Process is replying back with $line!\n"; $p->write_channel("PING"); } Write data to process channel. Note, it's not STDIN, neither STDOUT, it's a complete separate channel dedicated to parent-child communication. In the parent process, you can access to the same pipes (but from the opposite direction): my $child_output = $self->channel_out; my $child_input = $self->channel_in; =head2 read_stdout() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print "Boo\n" } )->start; $p->read_stdout; Gets a single line from process STDOUT. =head2 read_channel() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { my $self = shift; my $parent_output = $self->channel_out; my $parent_input = $self->channel_in; print $parent_output "PONG\n"; } )->start; $p->read_channel; Gets a single line from process channel. =head2 read_stderr() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print STDERR "Boo\n" } )->start; $p->read_stderr; Gets a single line from process STDERR. =head2 read_all_stdout() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print "Boo\n" } )->start; $p->read_all_stdout; Gets all the STDOUT output of the process. =head2 read_all_channel() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { shift->channel_out->write("Ping") } )->start; $p->read_all_channel; Gets all the channel output of the process. =head2 read_all_stderr() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(sub { print STDERR "Boo\n" } )->start; $p->read_all_stderr; Gets all the STDERR output of the process. =head2 send_signal() use Mojo::IOLoop::ReadWriteProcess qw(process); use POSIX; my $p = process( execute => "/path/to/bin" )->start; $p->send_signal(POSIX::SIGKILL); Send a signal to the process =head1 EXPORTS =head2 parallel() use Mojo::IOLoop::ReadWriteProcess qw(parallel); my $pool = parallel sub { print "Hello\n" } => 5; $pool->start(); $pool->on( stop => sub { print "Process: ".(+shift()->pid)." finished"; } ); $pool->stop(); Returns a L object that represent a group of processes. It accepts the same arguments as L, and the last one represent the number of processes to generate. =head2 batch() use Mojo::IOLoop::ReadWriteProcess qw(batch); my $pool = batch; $pool->add(sub { print "Hello\n" }); $pool->on(stop => sub { shift->_diag("Done!") })->start->wait_stop; Returns a L object generated from supplied arguments. It accepts as input the same parameter of L constructor ( see parallel() ). =head2 process() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process sub { print "Hello\n" }; $p->start()->wait_stop; or even: process(sub { print "Hello\n" })->start->wait_stop; Returns a L object that represent a process. It accepts the same arguments as L. =head2 queue() use Mojo::IOLoop::ReadWriteProcess qw(queue); my $q = queue; $q->add(sub { return 42 } ); $q->consume; Returns a L object that represent a queue. =head1 DEBUGGING You can set the MOJO_EVENTEMITTER_DEBUG environment variable to get some advanced diagnostics information printed to STDERR. MOJO_EVENTEMITTER_DEBUG=1 Also, you can set MOJO_PROCESS_DEBUG environment variable to get diagnostics about the process execution. MOJO_PROCESS_DEBUG=1 =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut CGroup.pm100644001750000144 574114502070636 27507 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcesspackage Mojo::IOLoop::ReadWriteProcess::CGroup; use Mojo::Base -base; use Mojo::File 'path'; use Mojo::IOLoop::ReadWriteProcess::CGroup::v1; use Mojo::IOLoop::ReadWriteProcess::CGroup::v2; use File::Spec::Functions 'splitdir'; our @EXPORT_OK = qw(cgroupv2 cgroupv1); use Exporter 'import'; use constant CGROUP_FS => $ENV{MOJO_CGROUP_FS} // '/sys/fs/cgroup'; use constant DEBUG => $ENV{MOJO_PROCESS_DEBUG}; has '_vfs' => sub { CGROUP_FS() }; has [qw(name parent)]; sub cgroupv2 { Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new(@_)->create } sub cgroupv1 { Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new(@_)->create } sub from { my ($self, $string) = @_; my $g = $self->_vfs; $string =~ s/$g//; my @p = splitdir($string); my $pre = substr $string, 0, 1; shift @p if $pre eq '/'; my $name = shift @p; return $_[0]->new(name => $name, parent => path(@p)); } sub _cgroup { path($_[0]->parent ? path($_[0]->_vfs, $_[0]->name // '', $_[0]->parent) : path($_[0]->_vfs, $_[0]->name // '')); } sub create { $_[0]->_cgroup->make_path unless -d $_[0]->_cgroup; $_[0] } # TODO: Make sure there aren't pid belonging to cgroup before removing # This is done in Container class, but we might want to warn in case this is hit sub remove { rmdir $_[0]->_cgroup->to_string } #->remove_tree() } sub child { return $_[0]->new( name => $_[0]->name, parent => $_[0]->parent ? path($_[0]->parent, $_[1]) : $_[1])->create; } sub exists { -d $_[0]->_cgroup } sub _append { my $h = $_[0]->_cgroup->child($_[1])->open('>>'); print $h pop() } sub _write { my $h = $_[0]->_cgroup->child($_[1])->open('>'); print $h pop() } sub _flag { my $f = pop; my $h = $_[0]->_cgroup->child($_[1])->open('>'); print $h ($f == 0 ? 0 : 1); } sub _appendln { shift->_append(shift() => pop() . "\n") } sub _list { my $c = shift->_cgroup->child(pop); $c->slurp if -e $c } sub _listarray { split(/\n/, shift->_list(@_)) } sub _contains { my $p = pop; my $i = pop; grep { $p eq $_ } shift->_listarray($i); } sub _setget { $_[2] ? shift->_cgroup->child($_[0])->spew($_[1]) : shift->_cgroup->child($_[0])->slurp; } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup - Base object for CGroups implementations. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup->new( name => "test" ); $cgroup->create; $cgroup->exists; my $child = $cgroup->child('bar'); =head1 DESCRIPTION This module uses features that are only available on Linux, and requires cgroups and capability for unshare syscalls to achieve pid isolation. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut v1.pm100644001750000144 1141614502070636 30051 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGrouppackage Mojo::IOLoop::ReadWriteProcess::CGroup::v1; # Refer to https://www.kernel.org/doc/Documentation/cgroup-v1/ for details use Mojo::Base 'Mojo::IOLoop::ReadWriteProcess::CGroup'; use Mojo::File 'path'; use Mojo::Collection 'c'; use Carp 'confess'; our @EXPORT_OK = qw(cgroup); use Exporter 'import'; use constant {PROCS_INTERFACE => 'cgroup.procs', TASKS_INTERFACE => 'tasks'}; use Scalar::Util (); use Mojo::IOLoop::ReadWriteProcess::CGroup::v1::PID; use Mojo::IOLoop::ReadWriteProcess::CGroup::v1::RDMA; use Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory; use Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Devices; use Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuacct; use Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset; use Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Netcls; use Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Netprio; use Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Freezer; use File::Spec::Functions 'splitdir'; has controller => ''; sub _cgroup { path( $_[0]->parent ? path( $_[0]->_vfs, $_[0]->controller // '', $_[0]->name // '', $_[0]->parent ) : path($_[0]->_vfs, $_[0]->controller // '', $_[0]->name // '')); } sub child { return $_[0]->new( name => $_[0]->name, controller => $_[0]->controller, parent => $_[0]->parent ? path($_[0]->parent, $_[1]) : $_[1])->create; } sub from { my ($self, $string) = @_; my $g = $self->_vfs; $string =~ s/$g//; my @p = splitdir($string); my $pre = substr $string, 0, 1; shift @p if $pre eq '/'; my $controller = shift @p; my $name = shift @p; return $_[0] ->new(name => $name, controller => $controller, parent => path(@p)); } has pid => sub { my $pid = Mojo::IOLoop::ReadWriteProcess::CGroup::v1::PID->new(cgroup => shift); Scalar::Util::weaken $pid->{cgroup}; return $pid; }; has rdma => sub { my $rdma = Mojo::IOLoop::ReadWriteProcess::CGroup::v1::RDMA->new(cgroup => shift); Scalar::Util::weaken $rdma->{cgroup}; return $rdma; }; has memory => sub { my $memory = Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory->new(cgroup => shift); Scalar::Util::weaken $memory->{cgroup}; return $memory; }; has devices => sub { my $devices = Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Devices->new(cgroup => shift); Scalar::Util::weaken $devices->{cgroup}; return $devices; }; has cpuacct => sub { my $cpuacct = Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuacct->new(cgroup => shift); Scalar::Util::weaken $cpuacct->{cgroup}; return $cpuacct; }; has cpuset => sub { my $cpuset = Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset->new(cgroup => shift); Scalar::Util::weaken $cpuset->{cgroup}; return $cpuset; }; has netcls => sub { my $netcls = Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Netcls->new(cgroup => shift); Scalar::Util::weaken $netcls->{cgroup}; return $netcls; }; has netprio => sub { my $netprio = Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Netprio->new(cgroup => shift); Scalar::Util::weaken $netprio->{cgroup}; return $netprio; }; has freezer => sub { my $freezer = Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Freezer->new(cgroup => shift); Scalar::Util::weaken $freezer->{cgroup}; return $freezer; }; # CGroups process interface sub add_process { shift->_appendln(+PROCS_INTERFACE() => pop) } sub process_list { shift->_list(PROCS_INTERFACE) } sub processes { c(shift->_listarray(PROCS_INTERFACE)) } sub contains_process { shift->_contains(+PROCS_INTERFACE() => pop) } # CGroups thread interface sub add_thread { shift->_appendln(+TASKS_INTERFACE() => pop) } sub thread_list { shift->_list(TASKS_INTERFACE) } sub contains_thread { shift->_contains(+TASKS_INTERFACE() => pop) } *CPU = \&cpu; *MEMORY = \&memory; *PID = \&pid; *RDMA = \&rdma; *DEVICES = \&devices; *FREEZER = \&freezer; *NETPRIO = \&netprio; *NETCLS = \&netcls; *CPUSET = \&cpuset; *CPUACCT = \&cpuacct; 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v1 - CGroups v1 implementation. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v1; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new( name => "test" ); $cgroup->create; $cgroup->exists; my $child = $cgroup->child('bar'); =head1 DESCRIPTION This module uses features that are only available on Linux, and requires cgroups and capability for unshare syscalls to achieve pid isolation. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut Cpuacct.pm100644001750000144 212614502070636 31411 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1package Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuacct; use Mojo::Base -base; use constant USAGE_INTERFACE => 'cpuacct.usage'; has cgroup => sub { Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new }; sub usage { shift->cgroup->_list(USAGE_INTERFACE) } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuacct - CGroups v1 Cpuacct Controller. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v1; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new( name => "test" ); $cgroup->cpuacct->current; =head1 DESCRIPTION This module uses features that are only available on Linux, and requires cgroups and capability for unshare syscalls to achieve pid isolation. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut Cpuset.pm100644001750000144 616414502070636 31300 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1package Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset; use Mojo::Base -base; use constant { # list of CPUs in that cpuset CPUS_INTERFACE => 'cpuset.cpus', # list of Memory Nodes in that cpuset MEMS_INTERFACE => 'cpuset.mems', # if set, move pages to cpusets nodes MEMORY_MIGRATE_INTERFACE => 'cpuset.memory_migrate', # is cpu placement exclusive? CPU_EXCLUSIVE_INTERFACE => 'cpuset.cpu_exclusive', # is memory placement exclusive? MEM_EXCLUSIVE_INTERFACE => 'cpuset.mem_exclusive', # is memory allocation hardwalled MEM_HARDWALL_INTERFACE => 'cpuset.mem_hardwall', # measure of how much paging pressure in cpuset MEM_PRESSURE_INTERFACE => 'cpuset.memory_pressure', # if set, spread page cache evenly on allowed nodes MEM_SPREAD_PAGE_INTERFACE => 'cpuset.memory_spread_page', # if set, spread slab cache evenly on allowed nodes MEM_SPREAD_SLAB_INTERFACE => 'cpuset.memory_spread_slab', # if set, load balance within CPUs on that cpuset SCHED_LOAD_BALANCE_INTERFACE => 'cpuset.sched_load_balance', # the searching range when migrating tasks SCHED_RELAX_DOMAIN_LEVEL_INTERFACE => 'cpuset.sched_relax_domain_level', # In addition, only the root cpuset has the following - compute memory_pressure? MEMORY_PRESSURE_ENABLED_INTERFACE => 'cpuset.memory_pressure_enabled', }; has cgroup => sub { Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new }; sub cpus { shift->cgroup->_write(CPUS_INTERFACE, @_) } sub mems { shift->cgroup->_write(MEMS_INTERFACE, @_) } sub memory_pressure { shift->cgroup->_flag(MEMORY_PRESSURE_ENABLED_INTERFACE, @_); } sub sched_relax_domain_level { shift->cgroup->_flag(SCHED_RELAX_DOMAIN_LEVEL_INTERFACE, @_); } sub sched_load_balance { shift->cgroup->_flag(SCHED_LOAD_BALANCE_INTERFACE, @_); } sub memory_spread_slab { shift->cgroup->_flag(MEM_SPREAD_SLAB_INTERFACE, @_) } sub memory_spread_page { shift->cgroup->_flag(MEM_SPREAD_PAGE_INTERFACE, @_) } sub get_memory_pressure { shift->cgroup->_list(MEM_PRESSURE_INTERFACE) } sub mem_hardwall { shift->cgroup->_flag(MEM_HARDWALL_INTERFACE, @_) } sub mem_exclusive { shift->cgroup->_flag(MEM_EXCLUSIVE_INTERFACE, @_) } sub cpu_exclusive { shift->cgroup->_flag(CPU_EXCLUSIVE_INTERFACE, @_) } sub memory_migrate { shift->cgroup->_flag(MEMORY_MIGRATE_INTERFACE, @_) } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset - CGroups v1 Cpuset Controller =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v1; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new( name => "test" ); $cgroup->cpuset->current; =head1 DESCRIPTION This module uses features that are only available on Linux, and requires cgroups and capability for unshare syscalls to achieve pid isolation. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut Devices.pm100644001750000144 235614502070636 31416 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1package Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Devices; use Mojo::Base -base; use constant { DEVICES_ALLOW_INTERFACE => 'devices.allow', DEVICES_DENY_INTERFACE => 'devices.deny' }; has cgroup => sub { Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new }; sub allow { shift->cgroup->_write(DEVICES_ALLOW_INTERFACE, @_) } sub deny { shift->cgroup->_write(DEVICES_DENY_INTERFACE, @_) } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Devices - CGroups v1 Devices Controller. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v1; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new( name => "test" ); $cgroup->devices->allow('a *:* rwm'); =head1 DESCRIPTION This module uses features that are only available on Linux, and requires cgroups and capability for unshare syscalls to achieve pid isolation. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut Freezer.pm100644001750000144 260314502070636 31431 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1package Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Freezer; use Mojo::Base -base; use constant { STATE_INTERFACE => 'freezer.state', SELF_FREEZING_INTERFACE => 'freezer.self_freezing', PARENT_FREEZING_INTERFACE => 'freezer.parent_freezing', }; has cgroup => sub { Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new }; sub state { shift->cgroup->_setget(STATE_INTERFACE, @_) } sub self_freezing { shift->cgroup->_list(SELF_FREEZING_INTERFACE) } sub parent_freezing { shift->cgroup->_list(PARENT_FREEZING_INTERFACE) } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Freezer - CGroups v1 Freezer Controller. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v1; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new( name => "test" ); $cgroup->freezer->state('FROZEN'); =head1 DESCRIPTION This module uses features that are only available on Linux, and requires cgroups and capability for unshare syscalls to achieve pid isolation. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut Memory.pm100644001750000144 1200414502070636 31313 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1package Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory; use Mojo::Base -base; use constant { # show various statistics STAT_INTERFACE => 'memory.stat', # show current usage for memory CURRENT_INTERFACE => 'memory.usage_in_bytes', # show current usage for memory+Swap CURRENT_AND_SWAP_INTERFACE => 'memory.memsw.usage_in_bytes', # set/show limit of memory usage LIMIT_INTERFACE => 'memory.limit_in_bytes', # show current usage for memory LIMIT_AND_SWAP_INTERFACE => 'memory.memsw.limit_in_bytes', # show the number of memory usage hits limits FAILCNT_INTERFACE => 'memory.failcnt', # show max memory usage recorded MAX_RECORDED_INTERFACE => 'memory.max_usage_in_bytes', # show max memory+Swap usage recorded MAX_RECORDED_AND_SWAP_INTERFACE => 'memory.memsw.max_usage_in_bytes', # set/show soft limit of memory usage SOFT_LIMIT_INTERFACE => 'memory.soft_limit_in_bytes', # set/show hierarchical account enabled USE_HIERARCHY_INTERFACE => 'memory.use_hierarchy', # trigger forced move charge to parent FORCE_EMPTY_INTERFACE => 'memory.force_empty', # set memory pressure notifications PRESSURE_LEVEL_INTERFACE => 'memory.pressure_level', # set/show swappiness parameter of vmscan (See sysctl's vm.swappiness) SWAPPINESS_INTERFACE => 'memory.swappiness', # set/show controls of moving charges MOVE_CHARGE_AT_IMMIGRATE_INTERFACE => 'memory.move_charge_at_immigrate', # set/show oom controls. OOM_CONTROL_INTERFACE => 'memory.oom_control', # show the number of memory usage per numa node NUMA_STAT_INTERFACE => 'memory.numa_stat', # set/show hard limit for kernel memory KMEM_LIMIT_INTERFACE => 'memory.kmem.limit_in_bytes', # show current kernel memory allocation KMEM_USAGE_INTERFACE => 'memory.kmem.usage_in_bytes', # show the number of kernel memory usage hits limits KMEM_FAILCNT_INTERFACE => 'memory.kmem.failcnt', # show max kernel memory usage recorded KMEM_MAX_RECORDED_INTERFACE => 'memory.kmem.max_usage_in_bytes', # set/show hard limit for tcp buf memory KMEM_TCP_LIMIT_INTERFACE => 'memory.kmem.tcp.limit_in_bytes', # show current tcp buf memory allocation KMEM_TCP_USAGE_INTERFACE => 'memory.kmem.tcp.usage_in_bytes', # show the number of tcp buf memory usage hits limits KMEM_TCP_FAILCNT_INTERFACE => 'memory.kmem.tcp.failcnt', # show max tcp buf memory usage recorded KMEM_TCP_MAX_USAGE_INTERFACE => 'memory.kmem.tcp.max_usage_in_bytes', }; has cgroup => sub { Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new }; sub current { shift->cgroup->_list(CURRENT_INTERFACE) } sub stat { shift->cgroup->_list(STAT_INTERFACE) } sub swap_current { shift->cgroup->_list(CURRENT_AND_SWAP_INTERFACE) } sub limit { shift->cgroup->_setget(LIMIT_INTERFACE, @_) } sub failcnt { shift->cgroup->_list(FAILCNT_INTERFACE) } sub observed_max_usage { shift->cgroup->_list(MAX_RECORDED_INTERFACE) } sub observed_swap_max_usage { shift->cgroup->_list(MAX_RECORDED_AND_SWAP_INTERFACE); } sub use_hierarchy { shift->cgroup->_setget(USE_HIERARCHY_INTERFACE, @_) } sub soft_limit { shift->cgroup->_setget(SOFT_LIMIT_INTERFACE, @_) } sub force_empty { shift->cgroup->_setget(FORCE_EMPTY_INTERFACE, @_) } sub pressure_level { shift->cgroup->_setget(PRESSURE_LEVEL_INTERFACE, @_) } sub swappiness { shift->cgroup->_setget(SWAPPINESS_INTERFACE, @_) } sub move_charge { shift->cgroup->_setget(MOVE_CHARGE_AT_IMMIGRATE_INTERFACE, @_); } sub oom_control { shift->cgroup->_setget(OOM_CONTROL_INTERFACE, @_) } sub numa_stat { shift->cgroup->_list(NUMA_STAT_INTERFACE) } sub kmem_limit { shift->cgroup->_setget(KMEM_LIMIT_INTERFACE, @_) } sub kmem_usage { shift->cgroup->_list(KMEM_USAGE_INTERFACE) } sub kmem_failcnt { shift->cgroup->_list(KMEM_FAILCNT_INTERFACE) } sub kmem_max_usage { shift->cgroup->_list(KMEM_MAX_RECORDED_INTERFACE) } sub kmem_tcp_limit { shift->cgroup->_setget(KMEM_TCP_LIMIT_INTERFACE, @_) } sub kmem_tcp_usage { shift->cgroup->_list(KMEM_TCP_USAGE_INTERFACE) } sub kmem_tcp_failcnt { shift->cgroup->_list(KMEM_TCP_FAILCNT_INTERFACE) } sub kmem_tcp_max_usage { shift->cgroup->_list(KMEM_TCP_MAX_USAGE_INTERFACE) } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory - CGroups v1 Memory Controller =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v1; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new( name => "test" ); $cgroup->memory->current; =head1 DESCRIPTION This module uses features that are only available on Linux, and requires cgroups and capability for unshare syscalls to achieve pid isolation. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut Netcls.pm100644001750000144 214314502070636 31256 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1package Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Netcls; use Mojo::Base -base; use constant CLASSID_INTERFACE => 'net_cls.classid'; has cgroup => sub { Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new }; sub classid { shift->cgroup->_setget(CLASSID_INTERFACE, @_) } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Netcls - CGroups v1 Netcls Controller. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v1; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new( name => "test" ); $cgroup->netcls->current; =head1 DESCRIPTION This module uses features that are only available on Linux, and requires cgroups and capability for unshare syscalls to achieve pid isolation. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut Netprio.pm100644001750000144 234014502070636 31445 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1package Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Netprio; use Mojo::Base -base; use constant { PRIOIDX_INTERFACE => 'net_prio.prioidx', IFPRIOMAP_INTERFACE => 'net_prio.ifpriomap', }; has cgroup => sub { Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new }; sub ifpriomap { shift->cgroup->_setget(IFPRIOMAP_INTERFACE, @_) } sub prioidx { shift->cgroup->_list(PRIOIDX_INTERFACE) } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Netprio - CGroups v1 Netprio Controller. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v1; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new( name => "test" ); $cgroup->netprio->prioidx; =head1 DESCRIPTION This module uses features that are only available on Linux, and requires cgroups and capability for unshare syscalls to achieve pid isolation. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut PID.pm100644001750000144 225414502070636 30445 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1package Mojo::IOLoop::ReadWriteProcess::CGroup::v1::PID; use Mojo::Base -base; use constant {CURRENT_INTERFACE => 'pids.current', MAX_INTERFACE => 'pids.max'}; has cgroup => sub { Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new }; sub current { shift->cgroup->_list(CURRENT_INTERFACE) } sub max { shift->cgroup->_setget(MAX_INTERFACE, @_) } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v1::PID - CGroups v1 PID Controller. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v1; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new( name => "test" ); $cgroup->pid->current; =head1 DESCRIPTION This module uses features that are only available on Linux, and requires cgroups and capability for unshare syscalls to achieve pid isolation. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut RDMA.pm100644001750000144 201314502070636 30545 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1package Mojo::IOLoop::ReadWriteProcess::CGroup::v1::RDMA; use Mojo::Base 'Mojo::IOLoop::ReadWriteProcess::CGroup::v2::RDMA'; has cgroup => sub { Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new }; 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v2::RDMA - CGroups v2 RDMA Controller =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v2; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new( name => "test" ); $cgroup->rdma->current; =head1 DESCRIPTION This module uses features that are only available on Linux, and requires cgroups and capability for unshare syscalls to achieve pid isolation. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut v2.pm100644001750000144 762314502070636 30037 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGrouppackage Mojo::IOLoop::ReadWriteProcess::CGroup::v2; # Refer to https://www.kernel.org/doc/Documentation/cgroup-v2.txt for details use Mojo::Base 'Mojo::IOLoop::ReadWriteProcess::CGroup'; use Mojo::File 'path'; use Mojo::Collection 'c'; our @EXPORT_OK = qw(cgroup); use Exporter 'import'; use constant { PROCS_INTERFACE => 'cgroup.procs', TYPE_INTERFACE => 'cgroup.type', THREADS_INTERFACE => 'cgroup.threads', EVENTS_INTERFACE => 'cgroup.events', CONTROLLERS_INTERFACE => 'cgroup.controllers', SUBTREE_CONTROL_INTERFACE => 'cgroup.subtree_control', MAX_DESCENDANT_INTERFACE => 'cgroup.max.descendants', MAX_DEPTH_INTERFACE => 'cgroup.max.depth', STAT_INTERFACE => 'cgroup.stat', }; use Scalar::Util (); use Mojo::IOLoop::ReadWriteProcess::CGroup::v2::IO; use Mojo::IOLoop::ReadWriteProcess::CGroup::v2::CPU; use Mojo::IOLoop::ReadWriteProcess::CGroup::v2::Memory; use Mojo::IOLoop::ReadWriteProcess::CGroup::v2::PID; use Mojo::IOLoop::ReadWriteProcess::CGroup::v2::RDMA; has io => sub { my $io = Mojo::IOLoop::ReadWriteProcess::CGroup::v2::IO->new(cgroup => shift); Scalar::Util::weaken $io->{cgroup}; return $io; }; has cpu => sub { my $cpu = Mojo::IOLoop::ReadWriteProcess::CGroup::v2::CPU->new(cgroup => shift); Scalar::Util::weaken $cpu->{cgroup}; return $cpu; }; has memory => sub { my $memory = Mojo::IOLoop::ReadWriteProcess::CGroup::v2::Memory->new(cgroup => shift); Scalar::Util::weaken $memory->{cgroup}; return $memory; }; has pid => sub { my $pid = Mojo::IOLoop::ReadWriteProcess::CGroup::v2::PID->new(cgroup => shift); Scalar::Util::weaken $pid->{cgroup}; return $pid; }; has rdma => sub { my $rdma = Mojo::IOLoop::ReadWriteProcess::CGroup::v2::RDMA->new(cgroup => shift); Scalar::Util::weaken $rdma->{cgroup}; return $rdma; }; # CGroups process interface sub add_process { shift->_appendln(+PROCS_INTERFACE() => pop) } sub process_list { shift->_list(PROCS_INTERFACE) } sub processes { c(shift->_listarray(PROCS_INTERFACE)) } sub contains_process { shift->_contains(+PROCS_INTERFACE() => pop) } # CGroups thread interface sub add_thread { shift->_appendln(+THREADS_INTERFACE() => pop) } sub thread_list { shift->_list(THREADS_INTERFACE) } sub contains_thread { shift->_contains(+THREADS_INTERFACE() => pop) } # CGroups event interface sub populated { shift->_list(EVENTS_INTERFACE) } # CGroups type interface sub type { shift->_setget(+TYPE_INTERFACE() => pop) } # CGroups controllers Interface sub controllers { shift->_setget(+CONTROLLERS_INTERFACE() => pop) } # CGroups subtree_control Interface sub subtree_control { shift->_setget(+SUBTREE_CONTROL_INTERFACE() => pop) } # CGroups max.descendants Interface sub max_descendants { shift->_setget(+MAX_DESCENDANT_INTERFACE() => pop) } # CGroups max.depth Interface sub max_depths { shift->_setget(+MAX_DEPTH_INTERFACE() => pop) } # CGroups stat Interface sub stat { shift->_list(+STAT_INTERFACE()) } *IO = \&io; *CPU = \&cpu; *MEMORY = \&memory; *PID = \&pid; *RDMA = \&rdma; 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v2 - CGroups v2 implementation. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v2; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new( name => "test" ); $cgroup->create; $cgroup->exists; my $child = $cgroup->child('bar'); =head1 DESCRIPTION This module uses features that are only available on Linux, and requires cgroups and capability for unshare syscalls to achieve pid isolation. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut CPU.pm100644001750000144 252314502070636 30460 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2package Mojo::IOLoop::ReadWriteProcess::CGroup::v2::CPU; use Mojo::Base -base; use constant { STAT_INTERFACE => 'cpu.stat', WEIGHT_INTERFACE => 'cpu.weight', WEIGHT_NICE_INTERFACE => 'cpu.weight.nice', MAX_INTERFACE => 'cpu.max', }; has cgroup => sub { Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new }; sub stat { shift->cgroup->_list(STAT_INTERFACE) } sub weight { shift->cgroup->_setget(WEIGHT_INTERFACE, @_) } sub weight_nice { shift->cgroup->_setget(WEIGHT_NICE_INTERFACE, @_) } sub max { shift->cgroup->_setget(MAX_INTERFACE, @_) } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v2::CPU - CGroups v2 CPU Controller =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v2; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new( name => "test" ); $cgroup->cpu->stat; =head1 DESCRIPTION This module uses features that are only available on Linux kernels. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut IO.pm100644001750000144 225714502070636 30344 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2package Mojo::IOLoop::ReadWriteProcess::CGroup::v2::IO; use Mojo::Base -base; use constant { STAT_INTERFACE => 'io.stat', WEIGHT_INTERFACE => 'io.weight', MAX_INTERFACE => 'io.max', }; has cgroup => sub { Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new }; sub stat { shift->cgroup->_list(STAT_INTERFACE) } sub weight { shift->cgroup->_setget(WEIGHT_INTERFACE, @_) } sub max { shift->cgroup->_setget(MAX_INTERFACE, @_) } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v2::IO - CGroups v2 IO Controller =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v2; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new( name => "test" ); $cgroup->io->stat; =head1 DESCRIPTION This module uses features that are only available on Linux kernels. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut Memory.pm100644001750000144 344314502070636 31303 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2package Mojo::IOLoop::ReadWriteProcess::CGroup::v2::Memory; use Mojo::Base -base; use constant { CURRENT_INTERFACE => 'memory.current', LOW_INTERFACE => 'memory.low', HIGH_INTERFACE => 'memory.high', MAX_INTERFACE => 'memory.max', EVENTS_INTERFACE => 'memory.events', STAT_INTERFACE => 'memory.stat', SWAP_CURRENT_INTERFACE => 'memory.swap.current', SWAP_MAX_INTERFACE => 'memory.swap.max', }; has cgroup => sub { Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new }; sub current { shift->cgroup->_list(CURRENT_INTERFACE) } sub swap_current { shift->cgroup->_list(SWAP_CURRENT_INTERFACE) } sub low { shift->cgroup->_setget(LOW_INTERFACE, @_) } sub high { shift->cgroup->_setget(HIGH_INTERFACE, @_) } sub max { shift->cgroup->_setget(MAX_INTERFACE, @_) } sub swap_max { shift->cgroup->_setget(SWAP_MAX_INTERFACE, @_) } sub events { shift->cgroup->_list(EVENTS_INTERFACE) } sub stat { shift->cgroup->_list(STAT_INTERFACE) } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v2::Memory - CGroups v2 Memory Controller =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v2; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new( name => "test" ); $cgroup->memory->current; =head1 DESCRIPTION This module uses features that are only available on Linux kernels. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut PID.pm100644001750000144 213014502070636 30437 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2package Mojo::IOLoop::ReadWriteProcess::CGroup::v2::PID; use Mojo::Base -base; use constant {CURRENT_INTERFACE => 'pid.current', MAX_INTERFACE => 'pid.max',}; has cgroup => sub { Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new }; sub current { shift->cgroup->_list(CURRENT_INTERFACE) } sub max { shift->cgroup->_setget(MAX_INTERFACE, @_) } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v2::PID - CGroups v2 PID Controller =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v2; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new( name => "test" ); $cgroup->pid->current; =head1 DESCRIPTION This module uses features that are only available on Linux kernels. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut RDMA.pm100644001750000144 213114502070636 30547 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2package Mojo::IOLoop::ReadWriteProcess::CGroup::v2::RDMA; use Mojo::Base -base; use constant {CURRENT_INTERFACE => 'rdma.current', MAX_INTERFACE => 'rdma.max', }; has cgroup => sub { Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new }; sub current { shift->cgroup->_list(CURRENT_INTERFACE) } sub max { shift->cgroup->_setget(MAX_INTERFACE, @_) } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::CGroup::v2::RDMA - CGroups v2 RDMA Controller =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::CGroup::v2; my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new( name => "test" ); $cgroup->rdma->current; =head1 DESCRIPTION This module uses features that are only available on Linux kernels. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut Container.pm100644001750000144 3620614502070636 30252 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcesspackage Mojo::IOLoop::ReadWriteProcess::Container; use Mojo::Base 'Mojo::EventEmitter'; use Mojo::IOLoop::ReadWriteProcess::CGroup; use Mojo::IOLoop::ReadWriteProcess; use Mojo::IOLoop::ReadWriteProcess::Namespace qw( CLONE_NEWPID CLONE_NEWNS ); use Mojo::IOLoop::ReadWriteProcess; use Mojo::IOLoop::ReadWriteProcess::Session; use Mojo::Collection 'c'; use Scalar::Util 'blessed'; our @EXPORT_OK = qw(container); use Exporter 'import'; use Carp 'croak'; has 'name'; has 'group'; # Roughly a container has process => sub { Mojo::IOLoop::ReadWriteProcess->new }; has cgroups => sub { c(Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new(controller => 'pids')); }; has namespace => sub { Mojo::IOLoop::ReadWriteProcess::Namespace->new }; has session => sub { Mojo::IOLoop::ReadWriteProcess::Session->singleton }; has pid_isolation => sub { 0 }; has unshare => undef; has subreaper => 0; has pre_migrate => 0; has clean_cgroup => 0; use constant DEBUG => $ENV{MOJO_PROCESS_DEBUG}; sub container { __PACKAGE__->new(@_) } sub new { my $self = shift->SUPER::new(@_); $self->cgroups(c($self->cgroups)) unless blessed $self->cgroups && $self->cgroups->isa('Mojo::Collection'); $self; } sub migrate_process { my $p = pop(); shift->cgroups->each(sub { shift->add_process($p) }); } sub start { my $self = shift; croak 'You need either to pass a Mojo::IOLoop::ReadWriteProcess object or a callback' unless (blessed $self->process && $self->process->isa("Mojo::IOLoop::ReadWriteProcess")) || ref $self->process eq 'CODE'; $self->process(Mojo::IOLoop::ReadWriteProcess->new($self->process)) unless blessed $self->process; $self->cgroups->map( sub { return $_ if $_->name || $_->parent; $_ = $_->name($self->group)->create if $self->group; $_ = $_->child($self->name)->create if $self->name; }) if defined $self->group || defined $self->name; $self->process->subreaper(1) if $self->subreaper; $self->unshare(CLONE_NEWPID | CLONE_NEWNS) if $self->pid_isolation; $self->process->once( start => sub { $self->migrate_process($self->process->pid); }) unless $self->pre_migrate; $self->process->once( stop => sub { $self->cgroups->each( sub { $_[0]->processes->each( sub { my $pid = shift; my $p = Mojo::IOLoop::ReadWriteProcess->new( process_id => $pid, blocking_stop => 1 ); $self->session->register($pid => $p); $p->stop(); }); $_[0]->remove() if $self->clean_cgroup; }); }); $self->process->once(stop => sub { shift; $self->emit(stop => @_) }); $self->process->once(start => sub { shift; $self->emit(start => @_) }); my $fn = $self->process->code(); $self->process->code(sub { $self->migrate_process($$); $fn->(@_) }) if $self->pre_migrate; $self->process->code( sub { $self->migrate_process($$) if $self->pre_migrate; if ( $self->unshare & CLONE_NEWPID && $self->namespace->unshare($self->unshare) == 0) { # In such case, we have to spawn another process my $init = Mojo::IOLoop::ReadWriteProcess->new( set_pipes => 0, internal_pipes => 1, code => sub { $_[0]->enable_subreaper if $self->subreaper; $self->namespace->isolate() if $self->unshare & CLONE_NEWNS; $fn->(@_); }); $init->start()->wait_stop; #return $init->return_status if defined $init->return_status; $init->_exit($init->exit_status); } elsif ($self->namespace->unshare($self->unshare) != 0) { warn "Unshare failed"; } $fn->(@_); }) if defined $self->unshare; if (DEBUG) { $self->process->diag("Starting container"); $self->process->diag("\tName: " . $self->name) if defined $self->name; $self->process->diag("\tGroup: " . $self->group) if defined $self->group; $self->cgroups->each(sub { $self->process->diag("CGroup: " . $_->_cgroup) } ); } local ($@, $!); eval { $self->process->start(); }; $self->emit(container_error => [$@, $!]) if $@; $self; } sub stop { shift->emit('stop')->process->stop() } sub is_running { shift->process->is_running } sub wait_stop { shift->process->wait_stop } sub wait { shift->process->wait } =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::Container - (kinda) Pure Perl containers. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); my $container = container( pid_isolation => 1, # Best-effort, as depends on where you run it (you need CAP_SYS_ADMIN) subreaper => 1, group => "my_org", name => "my_process", process => process( sub { # Exec, fork .. process(sub { warn "\o/"; sleep 42; })->start; process(sub { warn "\o/"; sleep 42; })->start; process( sub { process( sub { process(sub { warn "\o/"; sleep 42; })->start; warn "\o/"; sleep 400; warn "\o/"; })->start; warn "Hey"; sleep 42; warn "\o/"; })->start; sleep 42; } )->separate_err(0)); $container->start(); $container->is_running; $container->stop; my @procs = $container->cgroups->first->processes; $container->cgroups->first->pid->max(300); $container->process->on(stop => sub { print "Main container process stopped!" }); =head1 DESCRIPTION L ties anonymous functions or a L object to different sets of L implementations. When the C attribute is set, it needs special permissions (CAP_SYS_ADMIN capabilities). This module uses features that are only available on Linux, and requires cgroups and capability (CAP_SYS_ADMIN) for unshare syscalls to achieve pid isolation. =head1 EVENTS L inherits all events from L and can emit the following new ones. =head2 start $container->on(start => sub { my ($process) = @_; ... }); Emitted when the container starts. =head2 stop $container->on(stop => sub { my ($container) = @_; ... }); Emitted when the container stops. =head2 process_error $container->on(container_error => sub { my ($e) = @_; my @errors = @{$e}; }); Emitted when the container produce errors. =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 start use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); my $c = container( name=>"test", process => sub { print "Hello!" }); $c->start(); Starts the container, it's main process is a L, contained in the C attribute. On stop it will terminate every process included in the L attribute. =head2 is_running use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); my $c = container( name=>"test", process => sub { print "Hello!" }); $c->is_running(); Returns 1 if the container is running. =head2 stop use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); my $c = container( name=>"test", process => sub { print "Hello!" })->start; $c->stop(); Stops the container and kill all the processes belonging to the cgroup. It also registers all the unknown processes to the current L. =head2 wait_stop use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); my $c = container( name=>"test", process => sub { print "Hello!" })->start; $c->wait_stop(); Wait before stopping the container. =head2 wait use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); my $c = container( name=>"test", process => sub { print "Hello!" })->start; $c->wait(); Wait the container to stop =head2 migrate_process use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); my $c = container( name=>"test", process => sub { print "Hello!" })->start; $c->migrate_process(42); Migrate the given process to the container cgroup. =head1 ATTRIBUTES L inherits all attributes from L and implements the following new ones. =head2 name use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); use Mojo::IOLoop::ReadWriteProcess::CGroup qw(cgroupv1); use Mojo::Collection 'c'; my $container = container( name => "test", process => sub { print "Hello!" } ); $container->session->on(register => sub { ... }); $container->start(); Sets the container name. It creates in the indicated (or default) cgroups a sub-tree with the container name. This means that cgroups settings can be done also outside of the container object: use Mojo::IOLoop::ReadWriteProcess::CGroup qw(cgroupv1); use Mojo::IOLoop::ReadWriteProcess::Container qw(container); my $container = container( name => "test", process => sub { print "Hello!" } ); cgroupv1->from($continer->cgroups->first->_group)->pid->max(100); As cgroups are represented by path, you can set options directly from controllers objects that are pointing to the same cgroup slice. =head2 group use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); use Mojo::IOLoop::ReadWriteProcess::CGroup qw(cgroupv2); use Mojo::Collection 'c'; my $container = container( name => "bar", group => "foo", process => sub { print "Hello!" } ); my $container2 = container( name => "bar2", group => "foo", process => sub { print "Hello!" } ); $container->start(); $container2->start(); my $group_cgroup = cgroupv2->from($container2->cgroups->first->parent); $group_cgroup->pid->max(200); Sets the container group. If containers are sharing the same group they will inherit the same CGroup parent path, in such way it is possible to create controllers pointing to it and set specific options for the whole group. =head2 pid_isolation use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); use Mojo::IOLoop::ReadWriteProcess::CGroup qw(cgroupv1); use Mojo::Collection 'c'; my $container = container( pid_isolation => 1, process => sub { print "Hello!" } ); $container->session->on(register => sub { ... }); $container->start(); If set, the process will see itself as PID 1. It needs CAP_SYS_ADMIN capabilities set on the executable (or run as root). =head2 pre_migrate use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); my $container = container( pre_migrate => 1, process => sub { print "Hello!" } ); $container->session->on(register => sub { ... }); $container->start(); If set, the process will migrate itself into the cgroup. =head2 clean_cgroup use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); my $container = container( clean_cgroup => 1, process => sub { print "Hello!" }); $container->session->on(register => sub { ... }); $container->start(); If set, attempts to destroy the cgroup after the process terminated its execution. =head2 subreaper use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); my $c = container(subreaper => 1, name=>"test", process => sub { print "Hello!" }); $c->start(); Enable subreaper mode inside the child process. =head2 process use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); my $c = container(process => sub { print "Hello!" }); my $c = container(process => sub { print "Hello!" }); $c->start(); The process to run. It can be an anonymous function or a L object. =head2 namespace use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); my $c = container(process => sub { print "Hello!" }); $c->namespace->unshare(0); # All $c->start(); Set/Return L object. It's main use is to invoke syscalls. =head2 session use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); my $c = container(process => process(sub { print "Hello!" })); $c->session->on(register => sub { ... }); $c->start(); Returns/Set the L singleton object. =head2 unshare use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); use Mojo::IOLoop::ReadWriteProcess::Namespace qw( CLONE_NEWPID CLONE_NEWNS ); my $c = container( unshare=> CLONE_NEWPID | CLONE_NEWNS, process => sub { print "Hello!" } ); $c->session->on(register => sub { ... }); $c->start(); Returns/Set the unshare syscall options. See man unshare(2) for further documentation. =head2 cgroups use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); use Mojo::IOLoop::ReadWriteProcess::CGroup qw(cgroupv1); use Mojo::Collection 'c'; my $container = container(process => sub { print "Hello!" }); $container->cgroups( c(cgroupv1(controller => 'pids'), cgroupv1(controller => 'memory')) ); $container->session->on(register => sub { ... }); $container->start(); Returns/Set a L collection of CGroups where the process should belong to. If used with a single CGroup, you don't need to pass the L object: use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::IOLoop::ReadWriteProcess qw(process); use Mojo::IOLoop::ReadWriteProcess::CGroup qw(cgroupv1); use Mojo::Collection 'c'; my $container = container(cgroups=> cgroupv1(controller => 'pids'), process => sub { print "Hello!" }); $container->session->on(register => sub { ... }); $container->start(); =head1 DEBUGGING You can set the MOJO_EVENTEMITTER_DEBUG environment variable to get some advanced diagnostics information printed to STDERR. MOJO_EVENTEMITTER_DEBUG=1 Also, you can set MOJO_PROCESS_DEBUG environment variable to get diagnostics about the process execution. MOJO_PROCESS_DEBUG=1 =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut 1; Exception.pm100644001750000144 212514502070636 30237 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcesspackage Mojo::IOLoop::ReadWriteProcess::Exception; use Mojo::Base -base; sub new { my $class = shift; my $value = @_ == 1 ? $_[0] : ""; return bless \$value, ref $class || $class; } sub to_string { "${$_[0]}" } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::Exception - Exception object for Mojo::IOLoop::ReadWriteProcess. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::Exception; my $e = Mojo::IOLoop::ReadWriteProcess::Exception->new("Errored!"); print "Error $e"; my $string_error = $e->to_string; =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 to_string my $e = Mojo::IOLoop::ReadWriteProcess::Exception->new("Errored!"); my $string_error = $e->to_string; Returns stringified version of the error message. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut Namespace.pm100644001750000144 1172114502070636 30217 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcesspackage Mojo::IOLoop::ReadWriteProcess::Namespace; use Mojo::Base -base; use Mojo::File 'path'; use Carp 'confess'; use Config; use constant { CLONE_ALL => 0, CLONE_NEWNS => 0x00020000, CLONE_NEWIPC => 0x08000000, CLONE_NEWNET => 0x40000000, CLONE_NEWUTS => 0x04000000, CLONE_NEWPID => 0x20000000, CLONE_NEWUSER => 0x10000000, CLONE_NEWCGROUP => 0x02000000, MS_REC => 0x4000, MS_PRIVATE => 1 << 18, MS_NOSUID => 2, MS_NOEXEC => 8, MS_NODEV => 4, }; our @EXPORT_OK = ( qw(CLONE_ALL CLONE_NEWNS CLONE_NEWIPC CLONE_NEWUTS), qw(CLONE_NEWNET CLONE_NEWPID CLONE_NEWUSER CLONE_NEWCGROUP), qw(MS_REC MS_PRIVATE MS_NOSUID MS_NOEXEC MS_NODEV) ); use Exporter 'import'; sub _get_unshare_syscall { confess "Only Linux is supported" unless $^O eq 'linux'; my $machine = (POSIX::uname())[4]; die "Could not get machine type" unless $machine; # if we're running on an x86_64 kernel, but a 32-bit process, # we need to use the i386 syscall numbers. $machine = "i386" if ($machine eq "x86_64" && $Config{ptrsize} == 4); my $prctl_call = $machine =~ /^i[3456]86|^blackfin|cris|frv|h8300|m32r|m68k|microblaze|mn10300|sh|parisc$/ ? 310 : $machine eq "s390" ? 303 : $machine eq "x86_64" ? 272 : $machine eq "ppc" ? 282 : $machine eq "ia64" ? 1296 : undef; unless (defined $prctl_call) { delete @INC{ qw }; my $rv = eval { require 'syscall.ph'; 1 } ## no critic or eval { require 'sys/syscall.ph'; 1 }; ## no critic $prctl_call = eval { &SYS_unshare; }; } return $prctl_call; } sub _get_mount_syscall { confess "Only Linux is supported" unless $^O eq 'linux'; my $machine = (POSIX::uname())[4]; die "Could not get machine type" unless $machine; # if we're running on an x86_64 kernel, but a 32-bit process, # we need to use the i386 syscall numbers. $machine = "i386" if ($machine eq "x86_64" && $Config{ptrsize} == 4); my $prctl_call; # $machine # =~ /^i[3456]86|^blackfin|cris|frv|h8300|m32r|m68k|microblaze|mn10300|sh|parisc$/ # ? 310 # : $machine eq "s390" ? 303 # # : $machine eq "x86_64" ? 272 # : $machine eq "ppc" ? 282 # : $machine eq "ia64" ? 1296 # : unless (defined $prctl_call) { delete @INC{ qw }; my $rv = eval { require 'syscall.ph'; 1 } ## no critic or eval { require 'sys/syscall.ph'; 1 }; ## no critic $prctl_call = eval { &SYS_mount; }; } return $prctl_call; } sub mount { my ($self, $arg1, $arg2, $arg3, $opts) = (@_); $arg3 //= 0; local $!; my $ret = syscall(_get_mount_syscall(), my $s = $arg1, my $t = $arg2, $arg3, $opts, 0); warn "mount is unavailable on this platform." if $!{EINVAL}; warn "Mount failed! $!" if $!; return $ret; } sub unshare { my ($self, $opts) = @_; local $!; my $ret = syscall(_get_unshare_syscall(), $opts, 0, 0); warn "unshare is unavailable on this platform." if $!{EINVAL}; warn "Unshare failed! $!" if $!; return $ret; } sub isolate { my ($self, $procdir) = shift; $procdir //= "/proc"; $self->mount("none", "/", 0, MS_REC | MS_PRIVATE); warn "Failed isolating proc" if $self->mount("none", $procdir, 0, MS_REC | MS_PRIVATE) != 0 || $self->mount("proc", $procdir, "proc", MS_NOSUID | MS_NOEXEC | MS_NODEV) != 0; } =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::Namespace - Namespace object for Mojo::IOLoop::ReadWriteProcess. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::Namespace qw(CLONE_ALL); my $ns = Mojo::IOLoop::ReadWriteProcess::Namespace->new(); $ns->unshare(CLONE_ALL); $ns->mount("proc", "/proc", "proc"); $ns->isolate(); =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 unshare use Mojo::IOLoop::ReadWriteProcess::Namespace qw(CLONE_ALL); my $ns = Mojo::IOLoop::ReadWriteProcess::Namespace->new(); $ns->unshare(CLONE_ALL); Wrapper around the unshare syscall, accepts the same arguments, constants can be exported from L. =head2 mount my $ns = Mojo::IOLoop::ReadWriteProcess::Namespace->new(); $ns->mount("proc", "/proc", "proc"); Wrapper around the mount syscall, accepts the same arguments. =head2 isolate my $ns = Mojo::IOLoop::ReadWriteProcess::Namespace->new(); $ns->isolate(); Mount appropriately /proc to achieve process isolation during process containment, see L. =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut 1; Pool.pm100644001750000144 616214502070636 27217 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcesspackage Mojo::IOLoop::ReadWriteProcess::Pool; use Mojo::Base 'Mojo::Collection'; use constant MAXIMUM_PROCESSES => $ENV{MOJO_PROCESS_MAXIMUM_PROCESSES} // 100; use Scalar::Util qw(blessed); my %max_proc; sub new { my $s = shift->SUPER::new(@_); $max_proc{$s} = MAXIMUM_PROCESSES; $s; } sub get { @{$_[0]}[$_[1]] } sub remove { delete @{$_[0]}[$_[1]] } sub add { return undef unless $_[0]->size < $max_proc{$_[0]}; my $self = shift; push @{$self}, blessed $_[0] ? $_[0] : Mojo::IOLoop::ReadWriteProcess->new(@_); $self->last; } sub maximum_processes { $max_proc{$_[0]} = pop() if $_[1]; $max_proc{$_[0]}; } sub _cmd { my $c = shift; my $f = pop; my @args = @_; my @r; $c->each(sub { push(@r, +shift()->$f(@args)) }); wantarray ? @r : $c; } sub AUTOLOAD { our $AUTOLOAD; my $fn = $AUTOLOAD; $fn =~ s/.*:://; return if $fn eq "DESTROY"; return eval { shift->_cmd(@_, $fn) }; } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::Pool - Pool of Mojo::IOLoop::ReadWriteProcess objects. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess qw(parallel); my $n_proc = 20; my $fired; my $p = parallel sub { print "Hello world\n"; } => $n_proc; # Subscribe to all "stop" events in the pool $p->once(stop => sub { $fired++; }); # Start all processes belonging to the pool $p->start(); # Receive the process output $p->each(sub { my $p = shift; $p->getline(); }); $p->wait_stop; # Get the last one! (it's a Mojo::Collection!) $p->last()->stop(); =head1 METHODS L inherits all methods from L and implements the following new ones. Note: It proxies all the other methods of L for the whole process group. =head2 get use Mojo::IOLoop::ReadWriteProcess qw(parallel); my $pool = parallel(sub { print "Hello" } => 5); $pool->get(4); Get the element specified in the pool (starting from 0). =head2 add use Mojo::IOLoop::ReadWriteProcess qw(pool); my $pool = pool(maximum_processes => 2); $pool->add(sub { print "Hello 2! " }); Add the element specified in the pool. =head2 remove use Mojo::IOLoop::ReadWriteProcess qw(parallel); my $pool = parallel(sub { print "Hello" } => 5); $pool->remove(4); Remove the element specified in the pool. =head2 maximum_processes use Mojo::IOLoop::ReadWriteProcess qw(parallel); my $pool = parallel(sub { print "Hello" } => 5); $pool->maximum_processes(30); $pool->add(...); Prevent from adding processes to the pool. If we reach C number of processes, C will refuse to add more to the pool. =head1 ENVIRONMENT You can set the MOJO_PROCESS_MAXIMUM_PROCESSES environment variable to specify the the maximum number of processes allowed in L instances. MOJO_PROCESS_MAXIMUM_PROCESSES=10000 =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut Queue.pm100644001750000144 1056214502070636 27411 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcesspackage Mojo::IOLoop::ReadWriteProcess::Queue; use Mojo::Base -base; use Mojo::IOLoop::ReadWriteProcess::Pool; use Mojo::IOLoop::ReadWriteProcess; use Mojo::IOLoop::ReadWriteProcess::Session; use constant DEBUG => $ENV{MOJO_PROCESS_DEBUG}; has queue => sub { Mojo::IOLoop::ReadWriteProcess::Pool->new() }; has pool => sub { Mojo::IOLoop::ReadWriteProcess::Pool->new() }; has done => sub { Mojo::IOLoop::ReadWriteProcess::Pool->new() }; has session => sub { Mojo::IOLoop::ReadWriteProcess::Session->singleton }; sub _dequeue { my ($self, $process) = @_; $self->pool($self->pool->grep(sub { $process ne $_ })); shift @{$self->queue} if ($self->queue->first && $self->pool->add($self->queue->first)); } sub exhausted { $_[0]->pool->size == 0 && shift->queue->size == 0 } sub consume { my $self = shift; $self->session->enable; $self->done->maximum_processes( $self->queue->maximum_processes + $self->pool->maximum_processes); until ($self->exhausted) { sleep .5; $self->session->consume_collected_info; $self->session->_protect( sub { $self->pool->each( sub { my $p = shift; return unless $p; return if exists $p->{started}; $p->{started}++; $p->once(stop => sub { $self->done->add($p); $self->_dequeue($p) }); $p->start; }); }); } } sub add { my $self = shift; $self->pool->add(@_) // $self->queue->add(@_); } sub AUTOLOAD { our $AUTOLOAD; my $fn = $AUTOLOAD; $fn =~ s/.*:://; return if $fn eq "DESTROY"; my $self = shift; return ( eval { $self->pool->Mojo::IOLoop::ReadWriteProcess::Pool::_cmd(@_, $fn) }, (grep(/once|on|emit/, $fn)) ? eval { $self->queue->Mojo::IOLoop::ReadWriteProcess::Pool::_cmd(@_, $fn) } : ()); } 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::Queue - Queue for Mojo::IOLoop::ReadWriteProcess objects. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess qw(queue process); my $n_proc = 20; my $fired; my $q = queue; $q->pool->maximum_processes(2); # Max 2 processes in parallel $q->queue->maximum_processes(10); # Max queue is 10 $q->add( process sub { return 42 } ) for 1..7; # Subscribe to all "stop" events in the pool $q->once(stop => sub { $fired++; }); # Consume the queue $q->consume(); my $all = $q->done; # All processes, Mojo::Collection of Mojo::IOLoop::ReadWriteProcess # Set your own running pool $q->pool(parallel sub { return 42 } => 5); # Set your own queue $q->queue(parallel sub { return 42 } => 20); $q->consume(); =head1 METHODS L inherits all methods from L and implements the following new ones. Note: It proxies all the other methods of L for the whole process group. =head2 add use Mojo::IOLoop::ReadWriteProcess qw(queue process); my $q = queue(); $q->add(sub { print "Hello 2! " }); $q->add(process sub { print "Hello 2! " }); Add the process to the queue. =head2 consume use Mojo::IOLoop::ReadWriteProcess qw(queue); my $q = queue(); $q->add(sub { print "Hello 2! " }); $q->add(process sub { print "Hello 2! " }); $q->consume; # executes and exhaust the processes Starts the processes and empties the queue. Note: maximum_processes can be set both to the pool (number of process to be run in parallel), and for the queue (that gets exhausted during the C phase). $q->pool->maximum_processes(2); # Max 2 processes in parallel $q->queue->maximum_processes(10); # Max queue is 10 =head2 exhausted use Mojo::IOLoop::ReadWriteProcess qw(queue); my $q = queue(); $q->add(sub { print "Hello 2! " }); $q->add(process sub { print "Hello 2! " }); $q->consume; # executes and exhaust the processes $q->exhausted; # 1 Returns 1 if the queue is exhausted. =head1 ENVIRONMENT You can set the MOJO_PROCESS_MAXIMUM_PROCESSES environment variable to specify the the maximum number of processes allowed in the pool and the queue, that are L instances. MOJO_PROCESS_MAXIMUM_PROCESSES=10000 =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut Session.pm100644001750000144 3523014502070636 27747 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcesspackage Mojo::IOLoop::ReadWriteProcess::Session; use Mojo::Base 'Mojo::EventEmitter'; use Mojo::IOLoop::ReadWriteProcess; use Carp 'confess'; use POSIX qw( :sys_wait_h :signal_h ); use Mojo::Collection 'c'; our @EXPORT_OK = qw(session); use Exporter 'import'; use Config; use constant DEBUG => $ENV{MOJO_PROCESS_DEBUG}; # See https://github.com/torvalds/linux/blob/master/include/uapi/linux/prctl.h use constant PR_SET_CHILD_SUBREAPER => 36; use constant PR_GET_CHILD_SUBREAPER => 37; has subreaper => 0; has collect_status => 1; has orphans => sub { {} }; has process_table => sub { {} }; has collected_info => sub { [] }; has 'handler'; has emit_from_sigchld => 1; my $singleton; sub new { $singleton ||= __PACKAGE__->SUPER::new } sub disable { $singleton->_protect(sub { $SIG{CHLD} = $singleton->handler() }); } sub _protect { shift if $_[0] && $_[0] eq $singleton; my ($sig, $cb) = (@_ > 1 ? pop : SIGCHLD, pop); my ($sigset, $blockset) = (POSIX::SigSet->new, POSIX::SigSet->new($sig)); $singleton->emit(protect => [$cb, $sig]); sigprocmask(SIG_BLOCK, $blockset, $sigset); my $r = $cb->(); sigprocmask(SIG_SETMASK, $sigset); return $r; } sub enable { return if $singleton->handler(); $singleton->handler($SIG{CHLD}); $singleton->_protect( sub { $SIG{CHLD} = sub { local ($!, $?); $singleton->emit('SIG_CHLD'); return unless $singleton->collect_status; while ((my $pid = waitpid(-1, WNOHANG)) > 0) { $singleton->add_collected_info($pid, $?, $!); } $singleton->consume_collected_info() if ($singleton->emit_from_sigchld()); } }); } sub _collect { my ($self, $pid, $status, $errno) = @_; my $p = $singleton->resolve($pid); $p->emit('SIG_CHLD')->emit(collect_status => $pid => $status => $errno) ->emit('collected')->emit('stop'); } sub collect { my ($self, $pid, $status, $errno) = @_; if ($singleton->resolve($pid)) { $singleton->_collect($pid => $status => $errno); $singleton->emit(collected => $singleton->resolve($pid)); } else { $singleton->orphans->{$pid} = Mojo::IOLoop::ReadWriteProcess->new(process_id => $pid) ->_fork_collect_status($pid => $status => $errno); $singleton->emit(collected_orphan => $singleton->orphan($pid)); } return $singleton; } sub consume_collected_info { while (my $i = shift @{$singleton->collected_info}) { $singleton->collect(@$i); } } sub add_collected_info { shift; push @{$singleton->collected_info}, [@_]; } # Use as $pid => Mojo::IOLoop::ReadWriteProcess sub register { my ($process, $pid) = (pop, pop); $singleton->process_table()->{$pid} = \$process; $singleton->emit(register => $process); } sub unregister { delete($singleton->process_table()->{+pop()}) } sub _resolve { my ($el, $w) = (pop, pop); return exists $singleton->{$w}->{$el} ? $w eq 'orphans' ? $singleton->{$w}->{$el} : ${$singleton->{$w}->{$el}} : undef; } sub orphan { _resolve(orphans => pop()) } sub resolve { _resolve(process_table => pop()) } sub clean { $_[0]->resolve($_)->stop() and $_[0]->resolve($_)->DESTROY() for keys %{$_[0]->process_table()}; $_[0]->orphan($_)->stop() and $_[0]->orphan($_)->DESTROY() for keys %{$_[0]->orphans()}; shift->reset(); } sub all { c($singleton->all_processes, $singleton->all_orphans)->flatten } sub all_orphans { c(values %{$singleton->orphans}) } sub all_processes { c(values %{$singleton->process_table})->map(sub { ${$_} }); } sub contains { my $pid = pop; $singleton->all->grep(sub { $_->pid eq $pid })->size == 1; } sub reset { @{+shift} {qw(events orphans process_table collected_info handler emit_from_sigchld)} = ({}, {}, {}, [], undef, 1); } # XXX: This should be replaced by PR_GET_CHILD_SUBREAPER sub disable_subreaper { $singleton->subreaper( $singleton->_prctl(PR_SET_CHILD_SUBREAPER, 0) == 0 ? 0 : 1); } sub enable_subreaper { $singleton->subreaper( $singleton->_prctl(PR_SET_CHILD_SUBREAPER, 1) == 0 ? 1 : 0); } sub _get_prctl_syscall { # Courtesy of Sys::Prctl confess "Only Linux is supported" unless $^O eq 'linux'; my $machine = (POSIX::uname())[4]; die "Could not get machine type" unless $machine; # if we're running on an x86_64 kernel, but a 32-bit process, # we need to use the i386 syscall numbers. $machine = "i386" if ($machine eq "x86_64" && $Config{ptrsize} == 4); my $prctl_call = $machine =~ /^i[3456]86|^blackfin|cris|frv|h8300|m32r|m68k|microblaze|mn10300|sh|s390|parisc$/ ? 172 : $machine eq "x86_64" ? 157 : $machine eq "sparc64" ? 147 : $machine eq "aarch64" ? 167 : ($machine eq "ppc" || $machine eq "ppc64le") ? 171 : $machine eq "ia64" ? 1170 : $machine eq "alpha" ? 348 : $machine eq "avr32" ? 148 : $machine eq "mips" ? 4000 + 192 : $machine eq "mips64" ? 5000 + 153 : $machine eq "xtensa" ? 130 : undef; unless (defined $prctl_call) { delete @INC{ qw }; my $rv = eval { require 'syscall.ph'; 1 } ## no critic or eval { require 'sys/syscall.ph'; 1 }; ## no critic $prctl_call = eval { &SYS_prctl; }; } return $prctl_call; } sub _prctl { my ($self, $option, $arg2, $arg3, $arg4, $arg5) = @_; confess 'prctl not supported in this platform!' unless defined _get_prctl_syscall; local $!; my $ret = syscall( _get_prctl_syscall(), $option, ($arg2 or 0), ($arg3 or 0), ($arg4 or 0), ($arg5 or 0)); warn "prctl($option) is unavailable on this platform." if $!{EINVAL}; warn "Error! $!" if $!; return $ret; } *singleton = \&new; *session = \&new; *protect = \&_protect; 1; =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::Session - Session manager for handling child processes. =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess::Session; use Mojo::IOLoop::ReadWriteProcess qw(process); my $session = process()->session; # or Mojo::IOLoop::ReadWriteProcess::Session->singleton $session->enable; # Modifies your SIG_CHLD $session->on(collected => sub { warn "Process ".(shift->pid)." collected! "}); $session->on(collected_orphan => sub { warn "Orphan process collected! "}); $session->enable_subreaper(); # Mark the current process as subreaper $session->disable_subreaper(); # Disable subreaper $session->reset(); # Resets events and clear the process tables $session->clean(); # Stop all processes that result as running and reset =head1 DESCRIPTION Mojo::IOLoop::ReadWriteProcess::Session is a session manager for the collected processes =head1 EVENTS L inherits all events from L and can emit the following new ones. =head2 SIG_CHLD $session->on(SIG_CHLD => sub { my ($self) = @_; ... }); Emitted when we receive SIG_CHLD. =head2 collected $session->on(collected => sub { my ($self, $process) = @_; ... }); Emitted when child process is collected and it's return status is available. =head2 protect $session->on(protect => sub { my ($self, $detail) = @_; my ($cb, $signal) = @$detail; ... }); Emitted when protected callbacks are fired. =head2 collected_orphan $session->on(collected_orphan => sub { my ($self, $process) = @_; $process->pid; $process->exit_status; ... }); Emitted when child process is collected and it's exit status is available. Note: here are collected processes that weren't created with L. =head2 register $session->on(register => sub { my ($self, $process) = @_; $process->pid; $process->exit_status; ... }); Emitted when a process is registering to a session. =head1 ATTRIBUTES L inherits all attributes from L and implements the following new ones. =head2 subreaper use Mojo::IOLoop::ReadWriteProcess::Session qw(session); session->enable_subreaper; my $process = Mojo::IOLoop::ReadWriteProcess->new(code => sub { print "Hello ".$_[1] }, args => "User" ); $process->start(); $process->on( stop => sub { shift()->disable_subreaper } ); $process->stop(); # The process will print "Hello User" Mark the current process (not the child) as subreaper on start. It's on invoker behalf to disable subreaper when process stops, as it marks the current process and not the child. =head2 collect_status Defaults to C<1>, If enabled it will automatically collect the status of the children process. Disable it in case you want to manage your process child directly, and do not want to rely on automatic collect status. If you won't overwrite your C handler, the C event will be still emitted. =head2 handler() use Mojo::IOLoop::ReadWriteProcess::Session qw(session); session->handler(sub {}); Default handler for SIG_CHLD processing, used when C is invoked. =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 enable() use Mojo::IOLoop::ReadWriteProcess::Session qw(session); session->enable(); Sets the SIG_CHLD handler. =head2 disable() use Mojo::IOLoop::ReadWriteProcess::Session qw(session); session->disable(); Disables the SIG_CHLD handler and reset with the previous one. =head2 enable_subreaper() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process()->enable_subreaper; # or use Mojo::IOLoop::ReadWriteProcess::Session qw(session); session->enable_subreaper; Mark the current process (not the child) as subreaper. This is used typically if you want to mark further children as subreapers inside other forks. use Mojo::IOLoop::ReadWriteProcess::Session qw(session); my $master_p = process( sub { my $p = shift; $p->enable_subreaper; process(sub { sleep 4; exit 1 })->start(); process( sub { sleep 4; process(sub { sleep 1; })->start(); })->start(); process(sub { sleep 4; exit 0 })->start(); process(sub { sleep 4; die })->start(); my $manager = process(sub { sleep 2 })->subreaper(1)->start(); sleep 1 for (0 .. 10); $manager->stop; return session->all->size; }); $master_p->subreaper(1); $master_p->on(collect_status => sub { $status++ }); $master_p->on(stop => sub { shift()->disable_subreaper }); $master_p->start(); session->all->size(); .... =head2 disable_subreaper() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process()->disable_subreaper; Unset the current process as subreaper. =head2 prctl() use Mojo::IOLoop::ReadWriteProcess qw(process); my $p = process(); $p->prctl($option, $arg2, $arg3, $arg4, $arg5); Internal function to execute and wrap the prctl syscall, accepts the same arguments as prctl. =head2 reset() use Mojo::IOLoop::ReadWriteProcess qw(session); session->reset; Wipe the process tables. =head2 clean() use Mojo::IOLoop::ReadWriteProcess qw(session); session->clean; Wipe the process tables, but before attempt to stop running procesess. =head2 all() use Mojo::IOLoop::ReadWriteProcess::Session qw(session); my $collection = session->all; $collection->size; Returns a L of L that belongs to a session. =head2 all_orphans() use Mojo::IOLoop::ReadWriteProcess::Session qw(session); my $collection = session->all_orphans; $collection->size; Returns a L of L of orphaned processes that belongs to a session. They are automatically turned into a L, also if processes were created by C. =head2 all_processes() use Mojo::IOLoop::ReadWriteProcess::Session qw(session); my $collection = session->all_processes; $collection->size; Returns a L of all L known processes that belongs to a session. =head2 contains() use Mojo::IOLoop::ReadWriteProcess::Session qw(session); my $collection = session->contains(13443); $collection->size; Returns true if the pid is contained in any of the process tables. =head2 resolve() use Mojo::IOLoop::ReadWriteProcess::Session qw(session); my $process = session->resolve(12233); Returns the L process identified by its pid if belongs to the process table. =head2 orphan() use Mojo::IOLoop::ReadWriteProcess::Session qw(session); my $process = session->orphan(12233); Returns the L process identified by its pid if belongs to the process table of unknown processes. =head2 register() use Mojo::IOLoop::ReadWriteProcess::Session qw(session); my $process = session->register('pid' => Mojo::IOLoop::ReadWriteProcess->new); Register the L process to the session. =head2 unregister() use Mojo::IOLoop::ReadWriteProcess::Session qw(session); my $process = session->unregister(123342); Unregister the corresponding L with the given pid. =head2 collect() use Mojo::IOLoop::ReadWriteProcess::Session qw(session); my $process = session->collect(123342 => 0 => undef); Collect the status for the given pid. =head2 protect() use Mojo::IOLoop::ReadWriteProcess::Session qw(session); use POSIX; my $return = session->protect(sub { print "Hello World\n" }); session->protect(sub { print "Hello World\n" } => SIGTERM); Try to protect the execution of the callback from signal interrupts. =head1 EXPORTS =head2 session() use Mojo::IOLoop::ReadWriteProcess::Session qw(session); session->enable_subreaper; Returns the L singleton. =head1 DEBUGGING You can set the MOJO_EVENTEMITTER_DEBUG environment variable to get some advanced diagnostics information printed to STDERR. MOJO_EVENTEMITTER_DEBUG=1 Also, you can set MOJO_PROCESS_DEBUG environment variable to get diagnostics about the process execution. MOJO_PROCESS_DEBUG=1 =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut Lock.pm100644001750000144 1131314502070636 30416 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/Sharedpackage Mojo::IOLoop::ReadWriteProcess::Shared::Lock; use Mojo::Base 'Mojo::IOLoop::ReadWriteProcess::Shared::Semaphore'; our @EXPORT_OK = qw(shared_lock semaphore); use Exporter 'import'; use constant DEBUG => $ENV{MOJO_PROCESS_DEBUG}; # Mojo::IOLoop::ReadWriteProcess::Shared::Semaphore has same defaults - but locks have 1 count and 1 as setup value # Make it explict has count => 1; has _value => 1; has locked => 0; sub shared_lock { __PACKAGE__->new(@_) } sub lock { my $self = shift; warn "[debug:$$] Attempt to acquire lock " . $self->key if DEBUG; my $r = @_ > 0 ? $self->acquire(@_) : $self->acquire(wait => 1, undo => 0); warn "[debug:$$] lock Returned : $r" if DEBUG; $self->locked(1) if defined $r && $r == 1; return $r; } sub lock_section { my ($self, $fn) = @_; warn "[debug:$$] Acquiring lock (blocking)" if DEBUG; 1 while $self->lock != 1; warn "[debug:$$] Lock acquired $$" if DEBUG; my $r; { local $@; $r = eval { $fn->() }; $self->unlock(); warn "[debug:$$] Error inside locked section : $@" if $@ && DEBUG; }; return $r; } *section = \&lock_section; sub try_lock { shift->acquire(undo => 0, wait => 0) } sub unlock { my $self = shift; warn "[debug:$$] UNLock " . $self->key if DEBUG; my $r; eval { $r = $self->release(@_); $self->locked(0) if defined $r && $r == 1; }; return $r; } =encoding utf-8 =head1 NAME Mojo::IOLoop::ReadWriteProcess::Shared::Lock - IPC Lock =head1 SYNOPSIS use Mojo::IOLoop::ReadWriteProcess qw(process queue lock); my $q = queue; # Create a Queue $q->pool->maximum_processes(10); # 10 Concurrent processes at maximum $q->queue->maximum_processes(50); # 50 is maximum total to be allowed in the queue $q->add( process( sub { my $l = lock(key => 42); # IPC Lock my $e = 1; if ($l->lock) { # Blocking lock acquire # Critical section $e = 0; $l->unlock; } exit($e); } )->set_pipes(0)->internal_pipes(0)) for 1 .. 20; # Fill with 20 processes $q->consume(); # Consume the processes =head1 DESCRIPTION L uses L internally and creates a Lock from a semaphore that is available across different processes. =head1 METHODS L inherits all events from L and implements the following new ones. =head2 lock/unlock use Mojo::IOLoop::ReadWriteProcess qw(lock); my $l = lock(key => "42"); # Create Lock with key 42 if ($l->lock) { # Blocking call # Critical section ... $l->unlock; # Release the lock } Acquire access to the lock and unlocks it. C has the same arguments as L C. =head2 try_lock use Mojo::IOLoop::ReadWriteProcess qw(lock); my $l = lock(key => "42"); # Create Lock with key 42 if ($l->try_lock) { # Non Blocking call # Critical section ... $l->unlock; # Release the lock } Try to acquire lock in a non-blocking way. =head2 lock_section use Mojo::IOLoop::ReadWriteProcess qw(lock); my $l = lock(key => 3331); my $e = 1; $l->lock_section(sub { $e = 0; die; }); # or also $l->section(sub { $e = 0 }); $l->locked; # is 0 Executes a function inside a locked section. Errors are caught so lock is released in case of failures. =head1 ATTRIBUTES L inherits all attributes from L and provides the following new ones. =head2 flags use Mojo::IOLoop::ReadWriteProcess qw(lock); use IPC::SysV qw(IPC_CREAT IPC_EXCL S_IRUSR S_IWUSR); my $l = lock(flags=> IPC_CREAT | IPC_EXCL | S_IRUSR | S_IWUSR); Sets flag for the lock. In such way you can limit the access to the lock, e.g. to specific user/group process. =head2 key use Mojo::IOLoop::ReadWriteProcess qw(lock); my $l = lock(key => 42); Sets the lock key that is used to retrieve the lock among different processes, must be an integer. =head2 locked use Mojo::IOLoop::ReadWriteProcess qw(lock); my $l = lock(key => 42); $l->lock_section(sub { $l->locked; # 1 }); $l->locked; # 0 Returns the lock status =head1 DEBUGGING You can set MOJO_PROCESS_DEBUG environment variable to get diagnostics about the process execution. MOJO_PROCESS_DEBUG=1 =head1 LICENSE Copyright (C) Ettore Di Giacinto. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Ettore Di Giacinto Eedigiacinto@suse.comE =cut !!42; Memory.pm100644001750000144 1301014502070636 30772 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/Sharedpackage Mojo::IOLoop::ReadWriteProcess::Shared::Memory; use Mojo::IOLoop::ReadWriteProcess::Shared::Lock; use Mojo::Base -base; use Carp qw(croak confess); use constant DEBUG => $ENV{MOJO_PROCESS_DEBUG}; use IPC::SharedMem; use Config; use IPC::SysV qw(ftok IPC_PRIVATE IPC_NOWAIT IPC_CREAT IPC_EXCL S_IRUSR S_IWUSR S_IRGRP S_IWGRP S_IROTH S_IWOTH SEM_UNDO S_IRWXU S_IRWXG); our @EXPORT_OK = qw(shared_memory shared_lock semaphore); use Exporter 'import'; has key => sub { Mojo::IOLoop::ReadWriteProcess::Shared::Semaphore::_genkey() }; has 'buffer'; has destroy => 0; has flags => S_IRWXU() | S_IRWXG() | IPC_CREAT(); has lock_flags => IPC_CREAT | IPC_EXCL | S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH; has _size => 10 * 1024; has _shared_memory => sub { $_[0]->_newmem() }; has _shared_size => sub { $_[0]->_newmem((2 * shift->key) - 1, $Config{intsize}) }; has _lock => sub { Mojo::IOLoop::ReadWriteProcess::Shared::Lock->new( flags => $_[0]->lock_flags, key => (2 * shift->key) + 1 ); }; has dynamic_resize => 1; has dynamic_decrement => 1; has dynamic_increment => 1; sub shared_lock { Mojo::IOLoop::ReadWriteProcess::Shared::Lock->new(@_) } sub semaphore { Mojo::IOLoop::ReadWriteProcess::Shared::Semaphore->new(@_) } sub shared_memory { __PACKAGE__->new(@_) } sub new { my $s = shift->SUPER::new(@_); confess 'Could not allocate shared size memory ' . $s->key unless $s->_shared_size; $s->_loadsize; confess 'Could not allocate shared memory with key ' . $s->key unless $s->_shared_memory; return $s; } sub _encode_content { $_[0]->buffer(unpack 'H*', shift->buffer()) } sub _decode_content { $_[0]->buffer(pack 'H*', shift->buffer()) } sub _writesize { my $self = shift; my $size = shift; $self->_shared_size()->write(pack('I', $size), 0, $Config{intsize}); } sub _readsize { my $self = shift; my $s = $self->_shared_size()->read(0, $Config{intsize}); return unpack('I', $s); } sub _loadsize { my $s = $_[0]->_readsize; my $cur_size = $_[0]->_size; $s = $_[0]->_size if $s == 0; $_[0]->_size($s =~ /\d/ ? $s : $_[0]->_size); $_[0]->_writesize($_[0]->_size) and $_[0]->_shared_memory($_[0]->_newmem) if $s != $cur_size; warn "[debug:$$] Mem size: " . $_[0]->_size if DEBUG; } sub _reload { $_[0]->_shared_memory($_[0]->_newmem); $_[0]->_shared_memory($_[0]->_newmem) until defined $_[0]->_shared_memory; } # Must be run in a locked section sub resize { my $self = shift; $self->_shared_memory->detach(); 1 until $self->_safe_remove; $self->_size($_[0] // length $self->buffer); $self->_reload; # XXX: is faster to re-allocate the shared memory with shmctl, but SHM_SIZE # seems to not be really portable: # shmctl $_[0]->_shared_memory->id, SHM_SIZE, struct # $_[0]->_writesize($_[1] // length $_[0]->buffer ) if $_[0]->_shared_memory; } # Must be run in a locked section sub _sync_size { warn "[debug:$$] Sync size for content (" . length($_[0]->buffer) . ") vs currently allocated (" . $_[0]->_size . ")" if DEBUG; $_[0]->resize; } sub save { warn "[debug:$$] Writing data : " . $_[0]->buffer if DEBUG; $_[0]->_encode_content; eval { # Resize $_[0]->_sync_size if ( $_[0]->dynamic_resize && ( ( $_[0]->dynamic_increment && (defined $_[0]->buffer && length $_[0]->buffer > $_[0]->_size) ) # Increment || ($_[0]->dynamic_decrement && (defined $_[0]->buffer && $_[0]->_size > length $_[0]->buffer) ) # Decrement )); $_[0]->_writesize($_[0]->_size) if $_[0]->_shared_memory(); # $_[0]->_reload; $_[0]->_shared_memory()->write($_[0]->buffer, 0, $_[0]->_size) if $_[0]->_shared_memory(); }; warn "[debug:$$] Error Saving data : $@" if $@ && DEBUG; $_[0]->_shared_memory->detach() if $_[0]->_shared_memory; return if $@; return 1; } sub _newmem { IPC::SharedMem->new( $_[1] // $_[0]->key(), $_[2] // $_[0]->_size, $_[0]->flags ); } sub load { eval { $_[0]->_loadsize; warn "[debug:$$] Reading " . $_[0]->_size if DEBUG; $_[0]->_reload; $_[0]->_shared_memory->attach(); $_[0]->buffer($_[0]->_shared_memory()->read(0, $_[0]->_size)); # XXX: Remove the 0 padding? # substr($_[0]->{buffer}, index($_[0]->{buffer}, "\0")) = ""; $_[0]->_decode_content; }; warn "[debug:$$] Error Loading data : $@" if $@ && DEBUG; return if $@; return 1; } sub _safe_remove { my $self = shift; my $stat = $self->_shared_memory()->stat(); if (defined($stat) && ($stat->nattch() == 0)) { $self->_shared_memory()->remove(); return 1; } return 0; } sub remove { my $self = shift; $self->_shared_memory->detach(); $self->_lock->remove; $self->_shared_size()->remove(); return $self->_safe_remove; } sub clean { my $self = shift; $self->lock_section(sub { $self->buffer(' ')->save }); } sub unlock { eval { $_[0]->save }; shift->_lock->unlock(@_); } sub lock { my $s = shift; my $r = $s->_lock->lock(@_); $s->load; $r } sub try_lock { $_[0]->_lock->try_lock() } sub lock_section { my ($self, $fn) = @_; return $self->_lock->lock_section( sub { my $r; { $self->load; local $@; $r = eval { $fn->() }; warn "[debug:$$] Error inside locked memory section : $@" if $@ && DEBUG; eval { $self->save }; }; return $r; }); } sub stat { shift->_shared_memory->stat } sub DESTROY { $_[0]->remove if $_[0]->destroy() } !!42; Semaphore.pm100644001750000144 453614502070636 31442 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/lib/Mojo/IOLoop/ReadWriteProcess/Sharedpackage Mojo::IOLoop::ReadWriteProcess::Shared::Semaphore; use Mojo::Base -base; use Carp; use POSIX qw(O_WRONLY O_CREAT O_NONBLOCK O_NOCTTY); use IPC::SysV qw(ftok IPC_NOWAIT IPC_CREAT IPC_EXCL S_IRUSR S_IWUSR S_IRGRP S_IWGRP S_IROTH S_IWOTH SEM_UNDO); use IPC::Semaphore; our @EXPORT_OK = qw(semaphore); use Exporter 'import'; use constant DEBUG => $ENV{MOJO_PROCESS_DEBUG}; has key => sub { shift->_genkey }; has _sem => sub { $_[0]->_create(shift->key) }; has count => 1; has _value => 1; has flags => IPC_CREAT | IPC_EXCL | S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH; sub semaphore { __PACKAGE__->new(@_) } sub _genkey { ftok($0, 0) } # The following is an adaptation over IPC::Semaphore::Concurrency sub _create { my ($self, $key) = @_; # Try acquiring already existing semaphore my $sem = IPC::Semaphore->new($key, $self->count, 0); unless (defined $sem) { warn "[debug:$$] Create semaphore $key" if DEBUG; $sem = IPC::Semaphore->new($key, $self->count, $self->flags); confess 'Semaphore creation failed! ' unless defined($sem); $sem->setall($self->_value); } return $sem; } sub acquire { my $self = shift; my %args = @_ % 2 == 0 ? @_ : @_ == 1 && ref $_[0] eq 'HASH' ? %{$_[0]} : (); # Defaults $args{'sem'} = 0 unless defined($args{'sem'}); $args{'wait'} = 0 unless defined($args{'wait'}); $args{'max'} = -1 unless defined($args{'max'}); $args{'undo'} = 0 unless defined($args{'undo'}); warn "[debug:$$] Acquire semaphore " . $self->key if DEBUG; my $sem = $self->_sem; my $flags = IPC_NOWAIT; $flags |= SEM_UNDO if ($args{'undo'}); if ($args{'wait'}) { my $ncnt = $self->getncnt($args{'sem'}); return if ($args{'max'} >= 0 && $ncnt >= $args{'max'}); warn "[debug:$$] Semaphore wait" if DEBUG; warn "[debug:$$] Semaphore val " . $self->getval($args{sem}) if DEBUG; # Remove NOWAIT and block $flags ^= IPC_NOWAIT; } return $sem->op($args{'sem'}, -1, $flags); } sub getall { shift->_sem->getall() } sub getval { shift->_sem->getval(shift // 0) } sub getncnt { shift->_sem->getncnt(shift // 0) } sub setall { shift->_sem->setall(@_) } sub setval { shift->_sem->setval(@_) } sub stat { shift->_sem->stat() } sub id { shift->_sem->id() } sub release { shift->_sem->op(shift || 0, 1, 0) } sub remove { shift->_sem->remove() } !!42; minil.toml100644001750000144 36514502070636 21674 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34name = "Mojo-IOLoop-ReadWriteProcess" badges = ["codecov", "github-actions/linux"] module_maker="ModuleBuild" [build] build_class = "builder::custom" [Metadata.resources] repository = "https://github.com/openSUSE/Mojo-IOLoop-ReadWriteProcess" 00_compile.t100644001750000144 126214502070636 22263 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/t use strict; use Test::More 0.98; use FindBin; use lib ("$FindBin::Bin/lib", "../lib", "lib"); use_ok $_ for qw( Mojo::IOLoop::ReadWriteProcess Mojo::IOLoop::ReadWriteProcess::Pool Mojo::IOLoop::ReadWriteProcess::Exception Mojo::IOLoop::ReadWriteProcess::Queue Mojo::IOLoop::ReadWriteProcess::Session Mojo::IOLoop::ReadWriteProcess::Shared::Lock Mojo::IOLoop::ReadWriteProcess::Shared::Semaphore Mojo::IOLoop::ReadWriteProcess::Shared::Memory Mojo::IOLoop::ReadWriteProcess::Container Mojo::IOLoop::ReadWriteProcess::CGroup Mojo::IOLoop::ReadWriteProcess::CGroup::v1 Mojo::IOLoop::ReadWriteProcess::CGroup::v2 ); done_testing; 01_run.t100644001750000144 5054114502070636 21464 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.34/t#!/usr/bin/perl use warnings; use strict; use Test::More; use Test::Exception; use POSIX; use FindBin; use IO::Select; use Mojo::File qw(tempfile path); use lib ("$FindBin::Bin/lib", "../lib", "lib"); use Mojo::IOLoop::ReadWriteProcess qw(process); use Mojo::IOLoop::ReadWriteProcess::Test::Utils qw(attempt check_bin); subtest process => sub { my $c = Mojo::IOLoop::ReadWriteProcess->new(); can_ok($c, qw(verbose _diag)); my $buffer; { open my $handle, '>', \$buffer; local *STDERR = $handle; $c->_diag("FOOTEST"); }; like $buffer, qr/>> main::__ANON__(.*\])*\(\): FOOTEST/, "diag() correct output format"; }; subtest 'process basic functions' => sub { my $p = Mojo::IOLoop::ReadWriteProcess->new(); eval { $p->start(); $p->stop(); }; ok $@, "Error expected"; like $@, qr/Nothing to do/, "Process with no code nor execute command, will fail"; $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01 ); eval { $p->_fork(); }; ok $@, "Error expected"; like $@, qr/Can't spawn child without code/, "_fork() with no code will fail"; my @output; { pipe(PARENT, CHILD); my $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, code => sub { close(PARENT); open STDERR, ">&", \*CHILD or die $!; print STDERR "FOOBARFTW\n" while 1; })->start(); close(CHILD); @output = scalar ; $p->stop(); chomp @output; } is $output[0], "FOOBARFTW", 'right output'; }; subtest 'process is_running()' => sub { my @output; pipe(PARENT, CHILD); my $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, code => sub { close(PARENT); open STDERR, ">&", \*CHILD or die $!; print STDERR "FOOBARFTW\n"; }); $p->start(); close(CHILD); @output = scalar ; $p->stop(); close(PARENT); chomp @output; is $output[0], "FOOBARFTW", 'right output from process'; is $p->is_running, 0, "Process now is stopped"; # Redefine new code and restart it. pipe(PARENT, CHILD); $p->code( sub { close(PARENT); open STDERR, ">&", \*CHILD or die $!; print STDERR "FOOBAZFTW\n"; 1 while 1; }); $p->restart()->restart()->restart(); is $p->is_running, 1, "Process now is running"; close(CHILD); @output = scalar ; $p->stop(); chomp @output; is $output[0], "FOOBAZFTW", 'right output from process'; is $p->is_running, 0, "Process now is not running"; @output = (''); pipe(PARENT, CHILD); $p->restart(); # Give time to the child to be up my $attempts = 100; until ($p->is_running || $attempts == 0) { sleep .1; $attempts--; } is $p->is_running, 1, "Process now is running"; close(CHILD); @output = scalar ; $p->stop(); chomp @output; is $output[0], "FOOBAZFTW", 'right output from process'; }; subtest 'process execute()' => sub { my $test_script = check_bin("$FindBin::Bin/data/process_check.sh"); my $test_script_sigtrap = check_bin("$FindBin::Bin/data/term_trap.sh"); my $p = Mojo::IOLoop::ReadWriteProcess->new( sleeptime_during_kill => 0.1, execute => $test_script )->start(); is $p->getline, "TEST normal print\n", 'Get right output from stdout'; is $p->err_getline, "TEST error print\n", 'Get right output from stderr'; is $p->is_running, 1, 'process is still waiting for our input'; $p->write("FOOBAR"); is $p->read, "you entered FOOBAR\n", 'process received input and printed it back'; $p->stop(); is $p->is_running, 0, 'process is not running anymore'; $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, execute => $test_script, args => [ qw(FOO BAZ) ])->start(); is $p->stdout, "TEST normal print\n", 'Get right output from stdout'; is $p->err_getline, "TEST error print\n", 'Get right output from stderr'; is $p->is_running, 1, 'process is still waiting for our input'; $p->write("FOOBAR"); is $p->getline, "you entered FOOBAR\n", 'process received input and printed it back'; $p->wait_stop(); is $p->is_running, 0, 'process is not running anymore'; is $p->getline, "FOO BAZ\n", 'process received extra arguments'; is $p->exit_status, 100, 'able to retrieve function return'; $p = Mojo::IOLoop::ReadWriteProcess->new( sleeptime_during_kill => 0.1, execute => $test_script )->args([qw(FOO BAZ)])->start(); is $p->stdout, "TEST normal print\n", 'Get right output from stdout'; is $p->err_getline, "TEST error print\n", 'Get right output from stderr'; is $p->is_running, 1, 'process is still waiting for our input'; $p->write("FOOBAR"); is $p->getline, "you entered FOOBAR\n", 'process received input and printed it back'; $p->wait_stop(); is $p->is_running, 0, 'process is not running anymore'; is $p->getline, "FOO BAZ\n", 'process received extra arguments'; is $p->exit_status, 100, 'able to retrieve function return'; $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, separate_err => 0, execute => $test_script ); $p->start(); is $p->is_running, 1, 'process is still running'; is $p->getline, "TEST error print\n", 'Get STDERR output from stdout, always in getline()'; $p->stop(); like $p->getline, qr/TEST (exiting|normal print)/, 'Still able to get stdout output, always in getline()'; my $p2 = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, separate_err => 0, execute => $test_script, set_pipes => 0 ); $p2->start(); is $p2->getline, undef, "pipes are correctly disabled"; $p2->stop(); is !!$p2->_status, 1, 'take exit status even with set_pipes = 0 (we killed it)'; $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, verbose => 1, separate_err => 0, execute => $test_script_sigtrap, max_kill_attempts => -4, ); # ;) $p->start(); is($p->read_stdout(), "term_trap.sh started\n"); $p->stop(); is $p->is_running, 1, 'process is still running'; is $p->_status, undef, 'no status yet'; my $err = ${(@{$p->error})[0]}; my $exp = qr/Could not kill process/; like $err, $exp, 'Error is not empty if process could not be killed'; $p->max_kill_attempts(50); $p->blocking_stop(0); $p->stop(); is $p->is_running, 1, 'process is still running'; $p->blocking_stop(1); $p->max_kill_attempts(5); $p->stop; $p->wait; is $p->is_running, 0, 'process is shut down'; is $p->errored, 1, 'Process died and errored'; $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, verbose => 1, separate_err => 0, blocking_stop => 1, execute => $test_script, max_kill_attempts => -1 # ;) )->start()->stop(); is $p->is_running, 0, 'process is shut down by kill signal when "blocking_stop => 1"'; my $pidfile = tempfile; $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, verbose => 1, separate_err => 0, blocking_stop => 1, execute => $test_script, max_kill_attempts => -1, # ;) pidfile => $pidfile )->start(); my $pid = path($pidfile)->slurp(); is -e $pidfile, 1, 'Pidfile is there!'; is $pid, $p->pid, "Pidfile was correctly written"; $p->stop(); is -e $pidfile, undef, 'Pidfile got removed after stop()'; $pidfile = tempfile; $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, verbose => 1, separate_err => 0, blocking_stop => 1, execute => $test_script, max_kill_attempts => -1, # ;) )->start(); $p->write_pidfile($pidfile); $pid = path($pidfile)->slurp(); is -e $pidfile, 1, 'Pidfile is there!'; is $pid, $p->pid, "Pidfile was correctly written"; $p->stop(); is -e $pidfile, undef, 'Pidfile got removed after stop()'; $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, verbose => 1, separate_err => 0, blocking_stop => 1, execute => $test_script, max_kill_attempts => -1, # ;) )->start(); is $p->write_pidfile(), undef, "No filename given to write_pidfile"; $p->stop(); }; subtest 'process(execute => /bin/true)' => sub { check_bin('/bin/true'); is( process(execute => '/bin/true')->quirkiness(1)->start()->wait_stop() ->exit_status(), 0, 'Simple exec of /bin/true return 0' ); }; subtest 'process code()' => sub { my $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, code => sub { my ($self) = shift; my $parent_output = $self->channel_out; my $parent_input = $self->channel_in; print $parent_output "FOOBARftw\n"; print "TEST normal print\n"; print STDERR "TEST error print\n"; print "Enter something : "; my $a = ; chomp($a); print "you entered $a\n"; my $parent_stdin = $parent_input->getline; print $parent_output "PONG\n" if $parent_stdin eq "PING\n"; exit 0; })->start(); $p->channel_in->write("PING\n"); is $p->getline, "TEST normal print\n", 'Get right output from stdout'; is $p->stderr, "TEST error print\n", 'Get right output from stderr'; is $p->is_running, 1, 'process is running'; $p->write("FOOBAR\n"); is(IO::Select->new($p->read_stream)->can_read(10), 1, 'can read from stdout handle'); is $p->getline, "Enter something : you entered FOOBAR\n", 'can read output'; is $p->channel_out->getline, "FOOBARftw\n", "can read from internal channel"; is $p->channel_read_handle->getline, "PONG\n", "can read from internal channel"; $p->stop(); is $p->is_running, 0, 'process is not running'; $p->restart(); $p->channel_write("PING"); is $p->getline, "TEST normal print\n", 'Get right output from stdout'; is $p->stderr, "TEST error print\n", 'Get right output from stderr'; is $p->is_running, 1, 'process is running'; is $p->channel_read(), "FOOBARftw\n", "Read from channel while process is running"; $p->write("FOOBAR"); is(IO::Select->new($p->read_stream)->can_read(10), 1, 'can read from stdout handle'); is $p->read_all, "Enter something : you entered FOOBAR\n", 'Get right output from stdout'; $p->stop(); my @result = $p->read_all; is @result, 0, 'output buffer is now empty'; is $p->channel_read_handle->getline, "PONG\n", "can read from internal channel"; is $p->is_running, 0, 'process is not running'; $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, separate_err => 0, code => sub { my ($self) = shift; my $parent_output = $self->channel_out; my $parent_input = $self->channel_in; print "TEST normal print\n"; print STDERR "TEST error print\n"; return "256"; })->start(); is $p->getline, "TEST normal print\n", 'Get right output from stderr/stdout'; is $p->getline, "TEST error print\n", 'Get right output from stderr/stdout'; $p->wait_stop(); is $p->is_running, 0, 'process is not running'; is $p->return_status, 256, 'right return code'; $p = Mojo::IOLoop::ReadWriteProcess->new(sub { die "Fatal error"; }, sleeptime_during_kill => 0.1); my $event_fired = 0; $p->on( process_error => sub { $event_fired = 1; like(pop->first->to_string, qr/Fatal error/, 'right error from event'); }); $p->start(); $p->wait_stop(); is $p->is_running, 0, 'process is not running'; is $p->return_status, undef, 'process did not return nothing'; is $p->errored, 1, 'Process died'; like(${(@{$p->error})[0]}, qr/Fatal error/, 'right error'); is $event_fired, 1, 'error event fired'; $p = Mojo::IOLoop::ReadWriteProcess->new( sub { return 42 }, kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, internal_pipes => 0 ); $p->start(); $p->wait_stop(); is $p->is_running, 0, 'process is not running'; is $p->return_status, undef, 'process did not return nothing when internal_pipes are disabled'; $p = Mojo::IOLoop::ReadWriteProcess->new( sub { die "Bah" }, kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, internal_pipes => 0 ); $p->start(); $p->wait_stop(); is $p->is_running, 0, 'process is not running'; is $p->errored, 0, 'process did not errored, we dont catch errors anymore'; # XXX: flaky test temporarly skip it. is !!$p->exit_status, 1, 'Exit status is there'; $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, separate_err => 0, set_pipes => 0, code => sub { print "TEST normal print\n"; print STDERR "TEST error print\n"; return "256"; })->start(); is $p->getline, undef, 'no output from pipes expected'; is $p->getline, undef, 'no output from pipes expected'; $p->wait_stop(); is $p->return_status, 256, "grab exit_status even if no pipes are set"; $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, separate_err => 0, set_pipes => 1, code => sub { exit 100; })->start(); $p->wait_stop(); is $p->exit_status, 100, "grab exit_status even if no pipes are set"; $p = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, separate_err => 0, code => sub { print STDERR "TEST error print\n" for (1 .. 6); my $a = ; })->start(); like $p->stderr_all, qr/TEST error print/, 'read all from stderr, is like reading all from stdout when separate_err = 0'; $p->stop()->separate_err(1)->start(); $p->write("a"); $p->wait_stop(); like $p->stderr_all, qr/TEST error print/, 'read all from stderr works'; is $p->read_all, '', 'stdout is empty'; }; subtest stop_whole_process_group_gracefully => sub { my $test_script = check_bin("$FindBin::Bin/data/simple_fork.pl"); # run the "term_trap.pl" script and its sub processes within its own # process group # notes: - Not using "term_trap.sh" here because bash interferes with the # process group. # - Set TOTAL_SLEEPTIME_DURING_KILL to a notable number of seconds # to check whether the sub processes would actually be granted # this number of seconds before getting killed. This is not set by # default to avoid slowing down the CI. my $sub_process = Mojo::IOLoop::ReadWriteProcess->new( kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, max_kill_attempts => 1, separate_err => 0, blocking_stop => 1, kill_whole_group => 1, total_sleeptime_during_kill => $ENV{TOTAL_SLEEPTIME_DURING_KILL} // 0.05, code => sub { $SIG{TERM} = 'IGNORE'; setpgrp(0, 0); exec(perl => $test_script); })->start(); # wait until the sub process changes its process group # note: Otherwise it still has the process group of this unit test and calling # stop would also stop the test itself. my $test_gpid = getpgrp(0); my $sub_process_pid = $sub_process->pid; sleep 0.1 while $test_gpid == getpgrp($sub_process_pid); $sub_process->stop(); is $sub_process->is_running, 0, 'process is shut down via kill_whole_group'; }; subtest process_debug => sub { my $buffer; local $ENV{MOJO_PROCESS_DEBUG} = 1; { # We have to unload and load it back from memory to enable debug. (the ENV value is considered only in compile-time) open my $handle, '>', \$buffer; local *STDERR = $handle; delete $INC{'Mojo/IOLoop/ReadWriteProcess.pm'}; eval "no warnings; require Mojo::IOLoop::ReadWriteProcess"; ## no critic Mojo::IOLoop::ReadWriteProcess->new( code => sub { 1; }, kill_sleeptime => 0.01, sleeptime_during_kill => 0.01 )->start()->stop(); } like $buffer, qr/Fork: \{/, 'setting MOJO_PROCESS_DEBUG to 1 enables debug mode when forking process'; undef $buffer; { open my $handle, '>', \$buffer; local *STDERR = $handle; delete $INC{'Mojo/IOLoop/ReadWriteProcess.pm'}; eval "no warnings; require Mojo::IOLoop::ReadWriteProcess"; ## no critic Mojo::IOLoop::ReadWriteProcess->new( execute => "$FindBin::Bin/data/process_check.sh", kill_sleeptime => 0.01, sleeptime_during_kill => 0.01, )->start()->stop(); } like $buffer, qr/Execute: .*process_check.sh/, 'setting MOJO_PROCESS_DEBUG to 1 enables debug mode when executing external process'; }; subtest 'process_args' => sub { my $code = sub { shift; print "$_$/" for @_; }; my $p = Mojo::IOLoop::ReadWriteProcess->new($code, args => '0') ->start->wait_stop(); is($p->read_all_stdout(), "0$/", '1) False scalar value was given as args.'); $p = Mojo::IOLoop::ReadWriteProcess->new($code)->args('0')->start->wait_stop(); is($p->read_all_stdout(), "0$/", '2) False scalar value was given as args.'); $p = Mojo::IOLoop::ReadWriteProcess->new($code, args => [(0 .. 3)]) ->start->wait_stop(); is($p->read_all_stdout(), "0$/1$/2$/3$/", '1) Args given as arrayref.'); $p = Mojo::IOLoop::ReadWriteProcess->new($code)->args([(0 .. 3)]) ->start->wait_stop(); is($p->read_all_stdout(), "0$/1$/2$/3$/", '2) Args given as arrayref.'); }; subtest 'process in process' => sub { check_bin('/bin/true'); check_bin('/bin/false'); my $p = process( sub { is( process(execute => '/bin/true')->quirkiness(1)->start()->wait_stop() ->exit_status(), 0, 'process(execute) from process(code) -- retval check true' ); is( process(execute => '/bin/false')->quirkiness(1)->start()->wait_stop() ->exit_status(), 1, 'process(execute) from process(code) -- retval check false' ); is( process(sub { print 'sub-sub-process' })->start()->wait_stop() ->read_all_stdout, 'sub-sub-process', 'process(code) works from process(code)' ); print 'DONE'; })->start()->wait_stop(); is($p->read_all_stdout(), 'DONE', "Use ReadWriteProcess inside of ReadWriteProcess(code=>'')"); }; subtest 'execute exeption handling' => sub { throws_ok { process(execute => '/I/do/not/exist')->start()->wait_stop()->exit_status(); } qr%/I/do/not/exist%, 'Execute throw exception, if executable does not exists'; my $p = process(execute => 'sleep 0.2')->start(); attempt {attempts => 20, condition => sub { defined($p->exit_status) },}; is($p->is_running(), 0, 'Process not running'); is($p->exit_status(), 0, 'Exit status is 0'); }; subtest 'SIG_CHLD handler in spawned process' => sub { my $simple_rwp = check_bin("$FindBin::Bin/data/simple_rwp.pl"); my $sigchld_handler = check_bin("$FindBin::Bin/data/sigchld_handler.pl"); # use `perl