Build.PL100644001750000144 301613735070710 21202 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28# ========================================================================= # 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' => '7.24', }, recommends => { }, suggests => { }, build_requires => { }, test_requires => { 'Test::More' => '0.98', }, 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 730013735070710 21201 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28 Revision history for Perl extension Mojo-IOLoop-ReadWriteProcess 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 4400113735070710 20732 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28This 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 1346613735070710 21361 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28{ "abstract" : "Execute external programs or internal code blocks as separate process.", "author" : [ "Ettore Di Giacinto " ], "dynamic_config" : 0, "generated_by" : "Minilla/v3.1.10", "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" : { "Test::CPAN::Meta" : "0", "Test::MinimumVersion::Fast" : "0.04", "Test::PAUSE::Permissions" : "0.07", "Test::Pod" : "1.41", "Test::Spellunker" : "v0.2.7" } }, "runtime" : { "requires" : { "IPC::SharedMem" : "0", "Mojolicious" : "7.24" } }, "test" : { "requires" : { "Test::More" : "0.98" } } }, "provides" : { "Mojo::IOLoop::ReadWriteProcess" : { "file" : "lib/Mojo/IOLoop/ReadWriteProcess.pm", "version" : "0.28" }, "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/mudler/Mojo-IOLoop-ReadWriteProcess/issues" }, "homepage" : "https://github.com/mudler/Mojo-IOLoop-ReadWriteProcess", "repository" : { "url" : "git://github.com/mudler/Mojo-IOLoop-ReadWriteProcess.git", "web" : "https://github.com/mudler/Mojo-IOLoop-ReadWriteProcess" } }, "version" : "0.28", "x_contributors" : [ "Clemens Famulla-Conrad ", "Ettore Di Giacinto ", "Ettore Di Giacinto ", "Marius Kittler ", "Mohammad S Anwar ", "Oliver Kurz ", "Santiago Zarate ", "Santiago Zarate ", "Sebastian Riedel " ], "x_static_install" : 0 } README.md100644001750000144 5164713735070710 21222 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28[![Build Status](https://travis-ci.org/mudler/Mojo-IOLoop-ReadWriteProcess.svg?branch=master)](https://travis-ci.org/mudler/Mojo-IOLoop-ReadWriteProcess) [![Coverage Status](http://codecov.io/github/mudler/Mojo-IOLoop-ReadWriteProcess/coverage.svg?branch=master)](https://codecov.io/github/mudler/Mojo-IOLoop-ReadWriteProcess?branch=master) # 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" Array or arrayref of options to pass by to the external binary or the code block. ## 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 setted 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 childs 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 37013735070710 23164 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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; circle.yml100644001750000144 101713735070710 21671 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28version: 2.1 orbs: perl: circleci/perl@1.0.0 workflows: main: jobs: - perl/build: codecov: true save-to-artifacts: true save-to-workspace: true - perl/test-linux: matrix: parameters: perl-version: - '5.16' - '5.18' - '5.20' - '5.22' - '5.24' - '5.26' - '5.28' - '5.30' requires: - perl/buildcodecov.yml100644001750000144 53413735070710 22035 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28codecov: 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 31113735070710 21365 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28requires 'Mojolicious', '7.24'; requires 'IPC::SharedMem'; on configure => sub { requires 'Module::Build'; requires 'perl', '5.016'; }; on test => sub { requires 'Test::More', '0.98'; }; ReadWriteProcess.pm100644001750000144 11225713735070710 26354 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/lib/Mojo/IOLooppackage Mojo::IOLoop::ReadWriteProcess; our $VERSION = '0.28'; use Mojo::Base 'Mojo::EventEmitter'; use Mojo::File 'path'; use Mojo::Util qw(b64_decode b64_encode); 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) ]; has max_kill_attempts => 5; has kill_whole_group => 0; has args => sub { [] }; 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->session->enable; 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 $self->on(collect_status => \&_open_collect_status); 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->_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($!); open STDOUT, ">&", $stdout or !!$internal_err->write($!) or $self->_diag($!); open STDIN, ">&", $stdin or !!$internal_err->write($!) or $self->_diag($!); $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); $self->session->enable; 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 { $_[0]->process_id ? kill 0 => $_[0]->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)->spurt($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 '\n', @{[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 = $self->args ? ref($self->args) eq "ARRAY" ? @{$self->args} : $self->args : (); $self->session->enable_subreaper if $self->subreaper; $self->_status(undef); 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" Array or arrayref of options to pass by to the external binary or the code block. =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 setted 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 childs 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 574213735070710 27513 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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])->spurt($_[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 1141613735070710 30054 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 212613735070710 31414 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 615613735070710 31304 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 235613735070710 31421 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 260313735070710 31434 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 1200413735070710 31316 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 214313735070710 31261 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 234013735070710 31450 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 225413735070710 30450 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 201313735070710 30550 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 762313735070710 30042 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 250613735070710 30464 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 225413735070710 30344 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 342513735070710 31306 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 213013735070710 30442 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 213113735070710 30552 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 3620713735070710 30256 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 differents 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 212513735070710 30242 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 1172113735070710 30222 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 616213735070710 27222 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 1050613735070710 27412 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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->_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 3441513735070710 27756 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 'handler'; 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 { $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->collect($pid => $? => $!); } } }); } 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 ($errno, $status, $pid) = (pop, pop, pop); 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; } # 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)} = ({}, {}, {}) } # 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 "arm" ? 0x900000 + 172 : $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 childs 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 1131413735070710 30422 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 catched 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 1301613735070710 31003 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 453313735070710 31442 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 21113735070710 21665 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28name = "Mojo-IOLoop-ReadWriteProcess" badges = ["travis", "codecov"] module_maker="ModuleBuild" [build] build_class = "builder::custom" 00_compile.t100644001750000144 126213735070710 22266 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/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 4331613735070710 21471 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t#!/usr/bin/perl use warnings; use strict; use Test::More; use POSIX; use FindBin; use Mojo::File qw(tempfile path); use lib ("$FindBin::Bin/lib", "../lib", "lib"); subtest process => sub { use Mojo::IOLoop::ReadWriteProcess; 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 { use Mojo::IOLoop::ReadWriteProcess; 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 { use Mojo::IOLoop::ReadWriteProcess; 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 = "$FindBin::Bin/data/process_check.sh"; my $test_script_sigtrap = "$FindBin::Bin/data/term_trap.sh"; plan skip_all => "You do not seem to have bash, which is required (as for now) for this test" unless -e '/bin/bash'; plan skip_all => "You do not seem to have $test_script. The script is required to run the test" unless -e $test_script; plan skip_all => "You do not seem to have $test_script_sigtrap. The script is required to run the test" unless -e $test_script_sigtrap; use Mojo::IOLoop::ReadWriteProcess; 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(); $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 code()' => sub { use Mojo::IOLoop::ReadWriteProcess; use IO::Select; 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 = "$FindBin::Bin/data/simple_fork.pl"; plan skip_all => "You do not seem to have $test_script which is required to run the test" unless -e $test_script; # 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'; }; done_testing; 02_parallel.t100644001750000144 663713735070710 22447 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t#!/usr/bin/perl use warnings; use strict; use Test::More; use POSIX; use FindBin; use Mojo::File qw(tempfile path); use lib ("$FindBin::Bin/lib", "../lib", "lib"); use Mojo::IOLoop::ReadWriteProcess qw(parallel batch process pool); subtest parallel => sub { my $n_proc = 4; my $fired; my $c = parallel( code => sub { sleep 2; print "Hello world\n"; }, kill_sleeptime => 1, sleeptime_during_kill => 1, separate_err => 1, set_pipes => 1, $n_proc ); isa_ok($c, "Mojo::IOLoop::ReadWriteProcess::Pool"); is $c->size(), $n_proc; $c->once(stop => sub { $fired++; }); $c->start(); $c->each(sub { my $p = shift; $p->wait; is $p->getline(), "Hello world\n"; }); $c->wait_stop; is $fired, $n_proc; $c->once(stop => sub { $fired++ }); my $b = $c->restart(); is $b, $c; sleep 3; $c->wait_stop; is $fired, $n_proc * 2; }; subtest batch => sub { my @stack; my $n_proc = 2; my $fired; push( @stack, process( code => sub { sleep 2; print "Hello world\n" }, separate_err => 0, set_pipes => 1 )) for (1 .. $n_proc); my $c = batch @stack; isa_ok($c, "Mojo::IOLoop::ReadWriteProcess::Pool"); is $c->size(), $n_proc; $c->once(stop => sub { $fired++; }); my @procs = $c->start(); $c->each(sub { my $p = shift; $p->wait; is $p->getline(), "Hello world\n"; }); $c->wait_stop; is $fired, $n_proc; is scalar(@procs), $n_proc; $c->add( code => sub { print "Hello world 3\n" }, separate_err => 0, set_pipes => 1 ); $c->start(); is $c->last->getline, "Hello world 3\n"; $c->wait_stop(); my $result; $c->add(code => sub { return 40 + 2 }, separate_err => 0, set_pipes => 0); $c->last->on( stop => sub { $result = shift->return_status; }); $c->last->start()->wait_stop(); is $result, 42; }; subtest "Working with pools" => sub { my $n_proc = 5; my $number = 1; my $pool = batch; for (1 .. $n_proc) { $pool->add( code => sub { my $self = shift; my $number = shift; sleep 2; return 40 + $number; }, args => $number, set_pipes => 0, separate_err => 0, kill_sleeptime => 1, sleeptime_during_kill => 1, ); $number++; } my $results; $pool->once(stop => sub { $results->{+shift()->return_status}++; }); $pool->start->wait_stop; my $i = 1; for (1 .. $n_proc) { is $results->{40 + $i}, 1; $i++; } ok $pool->get(0) != $pool->get(1); ok $pool->get(3); $pool->remove(3); is $pool->get(3), undef; }; subtest maximum_processes => sub { my $p = pool(); $p->maximum_processes(1); $p->add(sub { print "Hello\n" }); $p->add(sub { print "Wof\n" }); $p->add(sub { print "Wof2\n" }); is $p->get(1), undef; is $p->size, 1; is $p->maximum_processes, 1; }; subtest stress_test => sub { plan skip_all => "set STRESS_TEST=1 (be careful)" unless $ENV{STRESS_TEST}; # Push the maximum_processes boundaries and let's see events are fired. my $n_proc = 2000; my $fired; my $p = pool; $p->maximum_processes($n_proc); $p->add( code => sub { sleep 3; exit(20) }, internal_pipes => 0, set_pipes => 0 ) for 1 .. $n_proc; $p->once(stop => sub { $fired++ }); $p->start->wait; is $fired, $n_proc; $p->each(sub { is $_->exit_status, "20" }); }; done_testing; 03_func.t100644001750000144 563413735070710 21603 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t#!/usr/bin/perl use warnings; use strict; use Test::More; use POSIX; use FindBin; use Mojo::File qw(tempfile path); use lib ("$FindBin::Bin/lib", "../lib", "lib"); use Mojo::IOLoop::ReadWriteProcess qw(process queue parallel); use Mojo::IOLoop::ReadWriteProcess::Test::Utils qw(attempt); no warnings; # This test mocks a lot subtest _new_err => sub { my $p = process(); $p->_new_err("Test"); is $p->error->last->to_string, "Test"; $p->_new_err("Test", "Test"); ok !$p->error->last->to_string; }; subtest write_pidfile => sub { use Mojo::File 'tempfile'; my $pidfile = tempfile; my $p = process(code => sub { exit 0 }, pidfile => $pidfile); $p->write_pidfile; ok !$pidfile->slurp; }; subtest _fork => sub { plan skip_all => "Test is not possible on Windows" if $^O eq "MSWin32"; use Mojo::Util 'monkey_patch'; monkey_patch 'IO::Pipe', new => sub { undef }; my $p = process(sub { exit 0 })->start->wait_stop; is $p->error->size, 7; like $p->error->last->to_string, qr/Failed creating internal return/ or diag explain $p->error->last; like $p->error->first->to_string, qr/Failed creating input pipe/ or diag explain $p->error->first; like @{$p->error}[2]->to_string, qr/Failed creating output error pipe/ or diag explain @{$p->error}[2]; like @{$p->error}[3]->to_string, qr/Failed creating Channel input pipe/ or diag explain @{$p->error}[3]; like @{$p->error}[4]->to_string, qr/Failed creating Channel output pipe/ or diag explain @{$p->error}[4]; like @{$p->error}[5]->to_string, qr/Failed creating internal error pipe/ or diag explain @{$p->error}[5]; like @{$p->error}[6]->to_string, qr/Failed creating internal return pipe/ or diag explain @{$p->error}[6]; }; subtest DESTROY => sub { my $q = queue(); $Mojo::IOLoop::ReadWriteProcess::Queue::AUTOLOAD = "Mojo::IOLoop::ReadWriteProcess::Queue::DESTROY"; $q->pool(parallel(sub { return 1 } => 30)); is $q->AUTOLOAD(), undef; }; subtest open => sub { sub Mojo::IOLoop::ReadWriteProcess::open3 { return undef } my $p = process(); { eval { $p->_open("/tmp") }; }; like $@, qr/Cannot create pipe:/ or diag explain $@; }; subtest _fork_collect_status => sub { use IO::Pipe; is Mojo::IOLoop::ReadWriteProcess::_fork_collect_status, undef, "Protect when self is already garbage-collected"; my $p = process(); my $end = IO::Pipe::End->new; $p->_internal_err($end); $p->_fork_collect_status(); is $p->error->first->to_string, 'Cannot read from errors code pipe'; }; subtest attempt => sub { my $var = 0; attempt(5, sub { $var == 5 }, sub { $var++ }); is $var, 5; $var = 0; attempt { attempts => 6, condition => sub { $var == 6 }, cb => sub { $var++ } }; is $var, 6; $var = 0; attempt { attempts => 6, condition => sub { $var == 7 }, cb => sub { $var++ }, or => sub { $var = 42 } }; is $var, 42; }; done_testing; 04_queues.t100644001750000144 1055113735070710 22172 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t#!/usr/bin/perl use warnings; use strict; use Test::More; use POSIX; use FindBin; use Mojo::File qw(tempfile path); use lib ("$FindBin::Bin/lib", "../lib", "lib"); use Mojo::IOLoop::ReadWriteProcess qw(queue process); use Mojo::IOLoop::ReadWriteProcess::Session; subtest queues => sub { my $q = queue; $q->pool->maximum_processes(3); $q->queue->maximum_processes(800); my $proc = 10; my $fired; my $i = 1; for (1 .. $proc) { $q->add(process(sub { shift; return shift() })->set_pipes(0)->args($i)); $i++; } my %output; $q->once( stop => sub { $fired++; $output{shift->return_status}++; }); is $q->queue->size, $proc - $q->pool->maximum_processes; is $q->pool->size, 3; is $q->pool->maximum_processes, 3; $q->consume; is $fired, $proc; is $q->queue->size, 0; is $q->pool->size, 0; is $q->done->size, $proc; $i = 1; for (1 .. $proc) { is $output{$i}, 1; $i++; } }; subtest test_2 => sub { my $q = queue; $q->pool->maximum_processes(2); $q->queue->maximum_processes(800); my $proc = 10; my $fired; my $i = 1; for (1 .. $proc) { $q->add(process(sub { shift; return shift() })->set_pipes(0)->args($i)); $i++; } my %output; $q->once( stop => sub { $fired++; $output{shift->return_status}++; }); is $q->queue->size, $proc - $q->pool->maximum_processes; is $q->pool->size, 2; is $q->pool->maximum_processes, 2; $q->consume; is $fired, $proc; is $q->queue->size, 0; is $q->pool->size, 0; is $q->done->size, $proc; $i = 1; for (1 .. $proc) { is $output{$i}, 1; $i++; } }; subtest atomic_queues => sub { my $q = queue; $q->pool->maximum_processes(1); $q->queue->maximum_processes(800); my $proc = 10; my $fired; my $i = 1; for (1 .. $proc) { $q->add(process(sub { shift; return shift() })->set_pipes(0)->args($i)); $i++; } my %output; $q->once( stop => sub { $fired++; $output{shift->return_status}++; }); is $q->queue->size, $proc - $q->pool->maximum_processes; is $q->pool->size, 1; is $q->pool->maximum_processes, 1; $q->consume; is $fired, $proc; is $q->queue->size, 0; is $q->pool->size, 0; is $q->done->size, $proc; $i = 1; for (1 .. $proc) { is $output{$i}, 1; $i++; } }; subtest test_3 => sub { my $q = queue(); $q->pool->maximum_processes(2); $q->queue->maximum_processes(100000); my $proc = 10; my $fired; my %output; my $i = 1; # Started as long as resources allows (maximum_processes of the main pool) # That requires then to subscribe for each process event's separately (manually) for (1 .. $proc) { my $p = process(sub { shift; return shift() + 42 })->set_pipes(0)->args($i); $p->once( stop => sub { $fired++; $output{shift->return_status}++; }); $q->add($p); $i++; } is $q->pool->maximum_processes, 2; $q->consume; is $q->queue->size, 0; is $q->pool->size, 0; is $q->done->size, $proc; is $fired, $proc; $i = 1; for (1 .. $proc) { is $output{$i + 42}, 1 or diag explain \%output; $i++; } }; is(Mojo::IOLoop::ReadWriteProcess::Session->singleton->all->size, 40); is(Mojo::IOLoop::ReadWriteProcess::Session->singleton->all_orphans->size, 0); subtest stress_test => sub { plan skip_all => "set STRESS_TEST=1 (be careful)" unless $ENV{STRESS_TEST}; Mojo::IOLoop::ReadWriteProcess::Session->singleton->reset; my $q = queue(); $q->pool->maximum_processes(50); $q->queue->maximum_processes(100000); my $proc = 200; my $fired; my %output; my $i = 1; # Started as long as resources allows (maximum_processes of the main pool) # That requires then to subscribe for each process event's separately (manually) for (1 .. $proc) { my $p = process(sub { shift; sleep 4; exit shift() })->set_pipes(0) ->internal_pipes(0)->args($i); $p->once( stop => sub { $fired++; $output{shift->exit_status}++; }); $q->add($p); $i++; } is $q->pool->maximum_processes, 50; $q->consume; is $q->queue->size, 0; is $q->pool->size, 0; is $q->done->size, $proc; is $fired, $proc; $i = 1; for (1 .. $proc) { is $output{$i}, 1 or diag explain \%output; $i++; } is(Mojo::IOLoop::ReadWriteProcess::Session->singleton->all->size, 200); }; done_testing; 05_serialize.t100644001750000144 67313735070710 22617 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t#!/usr/bin/perl use warnings; use strict; use Test::More; use POSIX; use FindBin; use lib ("$FindBin::Bin/lib", "../lib", "lib"); use Mojo::IOLoop::ReadWriteProcess qw(process queue); my $p = process( serialize => 1, set_pipes => 0, args => qw(12 13 14), code => sub { return qw(12 13 14); })->start(); $p->wait_stop(); is_deeply $p->return_status, [qw(12 13 14)] or diag explain $p->return_status; done_testing; 06_events.t100644001750000144 507313735070710 22154 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t#!/usr/bin/perl use warnings; use strict; use Test::More; use POSIX; use FindBin; use Mojo::File qw(tempfile path); use lib ("$FindBin::Bin/lib", "../lib", "lib"); use Mojo::IOLoop::ReadWriteProcess qw(process); use Mojo::IOLoop::ReadWriteProcess::Session qw(session); use Mojo::IOLoop::ReadWriteProcess::Test::Utils qw(attempt); subtest SIG_CHLD => sub { my $test_script = "$FindBin::Bin/data/process_check.sh"; plan skip_all => "You do not seem to have bash, which is required (as for now) for this test" unless -e '/bin/bash'; plan skip_all => "You do not seem to have $test_script. The script is required to run the test" unless -e $test_script; my $reached; my $collect = 0; my $p = process(sub { print "Hello\n" }); $p->session->collect_status(0); $p->on(collect_status => sub { $collect++ }); $p->session->on( SIG_CHLD => sub { my $self = shift; $reached++; waitpid $p->pid, 0; }); $p->start; attempt { attempts => 20, condition => sub { defined $reached && $reached == 1 }, cb => sub { $p->signal(POSIX::SIGTERM); sleep 1; } }; is $reached, 1, 'SIG_CHLD fired'; is $collect, 0, 'collect_status not fired'; is(Mojo::IOLoop::ReadWriteProcess::Session->singleton->all_orphans->size, 0); is(Mojo::IOLoop::ReadWriteProcess::Session->singleton->all->size, 1); session->reset; my $p2 = process(execute => $test_script); $p2->session->collect_status(1); $reached = 0; $p2->on( SIG_CHLD => sub { my $self = shift; $reached++; }); $p2->start; attempt { attempts => 20, condition => sub { defined $reached && $reached == 1 }, cb => sub { $p2->signal(POSIX::SIGTERM); sleep 1; } }; is $reached, 1, 'SIG_CHLD fired'; ok defined($p2->exit_status), 'SIG_CHLD fired'; is(Mojo::IOLoop::ReadWriteProcess::Session->singleton->all_orphans->size, 0); is(Mojo::IOLoop::ReadWriteProcess::Session->singleton->all->size, 1); }; subtest collect_status => sub { session->reset; my $sigcld; my $p = process(sub { print "Hello\n" }); $p->session->collect_status(0); $p->session->on( SIG_CHLD => sub { $sigcld++; waitpid $p->pid, 0; }); $p->start; attempt { attempts => 10, condition => sub { defined $sigcld && $sigcld == 1 }, cb => sub { $p->signal(POSIX::SIGTERM); sleep 1 } }; is $sigcld, 1, 'SIG_CHLD fired'; is(Mojo::IOLoop::ReadWriteProcess::Session->singleton->all_orphans->size, 0); is(Mojo::IOLoop::ReadWriteProcess::Session->singleton->all->size, 1); }; done_testing(); 07_autodetect.t100644001750000144 2703613735070710 23035 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t#!/usr/bin/perl use warnings; use strict; use Test::More; use POSIX; use FindBin; use Mojo::File qw(tempfile path); use lib ("$FindBin::Bin/lib", "../lib", "lib"); use Mojo::IOLoop::ReadWriteProcess::Test::Utils qw(attempt); use Mojo::IOLoop::ReadWriteProcess qw(process); use Mojo::IOLoop::ReadWriteProcess::Session; my $session = Mojo::IOLoop::ReadWriteProcess::Session->singleton; subtest autodetect => sub { local $SIG{CHLD}; my $reached; my $collect; my $status; my $fired; my $orphan2 = process(sub { print "Hello from first process\n"; sleep 1 })->start; my $orphan = process(sub { print "Hello from second process\n"; sleep 1 })->start; my $p = process( sub { print "Hello from master process\n"; sleep 2; return 2; }); my $orphans = 0; $session->on(collected => sub { $fired++ }); $session->on(collected_orphan => sub { $orphans++ }); $p->on(collect_status => sub { $status++ }); $p->start(); # If we just sleep and then exit, we won't be able to catch signals attempt { attempts => 10, condition => sub { defined $fired && $fired == 3 }, cb => sub { sleep 1 } }; $p->stop; is $status, 1, 'Status fired once'; is $session->all_processes->size, 3, 'detection works' or die diag explain $p; ok $session->contains($orphan->pid), 'Orphan collected' or die diag explain $p->session->all; ok $session->contains($orphan2->pid), 'Orphan collected'; ok !$session->contains(99999999), 'Session contain works as expected'; is $fired, 3, 'New subprocess event fired'; is $orphans, 0, 'New subprocess event fired'; is $p->return_status, 2, 'Got exit status from master'; $p->session->reset(); }; subtest autodetect_fork => sub { my $fired; my $status; local $SIG{CHLD}; $session->reset; $session->on(collected => sub { $fired++ }); $session->on(collected_orphan => sub { $status++ }); my $master_p = process(sub { exit 20 }); $master_p->start(); # Fork, and die after a bit my $pid = fork; die "Cannot fork: $!" unless defined $pid; if ($pid == 0) { sleep 2; exit 110 } $pid = fork; die "Cannot fork: $!" unless defined $pid; if ($pid == 0) { sleep 2; exit 110 } $pid = fork; die "Cannot fork: $!" unless defined $pid; if ($pid == 0) { sleep 2; exit 110 } $pid = fork; die "Cannot fork: $!" unless defined $pid; if ($pid == 0) { sleep 2; exit 110 } $pid = fork; die "Cannot fork: $!" unless defined $pid; if ($pid == 0) { sleep 2; exit 110 } $pid = fork; die "Cannot fork: $!" unless defined $pid; if ($pid == 0) { sleep 2; exit 110 } # If we just sleep and then exit, we won't be able to catch signals attempt { attempts => 20, condition => sub { defined $status && $status == 6 }, cb => sub { sleep 1 } }; $master_p->stop; is $master_p->exit_status, 20, 'Correct exit status from master process'; is $status, 6, 'Status fired 6 times'; is $fired, 1, 'Status fired 1 times'; is $session->all->size, 7, 'detection works' or die diag explain $master_p; $session->all_orphans->each( sub { is $_->exit_status, 110, 'Correct status from process ' . $_->pid }); }; subtest subreaper => sub { plan skip_all => "Skipped unless TEST_SUBREAPER is set" unless $ENV{TEST_SUBREAPER}; my $fired; my $status; my $orphans; local $SIG{CHLD}; my $sys; eval { $sys = $session->_prctl( Mojo::IOLoop::ReadWriteProcess::Session::PR_SET_CHILD_SUBREAPER(), 1); }; plan skip_all => "$@ : You do not seem to have subreaper capabilities" if ($@ || $sys != 0); $session->reset; my $master_p = process( sub { # Fork, and die after a bit my $pid = fork; die "Cannot fork: $!" unless defined $pid; if ($pid == 0) { sleep 2; exit 120 } $pid = fork; die "Cannot fork: $!" unless defined $pid; if ($pid == 0) { $pid = fork; die "Cannot fork: $!" unless defined $pid; if ($pid == 0) { sleep 2; exit 120 } exit 120; } $pid = fork; die "Cannot fork: $!" unless defined $pid; if ($pid == 0) { $pid = fork; die "Cannot fork: $!" unless defined $pid; if ($pid == 0) { $pid = fork; die "Cannot fork: $!" unless defined $pid; if ($pid == 0) { $pid = fork; die "Cannot fork: $!" unless defined $pid; if ($pid == 0) { sleep 2; exit 120 } sleep 2; exit 120; } exit 120; } exit 120; } }); $master_p->subreaper(1); $session->on(collected => sub { $fired++ }); $session->on(collected_orphan => sub { $orphans++ }); # On start we setup the current process as subreaper # So it's up on us to disable it after process is done. We can do that also when master process stops: # $master_p->on(stop => sub { shift()->disable_subreaper }); $master_p->start(); # If we just sleep and then exit, we won't be able to catch signals attempt { attempts => 20, condition => sub { defined $orphans && $orphans == 7 }, cb => sub { sleep 1 } }; $master_p->stop(); is $fired, 1, 'collect_status fired 8 times'; is $orphans, 7, 'new_subprocess fired 7 times'; is $session->all_orphans->size, 7, 'detection works' or die diag explain $master_p; $session->all_orphans->each( sub { is $_->exit_status, 120, 'Correct status from process ' . $_->pid }); $session->disable_subreaper; }; subtest subreaper_bash => sub { plan skip_all => "Skipped unless TEST_SUBREAPER is set" unless $ENV{TEST_SUBREAPER}; my $fired; my $status; my $orphans; local $SIG{CHLD}; $session->reset; my $sys; eval { $sys = $session->_prctl( Mojo::IOLoop::ReadWriteProcess::Session::PR_SET_CHILD_SUBREAPER(), 1); }; plan skip_all => "You do not seem to have subreaper capabilities" if ($@ || $sys != 0); my $test_script = "$FindBin::Bin/data/subreaper/master.sh"; plan skip_all => "You do not seem to have bash, which is required (as for now) for this test" unless -e '/bin/bash'; plan skip_all => "You do not seem to have $test_script. The script is required to run the test" unless -e $test_script; my $master_p = process( sub { exec($test_script); }); $master_p->subreaper(1); $session->on(collected => sub { $fired++ }); $session->on(collected_orphan => sub { $orphans++ }); $master_p->start(); is $master_p->subreaper, 1, 'We are subreaper'; # Goes to 0 if attempt was unsuccessful # If we just sleep and then exit, we won't be able to catch signals attempt { attempts => 20, condition => sub { defined $orphans && $orphans == 7 }, cb => sub { sleep 1 } }; $master_p->stop(); is $fired, 1, 'collect_status fired 8 times'; is $orphans, 7, 'new_subprocess fired 7 times'; is $session->all_orphans->size, 7, 'detection works' or die diag explain $master_p; $session->disable_subreaper; }; subtest subreaper_bash_execute => sub { my $fired; my $status; local $SIG{CHLD}; $session->reset; my $sys; eval { $sys = $session->_prctl( Mojo::IOLoop::ReadWriteProcess::Session::PR_SET_CHILD_SUBREAPER(), 1); }; plan skip_all => "You do not seem to have subreaper capabilities" if ($@ || $sys != 0); my $test_script = "$FindBin::Bin/data/subreaper/master.sh"; plan skip_all => "You do not seem to have bash, which is required (as for now) for this test" unless -e '/bin/bash'; plan skip_all => "You do not seem to have $test_script. The script is required to run the test" unless -e $test_script; my $master_p = process(execute => $test_script, detect_subprocess => 1, subreaper => 1); my $orphans; $session->on(collected => sub { $status++ }); $session->on(collected_orphan => sub { $orphans++ }); $master_p->start(); is $master_p->subreaper, 1, 'We are subreaper'; # If we just sleep and then exit, we won't be able to catch signals attempt { attempts => 20, condition => sub { defined $orphans && $orphans == 7 }, cb => sub { sleep 1 } }; $master_p->stop(); is $status, 1, 'collect_status fired 1 times'; is $orphans, 7, 'new_subprocess fired 7 times'; is $session->all_orphans->size, 7, 'detection works' or die diag explain $master_p; $session->disable_subreaper; }; subtest manager => sub { my $fired; my $status; local $SIG{CHLD}; $session->reset; my $sys; eval { $sys = $session->_prctl( Mojo::IOLoop::ReadWriteProcess::Session::PR_SET_CHILD_SUBREAPER(), 1); }; plan skip_all => "You do not seem to have subreaper capabilities" if ($@ || $sys != 0); 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(); # If we just sleep and then exit, we won't be able to catch signals attempt { attempts => 20, condition => sub { defined $status && $status == 1 }, cb => sub { sleep 1 } }; $master_p->stop(); is $status, 1, 'collect_status fired 1 times'; is $session->all_orphans->size, 0, 'isolation works' or die diag explain $master_p; is $session->all->size, 1, 'isolation works' or die diag explain $master_p; is $master_p->return_status, 6, 'detection works, 6 processes in total finished or died' or die diag explain $master_p; $session->disable_subreaper; }; subtest subreaper_bash_roulette => sub { my $fired; my $status; local $SIG{CHLD}; $session->reset; my $sys; eval { $sys = $session->_prctl( Mojo::IOLoop::ReadWriteProcess::Session::PR_SET_CHILD_SUBREAPER(), 1); }; plan skip_all => "You do not seem to have subreaper capabilities" if ($@ || $sys != 0); my $test_script = "$FindBin::Bin/data/subreaper/roulette.sh"; plan skip_all => "You do not seem to have bash, which is required (as for now) for this test" unless -e '/bin/bash'; plan skip_all => "You do not seem to have $test_script. The script is required to run the test" unless -e $test_script; # In this tests the bash scripts are going to create child processes and then die immediately my $master_p = process(execute => $test_script); $master_p->subreaper(1); my $orphans; $session->on(collected => sub { $fired++ }); $session->on(collected_orphan => sub { $orphans++ }); $master_p->start(); is $master_p->subreaper, 1, 'We are subreaper'; # Goes to 0 if attempt was unsuccessful # If we just sleep and then exit, we won't be able to catch signals attempt { attempts => 20, condition => sub { defined $orphans && $orphans == 8 }, cb => sub { sleep 1 } }; $master_p->stop(); is $fired, 1, 'collect_status fired 8 times'; is $orphans, 8, 'new_subprocess fired 7 times'; is $session->all_orphans->size, 8, 'detection works' or die diag explain $master_p; is $master_p->exit_status, '1', 'Correct master process exit status'; $session->disable_subreaper; }; done_testing(); 08_ioloop.t100644001750000144 216113735070710 22146 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t#!/usr/bin/perl use warnings; use strict; use Test::More; use POSIX; use FindBin; 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); use Mojo::IOLoop; subtest to_ioloop => sub { my $p = process(sub { print "Hello from first process\n"; sleep 1; exit 70 }); $p->start(); # Start and sets the handlers my $stream = $p->to_ioloop; # Get the stream my $output; $stream->on( read => sub { $output .= pop; is $p->is_running, 1, 'Process is running!' } ); # Hook on Mojo::IOLoop::Stream events Mojo::IOLoop->singleton->start() unless Mojo::IOLoop->singleton->is_running; attempt { attempts => 10, condition => sub { $p->is_running == 0 }, cb => sub { sleep 1 } }; is $p->is_running, 0, 'Process is not running anymore'; is $p->exit_status, 70, 'We got exit status'; ok !$p->errored, 'No error from the process'; is $output, "Hello from first process\n", 'Got correct output from process'; }; done_testing(); 09_session.t100644001750000144 470013735070710 22332 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t#!/usr/bin/perl use warnings; use strict; use Test::More; use POSIX; use FindBin; 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); use Mojo::IOLoop; use Mojo::IOLoop::ReadWriteProcess::Session qw(session); subtest register => sub { my $s = session; my $p = process(sub { }); $s->register(1 => $p); is_deeply ${$s->process_table()->{1}}, $p, 'Equal' or die diag explain $s; ${$s->process_table()->{1}}->{foo} = 'bar'; is $p->{foo}, 'bar'; session->resolve(1)->{foo} = 'kaboom'; is $p->{foo}, 'kaboom'; }; subtest unregister => sub { session->clean(); my $p = process(sub { }); session->register(1 => $p); is_deeply ${session->process_table()->{1}}, $p, 'Equal' or die diag explain session(); session->unregister(1); is session->all()->size, 0; is session->resolve(1), undef; session->register(1 => $p); is session->all()->size, 1; session->clean(); is session->all()->size, 0; }; subtest disable => sub { local $SIG{CHLD} = 'DEFAULT'; session->enable(); is session->handler, 'DEFAULT', 'previous handler saved'; isnt $SIG{CHLD}, 'DEFAULT', 'Handler has changed'; session->disable(); is $SIG{CHLD}, 'DEFAULT', 'handler restored'; }; subtest reset => sub { session->reset; session->register(1 => process(sub { })); session->register(2 => process(sub { })); session->register(3 => process(sub { })); session->orphans->{5} = 1; is session->all->size, 4, 'There are 4 processes'; session->reset(); is session->all->size, 0, 'Reset cleaned up processes'; session->on(foo => sub { 'bar' }); is((values %{session->{events}}), 1, '1 event is present'); session->reset(); is((values %{session->{events}}), 0, '0 events are present'); }; subtest protect => sub { my $handler; session->on(protect => sub { shift; $handler = pop @{shift()} }); session->protect(sub { }); is $handler, SIGCHLD; Mojo::IOLoop::ReadWriteProcess::Session->new->protect(sub { }); is $handler, SIGCHLD; Mojo::IOLoop::ReadWriteProcess::Session::protect(sub { }); is $handler, SIGCHLD; session->protect(sub { } => SIGTERM); is $handler, SIGTERM; Mojo::IOLoop::ReadWriteProcess::Session->new->protect(sub { } => SIGTERM); is $handler, SIGTERM; Mojo::IOLoop::ReadWriteProcess::Session::protect(sub { } => SIGTERM); is $handler, SIGTERM; }; done_testing(); 10_cgroupv1.t100644001750000144 4266313735070710 22437 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t#!/usr/bin/perl use warnings; use strict; use Test::More; use POSIX; use FindBin; use Mojo::File qw(tempfile tempdir path); use lib ("$FindBin::Bin/lib", "../lib", "lib"); BEGIN { $ENV{MOJO_CGROUP_FS} = tempdir() } use Mojo::IOLoop::ReadWriteProcess qw(process); use Mojo::IOLoop::ReadWriteProcess::Test::Utils qw(attempt); use Mojo::IOLoop; use Mojo::IOLoop::ReadWriteProcess::CGroup qw(cgroupv1); subtest mock => sub { my $cgroup = cgroupv1(name => "foo"); isa_ok $cgroup, 'Mojo::IOLoop::ReadWriteProcess::CGroup::v1'; my $child_cgroup = $cgroup->child('bar'); $child_cgroup->create(); ok $child_cgroup->exists, 'Child cgroup exists'; ok -d $child_cgroup->_cgroup, 'Folder is created'; $child_cgroup->remove; is $child_cgroup->exists, undef, 'Child group does not exist anymore'; ok $cgroup->exists, 'Parent CGroup exists'; ok -d $cgroup->_cgroup, 'Parent CGroup folder exists'; ok $cgroup->_cgroup ne $child_cgroup->_cgroup, 'Child and parent has different CGroup path' or diag explain [$cgroup, $child_cgroup]; $cgroup->remove; is $cgroup->exists, undef, 'Parent group does not exist anymore'; $child_cgroup->create(); $child_cgroup->add_process("3"); $child_cgroup->add_process("5"); is $child_cgroup->process_list, "3\n5\n", "procs interface contains the added pids" or die diag explain $child_cgroup->process_list; ok $child_cgroup->contains_process("3"), "Child contains pid 3"; ok $child_cgroup->contains_process("5"), "Child contains pid 5"; ok !$child_cgroup->contains_process("10"), "Child does not contain pid 10"; ok !$child_cgroup->contains_process("20"), "Child does not contain pid 20"; $cgroup->create(); $cgroup->add_process("30"); $cgroup->add_process("50"); is $cgroup->process_list, "30\n50\n", "procs interface contains the added pids" or die diag explain $cgroup->process_list; ok $cgroup->contains_process("30"), "Parent contains pid 30"; ok $cgroup->contains_process("50"), "Parent contains pid 50"; ok !$cgroup->contains_process("3"), "Parent does not contain pid 3"; ok !$cgroup->contains_process("5"), "Parent does not contain pid 5"; $cgroup->create(); $cgroup->add_thread("20"); $cgroup->add_thread("40"); is $cgroup->thread_list, "20\n40\n", "thread interface contains the added threads ID" or die diag explain $cgroup->thread_list; ok $cgroup->contains_thread("20"), "Parent contains thread ID 20"; ok $cgroup->contains_thread("40"), "Parent contains thread ID 40"; ok !$cgroup->contains_thread("30"), "Parent does not contain thread ID 30"; ok !$cgroup->contains_thread("50"), "Parent does not contain thread ID 50"; $cgroup->pid->max('6'); is $cgroup->pid->max, '6', 'Correct pid.max set'; my $cgroup2 = cgroupv1->from(path($ENV{MOJO_CGROUP_FS}, 'test', 'test2', 'test3')); is $cgroup2->name, 'test2', "Cgroup name matches"; is $cgroup2->controller, 'test', "Cgroup controller matches"; is $cgroup2->parent, 'test3', "Cgroup controller matches"; is $cgroup2->_cgroup, path($ENV{MOJO_CGROUP_FS}, 'test', 'test2', 'test3')->to_string; }; sub mockwrite { my $c = shift; $c->cgroup->_cgroup->child(shift)->spurt(shift); } subtest dev_freez_pid_rdma_controller => sub { my $devices = cgroupv1(name => "foo", controller => 'devices'); my $freezer = cgroupv1(name => "foo", controller => 'freezer'); my $pid = cgroupv1(name => "foo", controller => 'pids'); my $rdma = cgroupv1(name => "foo", controller => 'rdma'); my $devices_controller = $devices->devices; my $freezer_controller = $freezer->freezer; my $pid_controller = $pid->pid; my $rdma_controller = $rdma->rdma; $devices_controller->allow('foo'); $devices_controller->deny('bar'); is $devices_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Devices::DEVICES_ALLOW_INTERFACE( ))->slurp, 'foo'; is $devices_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Devices::DEVICES_DENY_INTERFACE( ))->slurp, 'bar'; $freezer_controller->state('THAW'); is $freezer_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Freezer::STATE_INTERFACE()) ->slurp, 'THAW'; is $freezer_controller->state, 'THAW'; mockwrite( $freezer_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Freezer::SELF_FREEZING_INTERFACE( ) => 'foo' ); is $freezer_controller->self_freezing, 'foo'; mockwrite( $freezer_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Freezer::PARENT_FREEZING_INTERFACE( ) => 'bar' ); is $freezer_controller->parent_freezing, 'bar'; mockwrite($pid_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::PID::CURRENT_INTERFACE() => '42'); is $pid_controller->current, '42'; $pid_controller->max('BAR'); is $pid_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::PID::MAX_INTERFACE())->slurp, 'BAR'; is $pid_controller->max, 'BAR'; mockwrite($rdma_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v2::RDMA::CURRENT_INTERFACE() => '42'); is $rdma_controller->current, '42'; $rdma_controller->max('BAR'); is $rdma_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v2::RDMA::MAX_INTERFACE())->slurp, 'BAR'; is $rdma_controller->max, 'BAR'; }; subtest memory_net_controller => sub { my $memory = cgroupv1(name => "foo", controller => 'memory'); my $netcls = cgroupv1(name => "foo", controller => 'netcls'); my $netprio = cgroupv1(name => "foo", controller => 'netprio'); my $memory_controller = $memory->memory; my $netcls_controller = $netcls->netcls; my $netprio_controller = $netprio->netprio; mockwrite($memory_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::CURRENT_INTERFACE( ) => 'boo'); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::CURRENT_INTERFACE()) ->slurp, 'boo'; is $memory_controller->current, 'boo'; mockwrite($memory_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::STAT_INTERFACE() => 'foo'); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::STAT_INTERFACE()) ->slurp, 'foo'; is $memory_controller->stat, 'foo'; mockwrite( $memory_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::CURRENT_AND_SWAP_INTERFACE( ) => 'bar' ); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::CURRENT_AND_SWAP_INTERFACE( ))->slurp, 'bar'; is $memory_controller->swap_current, 'bar'; mockwrite($memory_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::FAILCNT_INTERFACE( ) => '42'); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::FAILCNT_INTERFACE()) ->slurp, '42'; is $memory_controller->failcnt, '42'; mockwrite( $memory_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::MAX_RECORDED_INTERFACE( ) => 'baz' ); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::MAX_RECORDED_INTERFACE( ))->slurp, 'baz'; is $memory_controller->observed_max_usage, 'baz'; mockwrite( $memory_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::MAX_RECORDED_AND_SWAP_INTERFACE( ) => 'baz' ); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::MAX_RECORDED_AND_SWAP_INTERFACE( ))->slurp, 'baz'; is $memory_controller->observed_swap_max_usage, 'baz'; mockwrite( $memory_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::KMEM_TCP_USAGE_INTERFACE( ) => 'baz' ); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::KMEM_TCP_USAGE_INTERFACE( ))->slurp, 'baz'; is $memory_controller->kmem_tcp_usage, 'baz'; mockwrite( $memory_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::KMEM_TCP_FAILCNT_INTERFACE( ) => 'baz' ); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::KMEM_TCP_FAILCNT_INTERFACE( ))->slurp, 'baz'; is $memory_controller->kmem_tcp_failcnt, 'baz'; mockwrite( $memory_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::KMEM_TCP_MAX_USAGE_INTERFACE( ) => 'baz' ); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::KMEM_TCP_MAX_USAGE_INTERFACE( ))->slurp, 'baz'; is $memory_controller->kmem_tcp_max_usage, 'baz'; mockwrite( $memory_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::KMEM_USAGE_INTERFACE( ) => 'baz' ); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::KMEM_USAGE_INTERFACE()) ->slurp, 'baz'; is $memory_controller->kmem_usage, 'baz'; mockwrite( $memory_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::KMEM_FAILCNT_INTERFACE( ) => 'baz' ); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::KMEM_FAILCNT_INTERFACE( ))->slurp, 'baz'; is $memory_controller->kmem_failcnt, 'baz'; mockwrite( $memory_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::KMEM_MAX_RECORDED_INTERFACE( ) => 'baz' ); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::KMEM_MAX_RECORDED_INTERFACE( ))->slurp, 'baz'; is $memory_controller->kmem_max_usage, 'baz'; mockwrite($memory_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::NUMA_STAT_INTERFACE( ) => 'baz'); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::NUMA_STAT_INTERFACE()) ->slurp, 'baz'; is $memory_controller->numa_stat, 'baz'; $memory_controller->limit('boo'); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::LIMIT_INTERFACE()) ->slurp, 'boo'; is $memory_controller->limit, 'boo'; $memory_controller->use_hierarchy('boo'); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::USE_HIERARCHY_INTERFACE( ))->slurp, 'boo'; is $memory_controller->use_hierarchy, 'boo'; $memory_controller->soft_limit('boo'); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::SOFT_LIMIT_INTERFACE()) ->slurp, 'boo'; is $memory_controller->soft_limit, 'boo'; $memory_controller->force_empty('boo'); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::FORCE_EMPTY_INTERFACE()) ->slurp, 'boo'; is $memory_controller->force_empty, 'boo'; $memory_controller->pressure_level('boo'); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::PRESSURE_LEVEL_INTERFACE( ))->slurp, 'boo'; is $memory_controller->pressure_level, 'boo'; $memory_controller->swappiness('22233'); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::SWAPPINESS_INTERFACE()) ->slurp, '22233'; is $memory_controller->swappiness, '22233'; $memory_controller->move_charge('433'); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::MOVE_CHARGE_AT_IMMIGRATE_INTERFACE( ))->slurp, '433'; is $memory_controller->move_charge, '433'; $memory_controller->oom_control('433'); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::OOM_CONTROL_INTERFACE()) ->slurp, '433'; is $memory_controller->oom_control, '433'; $memory_controller->kmem_limit('433'); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::KMEM_LIMIT_INTERFACE()) ->slurp, '433'; is $memory_controller->kmem_limit, '433'; $memory_controller->kmem_tcp_limit('433'); is $memory_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Memory::KMEM_TCP_LIMIT_INTERFACE( ))->slurp, '433'; is $memory_controller->kmem_tcp_limit, '433'; $netcls_controller->classid('boo'); is $netcls_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Netcls::CLASSID_INTERFACE()) ->slurp, 'boo'; is $netcls_controller->classid, 'boo'; $netprio_controller->ifpriomap('boo'); is $netprio_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Netprio::IFPRIOMAP_INTERFACE()) ->slurp, 'boo'; is $netprio_controller->ifpriomap, 'boo'; mockwrite($netprio_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Netprio::PRIOIDX_INTERFACE( ) => 'foo'); is $netprio_controller->prioidx, 'foo'; }; subtest cpu_controller => sub { # Initialize controllers my $cpuset = cgroupv1(name => "foo", controller => 'cpuset'); my $cpuacct = cgroupv1(name => "foo", controller => 'cpuacct'); my $cpuacct_controller = $cpuacct->cpuacct; my $cpuset_controller = $cpuset->cpuset; mockwrite($cpuacct_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuacct::USAGE_INTERFACE() => 'foo'); is $cpuacct_controller->usage, 'foo'; # cpuset mockwrite( $cpuset_controller => Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::MEM_PRESSURE_INTERFACE( ) => 'foobar' ); is $cpuset_controller->get_memory_pressure, 'foobar'; $cpuset_controller->cpus('3'); $cpuset_controller->mems('30'); $cpuset_controller->memory_migrate(1); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::MEMORY_MIGRATE_INTERFACE( ))->slurp, '1'; $cpuset_controller->memory_migrate(0); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::MEMORY_MIGRATE_INTERFACE( ))->slurp, '0'; $cpuset_controller->cpu_exclusive(1); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::CPU_EXCLUSIVE_INTERFACE( ))->slurp, '1'; $cpuset_controller->cpu_exclusive(0); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::CPU_EXCLUSIVE_INTERFACE( ))->slurp, '0'; $cpuset_controller->mem_exclusive(1); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::MEM_EXCLUSIVE_INTERFACE( ))->slurp, '1'; $cpuset_controller->mem_exclusive(0); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::MEM_EXCLUSIVE_INTERFACE( ))->slurp, '0'; $cpuset_controller->mem_hardwall(1); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::MEM_HARDWALL_INTERFACE( ))->slurp, '1'; $cpuset_controller->mem_hardwall(0); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::MEM_HARDWALL_INTERFACE( ))->slurp, '0'; $cpuset_controller->memory_spread_page(1); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::MEM_SPREAD_PAGE_INTERFACE( ))->slurp, '1'; $cpuset_controller->memory_spread_page(0); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::MEM_SPREAD_PAGE_INTERFACE( ))->slurp, '0'; $cpuset_controller->memory_pressure(1); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::MEMORY_PRESSURE_ENABLED_INTERFACE( ))->slurp, '1'; $cpuset_controller->memory_pressure(0); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::MEMORY_PRESSURE_ENABLED_INTERFACE( ))->slurp, '0'; $cpuset_controller->sched_relax_domain_level(1); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::SCHED_RELAX_DOMAIN_LEVEL_INTERFACE( ))->slurp, '1'; $cpuset_controller->sched_relax_domain_level(0); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::SCHED_RELAX_DOMAIN_LEVEL_INTERFACE( ))->slurp, '0'; $cpuset_controller->sched_load_balance(1); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::SCHED_LOAD_BALANCE_INTERFACE( ))->slurp, '1'; $cpuset_controller->sched_load_balance(0); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::SCHED_LOAD_BALANCE_INTERFACE( ))->slurp, '0'; $cpuset_controller->memory_spread_slab(1); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::MEM_SPREAD_SLAB_INTERFACE( ))->slurp, '1'; $cpuset_controller->memory_spread_slab(0); is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::MEM_SPREAD_SLAB_INTERFACE( ))->slurp, '0'; is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::CPUS_INTERFACE()) ->slurp, '3'; is $cpuset_controller->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v1::Cpuset::MEMS_INTERFACE()) ->slurp, '30'; }; done_testing; 10_cgroupv2.t100644001750000144 1730013735070710 22426 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t#!/usr/bin/perl use warnings; use strict; use Test::More; use POSIX; use FindBin; use Mojo::File qw(tempfile tempdir path); use lib ("$FindBin::Bin/lib", "../lib", "lib"); BEGIN { $ENV{MOJO_CGROUP_FS} = tempdir() } use Mojo::IOLoop::ReadWriteProcess qw(process); use Mojo::IOLoop::ReadWriteProcess::Test::Utils qw(attempt); use Mojo::IOLoop; use Mojo::IOLoop::ReadWriteProcess::CGroup qw(cgroupv2); subtest mock => sub { my $cgroup = cgroupv2(name => "foo"); isa_ok $cgroup, 'Mojo::IOLoop::ReadWriteProcess::CGroup::v2'; my $child_cgroup = $cgroup->child('bar'); $child_cgroup->create(); ok $child_cgroup->exists, 'Child cgroup exists'; ok -d $child_cgroup->_cgroup, 'Folder is created'; $child_cgroup->remove; is $child_cgroup->exists, undef, 'Child group does not exist anymore'; ok $cgroup->exists, 'Parent CGroup exists'; ok -d $cgroup->_cgroup, 'Parent CGroup folder exists'; ok $cgroup->_cgroup ne $child_cgroup->_cgroup, 'Child and parent has different CGroup path' or diag explain [$cgroup, $child_cgroup]; $cgroup->remove; is $cgroup->exists, undef, 'Parent group does not exist anymore'; $child_cgroup->create(); $child_cgroup->add_process("3"); $child_cgroup->add_process("5"); is $child_cgroup->process_list, "3\n5\n", "procs interface contains the added pids" or die diag explain $child_cgroup->process_list; ok $child_cgroup->contains_process("3"), "Child contains pid 3"; ok $child_cgroup->contains_process("5"), "Child contains pid 5"; ok !$child_cgroup->contains_process("10"), "Child does not contain pid 10"; ok !$child_cgroup->contains_process("20"), "Child does not contain pid 20"; $cgroup->create(); $cgroup->add_process("30"); $cgroup->add_process("50"); is $cgroup->process_list, "30\n50\n", "procs interface contains the added pids" or die diag explain $cgroup->process_list; is $cgroup->processes->first, 30, 'first process has pid 30'; is $cgroup->processes->last, 50, 'last process has pid 50'; ok $cgroup->contains_process("30"), "Parent contains pid 30"; ok $cgroup->contains_process("50"), "Parent contains pid 50"; ok !$cgroup->contains_process("3"), "Parent does not contain pid 3"; ok !$cgroup->contains_process("5"), "Parent does not contain pid 5"; $cgroup->type('test'); is $cgroup->type, 'test', 'Correct CGroup type set'; ok -e $cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v2::TYPE_INTERFACE()), 'CGroup type interface exists'; is $cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v2::TYPE_INTERFACE())->slurp, 'test', 'CGroup type interface is correct'; $cgroup->create(); $cgroup->add_thread("20"); $cgroup->add_thread("40"); is $cgroup->thread_list, "20\n40\n", "thread interface contains the added threads ID" or die diag explain $cgroup->thread_list; ok $cgroup->contains_thread("20"), "Parent contains thread ID 20"; ok $cgroup->contains_thread("40"), "Parent contains thread ID 40"; ok !$cgroup->contains_thread("30"), "Parent does not contain thread ID 30"; ok !$cgroup->contains_thread("50"), "Parent does not contain thread ID 50"; is $cgroup->populated, undef, 'Not populated - mocked test'; # We are mocking $cgroup->subtree_control('+cpu +memory -io'); is $cgroup->subtree_control, '+cpu +memory -io', 'Correct CGroup type set'; ok -e $cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v2::SUBTREE_CONTROL_INTERFACE()), 'CGroup controllers interface exists'; is $cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v2::SUBTREE_CONTROL_INTERFACE()) ->slurp, '+cpu +memory -io', 'CGroup controllers interface is correct'; $cgroup->io->max('20'); is $cgroup->io->max, '20', 'Correct io.max set'; $cgroup->io->weight('30'); is $cgroup->io->weight, '30', 'Correct io.weight set'; $cgroup->io->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v2::IO::STAT_INTERFACE()) ->spurt('20'); is $cgroup->io->stat, '20', 'Correct io.max set'; $cgroup->cpu->max('30'); is $cgroup->cpu->max, '30', 'Correct cpu.max set'; $cgroup->cpu->weight('40'); is $cgroup->cpu->weight, '40', 'Correct cpu.weight set'; $cgroup->cpu->weight_nice('42'); is $cgroup->cpu->weight_nice, '42', 'Correct cpu.weight_nice set'; $cgroup->cpu->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v2::CPU::STAT_INTERFACE()) ->spurt('20'); is $cgroup->cpu->stat, '20', 'Correct cpu.stat set'; $cgroup->memory->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v2::Memory::EVENTS_INTERFACE()) ->spurt('230'); is $cgroup->memory->events, '230', 'Correct memory.events set'; $cgroup->memory->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v2::Memory::STAT_INTERFACE()) ->spurt('333'); is $cgroup->memory->stat, '333', 'Correct memory.stat set'; $cgroup->memory->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v2::Memory::CURRENT_INTERFACE()) ->spurt('foo'); is $cgroup->memory->current, 'foo', 'Correct memory.stat set'; $cgroup->memory->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v2::Memory::SWAP_CURRENT_INTERFACE( ))->spurt('bar'); is $cgroup->memory->swap_current, 'bar', 'Correct memory.stat set'; $cgroup->memory->max('4'); is $cgroup->memory->max, '4', 'Correct memory.max set'; $cgroup->memory->low('42'); is $cgroup->memory->low, '42', 'Correct memory.low set'; $cgroup->memory->swap_max('111'); is $cgroup->memory->swap_max, '111', 'Correct memory.swap_max set'; $cgroup->memory->high('420'); is $cgroup->memory->high, '420', 'Correct memory.high set'; $cgroup->rdma->max('5'); is $cgroup->rdma->max, '5', 'Correct rdma.max set'; $cgroup->pid->max('6'); is $cgroup->pid->max, '6', 'Correct pid.max set'; $cgroup->pid->cgroup->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v2::PID::CURRENT_INTERFACE()) ->spurt('test'); is $cgroup->pid->current, 'test', 'Can get cgroup max'; my $cgroup2 = cgroupv2->from(path($ENV{MOJO_CGROUP_FS}, 'test', 'test2', 'test3')) ->create; is $cgroup2->name, 'test', "Cgroup name matches"; is $cgroup2->parent, 'test2/test3', "Cgroup parent matches"; is $cgroup2->_cgroup, path($ENV{MOJO_CGROUP_FS}, 'test', 'test2', 'test3')->to_string, 'Cgroup path matches'; my $cgroup3 = cgroupv2->from(path('/test', 'test2', 'test3'))->create; is $cgroup3->name, 'test', "Cgroup name matches"; is $cgroup3->parent, 'test2/test3', "Cgroup parent matches"; is $cgroup3->_cgroup, path($ENV{MOJO_CGROUP_FS}, 'test', 'test2', 'test3')->to_string, 'Cgroup path matches'; my $cgroup4 = cgroupv2->from(path('test', 'test2', 'test3'))->create; is $cgroup4->name, 'test', "Cgroup name matches"; is $cgroup4->parent, 'test2/test3', "Cgroup parent matches"; is $cgroup4->_cgroup, path($ENV{MOJO_CGROUP_FS}, 'test', 'test2', 'test3')->to_string, 'Cgroup path matches'; $cgroup2->controllers('+io +cpu'); is $cgroup2->controllers, '+io +cpu', 'Controllers set correctly'; $cgroup2->max_descendants('20'); is $cgroup2->max_descendants, '20', 'max_descendants set correctly'; $cgroup2->max_depths('30'); is $cgroup2->max_depths, '30', 'max_depths set correctly'; $cgroup2->_cgroup->child( Mojo::IOLoop::ReadWriteProcess::CGroup::v2::STAT_INTERFACE()) ->spurt('test'); is $cgroup2->stat, 'test', 'Can get cgroup stats'; $cgroup2 = cgroupv2->from(path($ENV{MOJO_CGROUP_FS}, 'test', 'test2', 'test3')); is $cgroup2->name, 'test', "Cgroup name matches"; is $cgroup2->parent, 'test2/test3', "Cgroup controller matches"; is $cgroup2->_cgroup, path($ENV{MOJO_CGROUP_FS}, 'test', 'test2', 'test3')->to_string; }; done_testing; 11_containers.t100644001750000144 1477413735070710 23041 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t#!/usr/bin/perl use warnings; use strict; use Test::More; use POSIX; use FindBin; use Mojo::File qw(tempfile tempdir path); use lib ("$FindBin::Bin/lib", "../lib", "lib"); use Mojo::IOLoop::ReadWriteProcess qw(process); use Mojo::IOLoop::ReadWriteProcess::Test::Utils qw(attempt); use Mojo::IOLoop::ReadWriteProcess::CGroup qw(cgroupv2 cgroupv1); use Mojo::IOLoop::ReadWriteProcess::Container qw(container); eval { my $try_cgroup = cgroupv1(controller => 'pids', name => 'group')->child('test')->create; die unless $try_cgroup->exists(); }; plan skip_all => "This test works only if you have cgroups permissions" if $@; subtest belongs => sub { cgroupv1(controller => 'pids', name => 'group')->create; my $cgroup = cgroupv1(controller => 'pids', name => 'group')->child('test'); isa_ok $cgroup, 'Mojo::IOLoop::ReadWriteProcess::CGroup::v1'; my $p = process(sub { sleep 400 }); $p->start(); $cgroup->add_process($p->pid); is $cgroup->process_list, $p->pid . "\n", "procs interface contains the added pids" or diag explain $cgroup->process_list; ok $cgroup->contains_process($p->pid), "Parent contains pid " . $p->pid; $p->stop(); is $p->is_running, 0; attempt { attempts => 20, condition => sub { $cgroup->process_list eq '' }, cb => sub { sleep 1; } }; is $cgroup->process_list, ''; $cgroup->remove(); ok !$cgroup->exists(); }; subtest childs => sub { my $cgroup = cgroupv1(controller => 'pids', name => 'group')->child('test'); isa_ok $cgroup, 'Mojo::IOLoop::ReadWriteProcess::CGroup::v1'; is $cgroup->exists(), 1, 'Cgroup exists'; my $p = process( sub { process(sub { sleep 400 })->start; sleep 400; }); $p->start(); $cgroup->add_process($p->pid); is $cgroup->process_list, $p->pid . "\n", "procs interface contains the added pids" or diag explain $cgroup->process_list; ok $cgroup->contains_process($p->pid), "Parent contains pid " . $p->pid; attempt { attempts => 20, condition => sub { $cgroup->processes->size == 2 }, cb => sub { sleep 1; } }; $p->stop(); is $p->is_running, 0; is $cgroup->pid->current, "1\n"; process(process_id => $_, blocking_stop => 1)->stop() for $cgroup->processes->each; is $cgroup->process_list, '' or diag explain $cgroup->process_list; $cgroup->remove(); ok !$cgroup->exists(); }; subtest container_pid_isolation => sub { plan skip_all => "This test works only if you are root" if ($< != "0"); if ($ENV{MOJO_PROCESS_DEBUG} eq "1") { local $ENV{MOJO_PROCESS_DEBUG} = 0; # It will change our container output otherwise :( delete $INC{'Mojo/IOLoop/ReadWriteProcess.pm'}; eval "no warnings; require Mojo::IOLoop::ReadWriteProcess"; ## no critic } my $c = container( pid_isolation => 1, subreaper => 1, group => "group", name => "test", process => process( sub { print "$$\n"; process(sub { warn "Hey"; sleep 400; warn "Hey"; })->start; process(sub { warn "Hey"; sleep 400; warn "Hey"; })->start; process( sub { process( sub { process(sub { warn "Hey"; sleep 400; warn "Hey"; })->start; warn "Hey"; sleep 400; warn "Hey"; })->start; warn "Hey"; sleep 400; warn "Hey"; })->start; sleep 400; } )->separate_err(0)); $c->start(); my @pids; my $fired; $c->session->on(register => sub { push(@pids, shift) }); $c->process->on(collected => sub { $fired++ }); $c->once(stop => sub { $fired++ }); my $p = $c->process(); my $cgroups = $c->cgroups; is $cgroups->first->process_list, $p->pid . "\n", "procs interface contains the added pids" or diag explain $cgroups->first->process_list; ok $cgroups->first->contains_process($p->pid), "Parent contains pid " . $p->pid; my $virtual_pid; while (defined(my $line = $c->process->getline())) { $virtual_pid = $line; } chomp($virtual_pid); attempt { attempts => 20, condition => sub { $cgroups->first->processes->size == 7 }, cb => sub { sleep 1; } }; $c->stop(); is $cgroups->first->process_list, '' or die diag explain $cgroups->first->process_list; $cgroups->first->remove(); is scalar(@pids), 6 or diag explain \@pids; is $virtual_pid, '1', "Running process was PID 1 inside container"; ok !$cgroups->first->exists(); is $fired, 2; }; subtest container_no_pid_isolation => sub { if ($ENV{MOJO_PROCESS_DEBUG} eq "1") { local $ENV{MOJO_PROCESS_DEBUG} = 0; # It will change our container output otherwise :( delete $INC{'Mojo/IOLoop/ReadWriteProcess.pm'}; eval "no warnings; require Mojo::IOLoop::ReadWriteProcess"; ## no critic } my $c = container( pid_isolation => 0, subreaper => 1, group => "group", name => "test", process => process( sub { print "$$\n"; process(sub { warn "Hey"; sleep 400; warn "Hey"; })->start; process(sub { warn "Hey"; sleep 400; warn "Hey"; })->start; process( sub { process( sub { process(sub { warn "Hey"; sleep 400; warn "Hey"; })->start; warn "Hey"; sleep 400; warn "Hey"; })->start; warn "Hey"; sleep 400; warn "Hey"; })->start; sleep 400; } )->separate_err(0)); $c->start(); my @pids; $c->session->on(register => sub { push(@pids, shift) }); my $p = $c->process(); my $cgroup = $c->cgroups->first; is $cgroup->process_list, $p->pid . "\n", "procs interface contains the added pids" or diag explain $cgroup->process_list; ok $cgroup->contains_process($p->pid), "Parent contains pid " . $p->pid; my $virtual_pid; while (defined(my $line = $c->process->getline())) { $virtual_pid = $line; } chomp($virtual_pid); attempt { attempts => 20, condition => sub { $cgroup->processes->size == 6 }, cb => sub { sleep 1; } }; is $cgroup->processes->size, 6 or diag explain $cgroup->process_list; $c->stop(); is $cgroup->processes->size, 0; is $cgroup->process_list, '' or die diag explain $cgroup->process_list; $cgroup->remove(); is scalar(@pids), 5 or diag explain \@pids; isnt $virtual_pid, '1', "Running process was not PID 1 inside container, but $virtual_pid"; ok !$cgroup->exists(); }; done_testing; 12_mocked_container.t100644001750000144 1521013735070710 24163 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t#!/usr/bin/perl use warnings; use strict; use Test::More; use POSIX; use FindBin; use Mojo::File qw(tempfile tempdir path); use lib ("$FindBin::Bin/lib", "../lib", "lib"); BEGIN { $ENV{MOJO_CGROUP_FS} = tempdir() } use Mojo::IOLoop::ReadWriteProcess qw(process); use Mojo::IOLoop::ReadWriteProcess::Test::Utils qw(attempt); use Mojo::IOLoop::ReadWriteProcess::CGroup qw(cgroupv2 cgroupv1); use Mojo::IOLoop::ReadWriteProcess::Container qw(container); use Mojo::Util 'monkey_patch'; use Mojo::IOLoop::ReadWriteProcess::Namespace; sub mock_test { my $c = shift; my @pids; my $fired; $c->session->on(register => sub { push(@pids, shift) }); $c->once(stop => sub { $fired++ }); $c->start(); my $cgroups = $c->cgroups; attempt { attempts => 20, condition => sub { defined $cgroups->first->process_list }, cb => sub { sleep 1; } }; my $p = $c->process(); is $cgroups->first->process_list, $p->pid . "\n", "procs interface contains the added pids" or diag explain $cgroups->first->process_list; ok $cgroups->first->contains_process($p->pid), "Parent contains pid " . $p->pid; attempt { attempts => 20, condition => sub { !$c->is_running }, cb => sub { sleep 1; } }; $c->wait_stop(); is $cgroups->first->process_list, $p->pid . "\n" or die diag explain $cgroups->first->process_list; unlink $cgroups->first->_cgroup ->child(Mojo::IOLoop::ReadWriteProcess::CGroup::v1::PROCS_INTERFACE); $cgroups->first->remove(); ok !$cgroups->first->exists(); is $fired, 1; } subtest container => sub { eval { container(process => 2)->start(); }; ok defined $@, 'Croaks if no sub or Mojo::IOLoop::ReadWriteProcess given'; like $@, qr/You need either to pass a Mojo::IOLoop::ReadWriteProcess object or a callback/; my $c = container( subreaper => 1, group => "group", name => "test", process => sub { sleep 5; Devel::Cover::report() if Devel::Cover->can('report'); }, ); my @pids; my $fired; $c->session->on(register => sub { push(@pids, shift) }); $c->once(stop => sub { $fired++ }); $c->start(); my $p = $c->process(); my $cgroups = $c->cgroups; is $cgroups->first->process_list, $p->pid . "\n", "procs interface contains the added pids" or diag explain $cgroups->first->process_list; ok $cgroups->first->contains_process($p->pid), "Parent contains pid " . $p->pid; attempt { attempts => 20, condition => sub { $cgroups->first->processes->size == 1 }, cb => sub { sleep 1; } }; $c->wait(); is $cgroups->first->process_list, $p->pid . "\n" or die diag explain $cgroups->first->process_list; unlink $cgroups->first->_cgroup ->child(Mojo::IOLoop::ReadWriteProcess::CGroup::v1::PROCS_INTERFACE); $cgroups->first->remove(); ok !$cgroups->first->exists(); is $fired, 1; }; subtest container_2 => sub { my $c = container( subreaper => 1, group => "group", name => "test", process => process( sub { sleep 5; Devel::Cover::report() if Devel::Cover->can('report'); } ), ); my @pids; my $fired; $c->session->on(register => sub { push(@pids, shift) }); $c->once(stop => sub { $fired++ }); $c->start(); my $p = $c->process(); my $cgroups = $c->cgroups; is $cgroups->first->process_list, $p->pid . "\n", "procs interface contains the added pids" or diag explain $cgroups->first->process_list; ok $cgroups->first->contains_process($p->pid), "Parent contains pid " . $p->pid; attempt { attempts => 20, condition => sub { !$c->is_running }, cb => sub { sleep 1; } }; $c->wait_stop(); is $cgroups->first->process_list, $p->pid . "\n" or die diag explain $cgroups->first->process_list; unlink $cgroups->first->_cgroup ->child(Mojo::IOLoop::ReadWriteProcess::CGroup::v1::PROCS_INTERFACE); $cgroups->first->remove(); ok !$cgroups->first->exists(); is $fired, 1; $c->stop; is $c->is_running, 0; }; subtest container_3 => sub { use Mojo::Collection 'c'; mock_test( container( subreaper => 1, cgroups => cgroupv1(controller => 'pids', name => 'group')->child('test'), group => "group", name => "test", process => process( sub { sleep 5; Devel::Cover::report() if Devel::Cover->can('report'); } ), )); my $t_cgroup = cgroupv1(controller => 'pids', name => 'group')->child('test'); mock_test( container( subreaper => 1, pre_migrate => 1, clean_cgroup => 1, cgroups => c($t_cgroup), group => "group", name => "test", process => process( sub { sleep 5; Devel::Cover::report() if Devel::Cover->can('report'); } ), )); ok !$t_cgroup->exists(); mock_test( container( unshare => 0, pre_migrate => 1, clean_cgroup => 1, group => "group", name => "test", process => process( sub { sleep 5; Devel::Cover::report() if Devel::Cover->can('report'); } ), )); mock_test( container( pre_migrate => 1, clean_cgroup => 1, group => "group", name => "test", process => process( sub { sleep 5; Devel::Cover::report() if Devel::Cover->can('report'); } ), )); my $c = container( pid_isolation => 1, pre_migrate => 1, clean_cgroup => 1, group => "group", name => "test", process => process( sub { sleep 5; Devel::Cover::report() if Devel::Cover->can('report'); } ), ); mock_test($c); ok $c->process->errored; monkey_patch "Mojo::IOLoop::ReadWriteProcess::Namespace", unshare => sub { 0 }; is Mojo::IOLoop::ReadWriteProcess::Namespace::unshare(1), 0; mock_test( container( unshare => Mojo::IOLoop::ReadWriteProcess::Namespace::CLONE_NEWIPC, clean_cgroup => 1, group => "group", name => "test", process => process( sub { sleep 5; Devel::Cover::report() if Devel::Cover->can('report'); } ), )); mock_test( container( unshare => 0, pre_migrate => 1, clean_cgroup => 1, group => "group", name => "test", process => process( sub { sleep 5; Devel::Cover::report() if Devel::Cover->can('report'); } ), )); mock_test( container( pre_migrate => 1, pid_isolation => 1, clean_cgroup => 1, group => "group", name => "test", process => process( sub { sleep 5; Devel::Cover::report() if Devel::Cover->can('report'); } ), )); }; done_testing; 13_shared.t100644001750000144 2040313735070710 22126 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t#!/usr/bin/perl use warnings; use strict; use Test::More; use POSIX; use FindBin; use Mojo::File qw(tempfile tempdir path); use lib ("$FindBin::Bin/lib", "../lib", "lib"); use Mojo::IOLoop::ReadWriteProcess qw(process queue shared_memory lock semaphore); use Mojo::IOLoop::ReadWriteProcess::Shared::Semaphore; use Mojo::IOLoop::ReadWriteProcess::Shared::Lock; use Mojo::IOLoop::ReadWriteProcess::Shared::Memory; use Data::Dumper; use constant DEBUG => $ENV{MOJO_PROCESS_DEBUG}; plan skip_all => "Skipped unless TEST_SHARED is set" unless $ENV{TEST_SHARED}; subtest 'semaphore' => sub { my $sem_key = 33131; my $sem = Mojo::IOLoop::ReadWriteProcess::Shared::Semaphore::semaphore( key => $sem_key); ok(defined $sem->id, ' We have semaphore id ( ' . $sem->id . ' )'); ok(defined $sem->stat, ' We have semaphore stats ( ' . Dumper($sem->stat) . ' )'); is($sem->stat->[7], 1, 'Default semaphore size is 1'); $sem->setval(0, 1); is $sem->getval(0), 1, 'Semaphore value set to 1'; $sem->setval(0, 0); is $sem->getval(0), 0, 'Semaphore value set 0'; $sem->setval(0, 1); is $sem->getval(0), 1, 'Semaphore value set to 1'; $sem->setall(0); is $sem->getval(0), 0, 'Semaphore value set 0'; $sem->setval(0, 1); is $sem->getall, 1, 'We have one semaphore, which is free to go'; is $sem->getncnt, 0, '0 Processes waiting for the semaphore'; my $q = queue; $q->pool->maximum_processes(10); $q->queue->maximum_processes(50); $q->add( process( sub { my $sem = semaphore(key => $sem_key); my $e = 1; if ($sem->acquire({wait => 1, undo => 0})) { $e = 0; $sem->release(); } Devel::Cover::report() if Devel::Cover->can('report'); exit($e); } )->set_pipes(0)->internal_pipes(0)) for 1 .. 20; $q->consume(); is $q->done->size, 20, '20 Processes consumed'; $q->done->each( sub { is $_[0]->exit_status, 0, "Process: " . shift->pid . " exited with 0 (semaphore acquired at least once)"; }); $sem->remove; }; subtest 'lock' => sub { my $k = 2342385; my $lock = Mojo::IOLoop::ReadWriteProcess::Shared::Lock::shared_lock(key => $k); my $q = queue; $q->pool->maximum_processes(10); $q->queue->maximum_processes(50); $q->add( process( sub { my $l = lock(key => $k); my $e = 1; if ($l->lock) { $e = 0; $l->unlock; } Devel::Cover::report() if Devel::Cover->can('report'); exit($e); } )->set_pipes(0)->internal_pipes(0)) for 1 .. 20; $q->consume(); is $q->done->size, 20, '20 Processes consumed'; $q->done->each( sub { is $_[0]->exit_status, 0, "Process: " . shift->pid . " exited with 0 (semaphore acquired at least once)"; }); $lock->remove(); }; subtest 'lock section' => sub { my $lock = Mojo::IOLoop::ReadWriteProcess::Shared::Memory::shared_lock(key => 3331); my $q = queue; $q->pool->maximum_processes(10); $q->queue->maximum_processes(50); $q->add( process( sub { my $l = lock(key => 3331); my $e = 1; $l->section(sub { $e = 0 }); Devel::Cover::report() if Devel::Cover->can('report'); exit($e); } )->set_pipes(0)->internal_pipes(0)) for 1 .. 20; $q->consume(); is $q->done->size, 20, '20 Processes consumed'; $q->done->each( sub { is $_[0]->exit_status, 0, "Process: " . shift->pid . " exited with 0 (semaphore acquired at least once)"; }); $lock->remove; }; subtest 'concurrent memory read/write' => sub { use IPC::SysV 'ftok'; my $k = ftok($0, 0); my $mem = shared_memory(key => $k); $mem->_lock->remove; my $default = shared_memory; is $default->key, $k, "Default memory key is : $k"; $mem = shared_memory(key => $k); $mem->clean; $mem->_lock->remove; $mem = shared_memory(key => $k); $mem->lock_section(sub { $mem->buffer('start') }); my $q = queue; $q->pool->maximum_processes(10); $q->queue->maximum_processes(50); $q->add( process( sub { my $mem = shared_memory(key => $k); srand time; $mem->lock_section( sub { # Random sleeps to try to make threads race into lock section unless (DEBUG) { do { warn "$$: Sleeping inside locked section"; sleep rand(int(2)); } for 1 .. 5; } my $b = $mem->buffer; $mem->buffer($$ . " $b"); Devel::Cover::report() if Devel::Cover->can('report'); }); } )->set_pipes(0)->internal_pipes(0)) for 1 .. 20; $q->consume(); $mem = shared_memory(key => $k); $mem->lock_section( sub { ok((length $mem->buffer > 0), 'Buffer is there'); }); $mem->lock_section( sub { my @pids = split(/ /, $mem->buffer); is scalar @pids, 21, 'There are 20 pids and the start word (21)'; }); $mem->_lock->remove; $mem->remove; }; sub free_mem { my $mem = shared_memory; $mem->_lock->remove; $mem->remove; $mem = shared_memory; $mem->clean; $mem->_lock->remove; $mem = shared_memory; if ($mem->try_lock) { $mem->buffer(freeze({})); $mem->unlock; } } sub test_mem { my $mem = shared_memory(destroy => 1); $mem->lock_section( sub { ok((length $mem->buffer > 0), 'Buffer is there'); my $data = thaw($mem->buffer); my @pids = keys %{$data}; is scalar @pids, 20, 'There are 20 pids'; diag explain $data; }); is $mem->stat->[8], 0, 'No process attached to memory'; } subtest 'storable' => sub { use Storable qw(freeze thaw); use Mojo::IOLoop::ReadWriteProcess::Shared::Memory qw(shared_lock shared_memory semaphore); free_mem; my $q = queue; $q->pool->maximum_processes(10); $q->queue->maximum_processes(50); $q->add( process( sub { my $mem = shared_memory; $mem->lock_section( sub { unless (DEBUG) { do { warn "$$: Sleeping inside locked section"; sleep rand(int(2)); } for 1 .. 5; } my $data = thaw($mem->buffer); $data->{$$}++; $mem->buffer(freeze($data)); Devel::Cover::report() if Devel::Cover->can('report'); }); } )->set_pipes(0)->internal_pipes(0)) for 1 .. 20; $q->consume(); is $q->done->size, 20, 'Queue consumed 20 processes'; test_mem; }; # # subtest 'locking with undo' => sub { # use Storable qw(freeze thaw); # # free_mem; # # my $q = queue; # $q->pool->maximum_processes(10); # $q->queue->maximum_processes(50); # # $q->add( # process( # sub { # my $mem = shared_memory; # # if ($mem->lock(undo => 1, wait => 1)) # { # Do not unlock/release with undo => 1 # eval { my $data = thaw($mem->buffer); # $data->{$$}++; # $mem->buffer(freeze($data)); # $mem->save(); # }; # warn "FAILED UNDO $@" if $@; # # # $mem->unlock(); # } # Devel::Cover::report() if Devel::Cover->can('report'); # exit(0); # } # )->set_pipes(0)->internal_pipes(0)) for 1 .. 20; # # $q->consume(); # is $q->done->size, 20, 'Queue consumed 20 processes'; # # test_mem; # }; subtest 'dying in locked section' => sub { use Storable qw(freeze thaw); free_mem; my $q = queue; $q->pool->maximum_processes(10); $q->queue->maximum_processes(20); $q->add( process( sub { my $mem = shared_memory; $mem->lock_section( sub { unless (DEBUG) { do { warn "$$: Sleeping inside locked section"; sleep rand(int(2)); } for 1 .. 5; } my $data = thaw($mem->buffer); $data->{$$}++; $mem->buffer(freeze($data)); Devel::Cover::report() if Devel::Cover->can('report'); die("Process failed!"); }); Devel::Cover::report() if Devel::Cover->can('report'); } )->set_pipes(0)->internal_pipes(0)) for 1 .. 20; $q->consume(); is $q->done->size, 20, 'Queue consumed 20 processes'; test_mem; }; done_testing(); process_check.sh100755001750000144 41113735070710 24210 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t/data#!/bin/bash cleanup() { echo "TEST exiting" } trap cleanup EXIT (>&2 echo "TEST error print") echo "TEST normal print" while [[ -z "$TESTVAR" ]] do read -p "Enter something: " TESTVAR done echo "you entered $TESTVAR" [[ -n "$@" ]] && echo "$@" exit 100 simple_fork.pl100755001750000144 32113735070710 23710 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t/datause warnings; use strict; my $pid1 = fork(); if ($pid1 == 0) { print "fork 1\n"; sleep 1000; } my $pid2 = fork(); if ($pid2 == 0) { print "fork 2\n"; sleep 1000; } waitpid $pid1, 0; waitpid $pid2, 0; child.sh100755001750000144 4313735070710 24431 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t/data/subreaper#!/bin/bash sleep 3 echo "child" dead_child.sh100755001750000144 11413735070710 25425 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t/data/subreaper#!/bin/sh sleep 3 die() { echo "$*" 1>&2 ; exit 1; } die "dead child Boom" dead_master.sh100755001750000144 25613735070710 25644 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t/data/subreaper#/bin/sh wd="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" echo $wd die() { echo "$*" 1>&2 ; exit 1; } sleep 2 $wd/dead_child.sh & $wd/spawn.sh & die " master 1Boom" master.sh100755001750000144 27413735070710 24667 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t/data/subreaper#!/bin/bash sleep 1 wd="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" echo $wd echo "master" $wd/child.sh & $wd/spawn.sh & $wd/child.sh & $wd/child.sh & $wd/child.sh & echo "done" roulette.sh100755001750000144 24213735070710 25232 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t/data/subreaper#!/bin/bash wd="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" die() { echo "$*" 1>&2 ; exit 1; } $wd/dead_master.sh & $wd/spawn.sh & die "roulette KaBoom" spawn.sh100755001750000144 25713735070710 24525 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t/data/subreaper#!/bin/bash sleep 3 wd="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" echo $wd die() { echo "$*" 1>&2 ; exit 1; } $wd/child.sh & $wd/child.sh & die "spawner: 2 Boom" term_trap.sh100755001750000144 23013735070710 23371 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t/data#!/bin/bash (sleep 25; echo "Hello World") & trap "echo I ALWAYS WIN" SIGINT SIGTERM echo "pid is $$" while : do echo "b" sleep 1 done Utils.pm100644001750000144 106013735070710 30563 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/t/lib/Mojo/IOLoop/ReadWriteProcess/Testpackage Mojo::IOLoop::ReadWriteProcess::Test::Utils; our @EXPORT_OK = qw(attempt); use Exporter 'import'; use constant DEBUG => $ENV{MOJO_PROCESS_DEBUG}; sub attempt { my $attempts = 0; my ($total_attempts, $condition, $cb, $or) = ref $_[0] eq 'HASH' ? (@{$_[0]}{qw(attempts condition cb or)}) : @_; until ($condition->() || $attempts >= $total_attempts) { warn "Attempt $attempts" if DEBUG; $cb->(); sleep 1; $attempts++; } $or->() if $or && !$condition->(); warn "Attempts terminated!" if DEBUG; } 1; setup100755001750000144 116513735070710 22137 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/tools#!/bin/bash # Courtesy of https://github.com/sosy-lab/benchexec echo ------------------------ echo "Existing mount points:" mount echo ------------------------ echo "Existing users:" getent passwd echo ------------------------ PRIMARY_USER="$1" # Set up cgroups for i in blkio cpuacct cpuset freezer memory cpu pids; do if [ ! -d "/sys/fs/cgroup/$i" ]; then mkdir /sys/fs/cgroup/$i mount cgroup-$i /sys/fs/cgroup/$i -t cgroup -o $i fi chgrp "$(id -g "$PRIMARY_USER")" /sys/fs/cgroup/$i chmod g+rwx /sys/fs/cgroup/$i done echo ------------------------ echo "Now mount points:" mount ls -liah /sys/fs/cgroup/ tidy100755001750000144 140513735070710 21745 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28/tools#!/bin/bash # # perltidy rules can be found in ../.perltidyrc # check= if test "$1" = '--check'; then shift check=1 fi if ! which perltidy > /dev/null 2>&1; then echo "No perltidy found, install it first!" exit 1 fi cd "${0%/*}/.." # just to make sure we are at the right location test -e tools/tidy || exit 1 find -name '*.tdy' -delete find . \( -name '*.p[lm]' -o -name '*.t' \) -print0 | xargs -0 perltidy --pro=.../.perltidyrc while read file; do if ! diff -u ${file%.tdy} $file; then if test -n "$check"; then echo "RUN tools/tidy script before checkin" exit 1 else mv -v $file ${file%.tdy} fi else rm $file fi done < <(find . -name "*.tdy") # vim: set sw=4 et: META.yml100644001750000144 1025213735070710 21177 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28--- abstract: 'Execute external programs or internal code blocks as separate process.' author: - 'Ettore Di Giacinto ' build_requires: Test::More: '0.98' configure_requires: Module::Build: '0.4005' perl: '5.016' dynamic_config: 0 generated_by: 'Minilla/v3.1.10, CPAN::Meta::Converter version 2.143240' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Mojo-IOLoop-ReadWriteProcess no_index: directory: - t - xt - inc - share - eg - examples - author - builder provides: Mojo::IOLoop::ReadWriteProcess: file: lib/Mojo/IOLoop/ReadWriteProcess.pm version: '0.28' 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 requires: IPC::SharedMem: '0' Mojolicious: '7.24' resources: bugtracker: https://github.com/mudler/Mojo-IOLoop-ReadWriteProcess/issues homepage: https://github.com/mudler/Mojo-IOLoop-ReadWriteProcess repository: git://github.com/mudler/Mojo-IOLoop-ReadWriteProcess.git version: '0.28' x_contributors: - 'Clemens Famulla-Conrad ' - 'Ettore Di Giacinto ' - 'Ettore Di Giacinto ' - 'Marius Kittler ' - 'Mohammad S Anwar ' - 'Oliver Kurz ' - 'Santiago Zarate ' - 'Santiago Zarate ' - 'Sebastian Riedel ' x_static_install: 0 MANIFEST100644001750000144 367613735070710 21053 0ustar00foursixnineusers000000000000Mojo-IOLoop-ReadWriteProcess-0.28Build.PL Changes LICENSE META.json README.md builder/custom.pm circle.yml codecov.yml cpanfile lib/Mojo/IOLoop/ReadWriteProcess.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/Cpuacct.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/Cpuset.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/Devices.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/Freezer.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/Memory.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/Netcls.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/Netprio.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/PID.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v1/RDMA.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2/CPU.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2/IO.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2/Memory.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2/PID.pm lib/Mojo/IOLoop/ReadWriteProcess/CGroup/v2/RDMA.pm lib/Mojo/IOLoop/ReadWriteProcess/Container.pm lib/Mojo/IOLoop/ReadWriteProcess/Exception.pm lib/Mojo/IOLoop/ReadWriteProcess/Namespace.pm lib/Mojo/IOLoop/ReadWriteProcess/Pool.pm lib/Mojo/IOLoop/ReadWriteProcess/Queue.pm lib/Mojo/IOLoop/ReadWriteProcess/Session.pm lib/Mojo/IOLoop/ReadWriteProcess/Shared/Lock.pm lib/Mojo/IOLoop/ReadWriteProcess/Shared/Memory.pm lib/Mojo/IOLoop/ReadWriteProcess/Shared/Semaphore.pm minil.toml t/00_compile.t t/01_run.t t/02_parallel.t t/03_func.t t/04_queues.t t/05_serialize.t t/06_events.t t/07_autodetect.t t/08_ioloop.t t/09_session.t t/10_cgroupv1.t t/10_cgroupv2.t t/11_containers.t t/12_mocked_container.t t/13_shared.t t/data/process_check.sh t/data/simple_fork.pl t/data/subreaper/child.sh t/data/subreaper/dead_child.sh t/data/subreaper/dead_master.sh t/data/subreaper/master.sh t/data/subreaper/roulette.sh t/data/subreaper/spawn.sh t/data/term_trap.sh t/lib/Mojo/IOLoop/ReadWriteProcess/Test/Utils.pm tools/setup tools/tidy META.yml MANIFEST