Sign Up
Log In
Log In
or
Sign Up
Places
All Projects
Status Monitor
Collapse sidebar
devel:languages:erlang
erlang-p1_utils
_service:obs_scm:p1_utils-1.0.25.obscpio
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
File _service:obs_scm:p1_utils-1.0.25.obscpio of Package erlang-p1_utils
07070100000000000041ED000000000000000000000002626FB04100000000000000000000000000000000000000000000001E00000000p1_utils-1.0.25/.devcontainer07070100000001000081A4000000000000000000000001626FB04100000051000000000000000000000000000000000000002900000000p1_utils-1.0.25/.devcontainer/Dockerfile# Tag version from https://hub.docker.com/_/erlang ARG TAG=23 FROM erlang:${TAG} 07070100000002000081A4000000000000000000000001626FB04100000223000000000000000000000000000000000000003000000000p1_utils-1.0.25/.devcontainer/devcontainer.json{ "name": "Erlang", "build": { "dockerfile": "Dockerfile", "args": { "TAG": "23", } }, // Set *default* container specific settings.json values on container create. "settings": { "terminal.integrated.shell.linux": "/bin/bash", }, // Add the IDs of extensions you want installed when the container is created. "extensions": [ "pgourlain.erlang", "garaemon.vscode-emacs-tab" ], // Comment out connect as root instead. More info: https://aka.ms/vscode-remote/containers/non-root. // "remoteUser": "vscode" }07070100000003000041ED000000000000000000000003626FB04100000000000000000000000000000000000000000000001800000000p1_utils-1.0.25/.github07070100000004000041ED000000000000000000000002626FB04100000000000000000000000000000000000000000000002200000000p1_utils-1.0.25/.github/workflows07070100000005000081A4000000000000000000000001626FB04100000404000000000000000000000000000000000000002900000000p1_utils-1.0.25/.github/workflows/ci.ymlname: CI on: [push, pull_request] jobs: tests: name: Tests strategy: fail-fast: false matrix: otp: ['19.3', '21.3', 24] runs-on: ubuntu-20.04 container: image: erlang:${{ matrix.otp }} steps: - uses: actions/checkout@v2 - run: adduser tester && chown -R tester . - run: su tester -c "make" - run: su tester -c "rebar3 compile" - run: su tester -c "rebar3 xref" - run: su tester -c "rebar3 dialyzer" - run: su tester -c "rebar3 eunit -v" - name: Send to Coveralls if: matrix.otp == 24 env: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} run: | COVERALLS=true rebar3 as test coveralls send curl -v -k https://coveralls.io/webhook \ --header "Content-Type: application/json" \ --data '{"repo_name":"$GITHUB_REPOSITORY", "repo_token":"$GITHUB_TOKEN", "payload":{"build_num":$GITHUB_RUN_ID, "status":"done"}}' 07070100000006000081A4000000000000000000000001626FB0410000045B000000000000000000000000000000000000003400000000p1_utils-1.0.25/.github/workflows/hexpm-release.ymlname: Hex on: push: tags: - '*' jobs: release: runs-on: ubuntu-latest steps: - name: Check out uses: actions/checkout@v2 - name: Setup rebar3 hex run: | mkdir -p ~/.config/rebar3/ echo "{plugins, [rebar3_hex]}." > ~/.config/rebar3/rebar.config - run: rebar3 edoc - name: Prepare Markdown run: | echo "" >>README.md echo "## EDoc documentation" >>README.md echo "" >>README.md echo "You can check this library's " >>README.md echo "[EDoc documentation](edoc.html), " >>README.md echo "generated automatically from the source code comments." >>README.md - name: Convert Markdown to HTML uses: natescherer/markdown-to-html-with-github-style-action@v1.1.0 with: path: README.md - run: | mv doc/index.html doc/edoc.html mv README.html doc/index.html - name: Publish to hex.pm run: DEBUG=1 rebar3 hex publish --repo hexpm --yes env: HEX_API_KEY: ${{ secrets.HEX_API_KEY }} 07070100000007000081A4000000000000000000000001626FB041000000AD000000000000000000000000000000000000001B00000000p1_utils-1.0.25/.gitignore*.swo *.swp .eunit .rebar _build autom4te.cache c_src/*.d c_src/*.gcda c_src/*.gcno c_src/*.o config.log config.status deps doc ebin priv rebar.lock test/*.beam vars.config 07070100000008000041ED000000000000000000000002626FB04100000000000000000000000000000000000000000000001800000000p1_utils-1.0.25/.vscode07070100000009000081A4000000000000000000000001626FB0410000006F000000000000000000000000000000000000002600000000p1_utils-1.0.25/.vscode/settings.json{ "erlang.codeLensEnabled": true, "erlang.linting": true, "workbench.colorTheme": "Default Dark+" }0707010000000A000081A4000000000000000000000001626FB04100000142000000000000000000000000000000000000002300000000p1_utils-1.0.25/.vscode/tasks.json{ "version": "2.0.0", "tasks": [ { "label": "rebar3 compile", "type": "shell", "command": "rebar3 compile", "group": { "kind": "build", "isDefault": true }, "problemMatcher": "$erlang" } ] }0707010000000B000081A4000000000000000000000001626FB04100000876000000000000000000000000000000000000001D00000000p1_utils-1.0.25/CHANGELOG.md# Version 1.0.25 * Generate docs when publishing to hex.pm * Add missing `compiler` dependency * Improve function specs # Version 1.0.24 * Add module for decoding HAproxy protocol (v1 and v2) headers # Version 1.0.23 * Switch from using Travis to Github Actions as CI * Update .gitignore * Fix compatibility problems with OTP24 # Version 1.0.22 * Update copyright year to 2021 * Unit tests + plugin in release workflow * Support Docker + VScode development # Version 1.0.21 * Update travis config # Version 1.0.19 * Fix compatibility issues with Erlang 23 # Version 1.0.18 * Update copyright year # Version 1.0.17 * Fix formatting of error messages # Version 1.0.16 * Update type specs * Avoid lengthy output of p1\_prof:m/r/q commands # Version 1.0.15 * Add p1\_prof module # Version 1.0.14 * Add contribution guide * Remove exec bit from doc/style.css # Version 1.0.13 * Add p1\_rand and shaper module # Version 1.0.12 * Don't fetch generic\_debug option from init # Version 1.0.11 * Fix compilation with rebar3 # Version 1.0.10 * Fix problem with edoc # Version 1.0.9 * Add p1_options module # Version 1.0.8 * Add p1_queue * Only perform destructive operations in p1_file_queue:in/2 * Add garbage collector for file queues * Add ram_to_file/1 and file_to_ram/1 * Improve exception names * Implement limited queues * Add ownership protection * Add get_limit/1 and set_limit/2 # Version 1.0.7 * Fix coverall invocation (Paweł Chmielowski) * Fix p1_server timeout handling, R18 compatibility (Alexey Shchepin) # Version 1.0.6 * Add p1_http # Version 1.0.5 * Erlang R19 compliance (Paweł Chmielowski) # Version 1.0.4 * Adds p1_time_compat:unique_timestamp() that returns value resembling what now() was returning # Version 1.0.3 * Added time related compatibility module, added API documentation (Paweł Chmielowski) * Improve documentation readability (Marek Foss) # Version 1.0.2 * Add p1_time_compat module to ease support for both R17 and R18 Erlang time features (Paweł Chmielowski) # Version 1.0.1 * Better Rebar3 support, remove warning about missing hex plugin when building with rebar (Mickaël Rémond) 0707010000000C000081A4000000000000000000000001626FB04100000D1B000000000000000000000000000000000000002300000000p1_utils-1.0.25/CODE_OF_CONDUCT.md# Contributor Covenant Code of Conduct ## Our Pledge In the interest of fostering an open and welcoming environment, we as contributors and maintainers pledge to making participation in our project and our community a harassment-free experience for everyone, regardless of age, body size, disability, ethnicity, sex characteristics, gender identity and expression, level of experience, education, socio-economic status, nationality, personal appearance, race, religion, or sexual identity and orientation. ## Our Standards Examples of behavior that contributes to creating a positive environment include: * Using welcoming and inclusive language * Being respectful of differing viewpoints and experiences * Gracefully accepting constructive criticism * Focusing on what is best for the community * Showing empathy towards other community members Examples of unacceptable behavior by participants include: * The use of sexualized language or imagery and unwelcome sexual attention or advances * Trolling, insulting/derogatory comments, and personal or political attacks * Public or private harassment * Publishing others' private information, such as a physical or electronic address, without explicit permission * Other conduct which could reasonably be considered inappropriate in a professional setting ## Our Responsibilities Project maintainers are responsible for clarifying the standards of acceptable behavior and are expected to take appropriate and fair corrective action in response to any instances of unacceptable behavior. Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, or to ban temporarily or permanently any contributor for other behaviors that they deem inappropriate, threatening, offensive, or harmful. ## Scope This Code of Conduct applies both within project spaces and in public spaces when an individual is representing the project or its community. Examples of representing a project or community include using an official project e-mail address, posting via an official social media account, or acting as an appointed representative at an online or offline event. Representation of a project may be further defined and clarified by project maintainers. ## Enforcement Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by contacting the project team at contact@process-one.net. All complaints will be reviewed and investigated and will result in a response that is deemed necessary and appropriate to the circumstances. The project team is obligated to maintain confidentiality with regard to the reporter of an incident. Further details of specific enforcement policies may be posted separately. Project maintainers who do not follow or enforce the Code of Conduct in good faith may face temporary or permanent repercussions as determined by other members of the project's leadership. ## Attribution This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, available at https://www.contributor-covenant.org/version/1/4/code-of-conduct.html [homepage]: https://www.contributor-covenant.org For answers to common questions about this code of conduct, see https://www.contributor-covenant.org/faq 0707010000000D000081A4000000000000000000000001626FB0410000178D000000000000000000000000000000000000002000000000p1_utils-1.0.25/CONTRIBUTING.md# Contributing We'd love for you to contribute to our source code and to make our project even better than it is today! Here are the guidelines we'd like you to follow: * [Code of Conduct](#coc) * [Questions and Problems](#question) * [Issues and Bugs](#issue) * [Feature Requests](#feature) * [Issue Submission Guidelines](#submit) * [Pull Request Submission Guidelines](#submit-pr) * [Signing the CLA](#cla) ## <a name="coc"></a> Code of Conduct Help us keep our community open-minded and inclusive. Please read and follow our [Code of Conduct][coc]. ## <a name="requests"></a> Questions, Bugs, Features ### <a name="question"></a> Got a Question or Problem? Do not open issues for general support questions as we want to keep GitHub issues for bug reports and feature requests. You've got much better chances of getting your question answered on dedicated support platforms, the best being [Stack Overflow][stackoverflow]. Stack Overflow is a much better place to ask questions since: - there are thousands of people willing to help on Stack Overflow - questions and answers stay available for public viewing so your question / answer might help someone else - Stack Overflow's voting system assures that the best answers are prominently visible. To save your and our time, we will systematically close all issues that are requests for general support and redirect people to the section you are reading right now. ### <a name="issue"></a> Found an Issue or Bug? If you find a bug in the source code, you can help us by submitting an issue to our [GitHub Repository][github]. Even better, you can submit a Pull Request with a fix. ### <a name="feature"></a> Missing a Feature? You can request a new feature by submitting an issue to our [GitHub Repository][github-issues]. If you would like to implement a new feature then consider what kind of change it is: * **Major Changes** that you wish to contribute to the project should be discussed first in an [GitHub issue][github-issues] that clearly outlines the changes and benefits of the feature. * **Small Changes** can directly be crafted and submitted to the [GitHub Repository][github] as a Pull Request. See the section about [Pull Request Submission Guidelines](#submit-pr). ## <a name="submit"></a> Issue Submission Guidelines Before you submit your issue search the archive, maybe your question was already answered. If your issue appears to be a bug, and hasn't been reported, open a new issue. Help us to maximize the effort we can spend fixing issues and adding new features, by not reporting duplicate issues. The "[new issue][github-new-issue]" form contains a number of prompts that you should fill out to make it easier to understand and categorize the issue. ## <a name="submit-pr"></a> Pull Request Submission Guidelines By submitting a pull request for a code or doc contribution, you need to have the right to grant your contribution's copyright license to ProcessOne. Please check [ProcessOne CLA][cla] for details. Before you submit your pull request consider the following guidelines: * Search [GitHub][github-pr] for an open or closed Pull Request that relates to your submission. You don't want to duplicate effort. * Make your changes in a new git branch: ```shell git checkout -b my-fix-branch master ``` * Test your changes and, if relevant, expand the automated test suite. * Create your patch commit, including appropriate test cases. * If the changes affect public APIs, change or add relevant documentation. * Commit your changes using a descriptive commit message. ```shell git commit -a ``` Note: the optional commit `-a` command line option will automatically "add" and "rm" edited files. * Push your branch to GitHub: ```shell git push origin my-fix-branch ``` * In GitHub, send a pull request to `master` branch. This will trigger the continuous integration and run the test. We will also notify you if you have not yet signed the [contribution agreement][cla]. * If you find that the continunous integration has failed, look into the logs to find out if your changes caused test failures, the commit message was malformed etc. If you find that the tests failed or times out for unrelated reasons, you can ping a team member so that the build can be restarted. * If we suggest changes, then: * Make the required updates. * Test your changes and test cases. * Commit your changes to your branch (e.g. `my-fix-branch`). * Push the changes to your GitHub repository (this will update your Pull Request). You can also amend the initial commits and force push them to the branch. ```shell git rebase master -i git push origin my-fix-branch -f ``` This is generally easier to follow, but separate commits are useful if the Pull Request contains iterations that might be interesting to see side-by-side. That's it! Thank you for your contribution! ## <a name="cla"></a> Signing the Contributor License Agreement (CLA) Upon submitting a Pull Request, we will ask you to sign our CLA if you haven't done so before. It's a quick process, we promise, and you will be able to do it all online You can read [ProcessOne Contribution License Agreement][cla] in PDF. This is part of the legal framework of the open-source ecosystem that adds some red tape, but protects both the contributor and the company / foundation behind the project. It also gives us the option to relicense the code with a more permissive license in the future. [coc]: https://github.com/processone/p1_utils/blob/master/CODE_OF_CONDUCT.md [stackoverflow]: https://stackoverflow.com/ [github]: https://github.com/processone/p1_utils [github-issues]: https://github.com/processone/p1_utils/issues [github-new-issue]: https://github.com/processone/p1_utils/issues/new [github-pr]: https://github.com/processone/p1_utils/pulls [cla]: https://www.process-one.net/resources/ejabberd-cla.pdf [license]: https://github.com/processone/p1_utils/blob/master/LICENSE.txt 0707010000000E000081A4000000000000000000000001626FB04100002C5E000000000000000000000000000000000000001C00000000p1_utils-1.0.25/LICENSE.txt Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. 0707010000000F000081A4000000000000000000000001626FB041000005AF000000000000000000000000000000000000001900000000p1_utils-1.0.25/MakefileREBAR ?= rebar IS_REBAR3:=$(shell expr `$(REBAR) --version | awk -F '[ .]' '/rebar / {print $$2}'` '>=' 3) all: src src: $(REBAR) compile clean: $(REBAR) clean ifeq "$(IS_REBAR3)" "1" test: $(REBAR) eunit -v else test: all $(REBAR) -v skip_deps=true eunit endif ifeq "$(IS_REBAR3)" "1" dialyzer: $(REBAR) dialyzer else dialyzer/erlang.plt: @mkdir -p dialyzer @dialyzer --build_plt --output_plt dialyzer/erlang.plt \ -o dialyzer/erlang.log --apps kernel stdlib erts inets crypto compiler edoc tools syntax_tools xmerl; \ status=$$? ; if [ $$status -ne 2 ]; then exit $$status; else exit 0; fi dialyzer/p1_utils.plt: @mkdir -p dialyzer @dialyzer --build_plt --output_plt dialyzer/p1_utils.plt \ -o dialyzer/p1_utils.log ebin; \ status=$$? ; if [ $$status -ne 2 ]; then exit $$status; else exit 0; fi erlang_plt: dialyzer/erlang.plt @dialyzer --plt dialyzer/erlang.plt --check_plt -o dialyzer/erlang.log; \ status=$$? ; if [ $$status -ne 2 ]; then exit $$status; else exit 0; fi p1_utils_plt: dialyzer/p1_utils.plt @dialyzer --plt dialyzer/p1_utils.plt --check_plt -o dialyzer/p1_utils.log; \ status=$$? ; if [ $$status -ne 2 ]; then exit $$status; else exit 0; fi dialyzer: erlang_plt p1_utils_plt @dialyzer --plts dialyzer/*.plt --no_check_plt \ --get_warnings -o dialyzer/error.log ebin; \ status=$$? ; if [ $$status -ne 2 ]; then exit $$status; else exit 0; fi endif .PHONY: clean src test dialyzer erlang_plt p1_utils_plt 07070100000010000081A4000000000000000000000001626FB0410000055B000000000000000000000000000000000000001A00000000p1_utils-1.0.25/README.md# p1_utils [](https://github.com/processone/p1_utils/actions/workflows/ci.yml) [](https://coveralls.io/github/processone/p1_utils?branch=master) [](https://hex.pm/packages/p1_utils) p1_utils is an application containing ProcessOne modules and tools that are leveraged in other development projects: * `p1_fsm` and `p1_server` are drop-in replacements of Erlang gen_fsm and gen_server, offering extra option for better reliability in production. They support mostly priority messages and message queue length controls. * `p1_nif_utils` is an helper utilities for handling NIF code. * `treap` is a treap algorithm implementation. It is a randomized binary search tree. See: https://en.wikipedia.org/wiki/Treap * `p1_time_compat` is a module to ease support and migration of Erlang time management function from Erlang R16/R17 to Erlang R18. * `p1_http` is an http client which provides a common API for inets / lhttpc / ibrowse * `p1_proxy_protocol` decodes HAproxy protocol (v1 and v2) headers. If you have `rebar` binary, you can generate `p1_utils` documentation by running `rebar3 edoc`. 07070100000011000041ED000000000000000000000002626FB04100000000000000000000000000000000000000000000001800000000p1_utils-1.0.25/include07070100000012000081A4000000000000000000000001626FB0410000015B000000000000000000000000000000000000002500000000p1_utils-1.0.25/include/p1_queue.hrl-record(file_q, {tail = 0 :: non_neg_integer(), head = 0 :: non_neg_integer(), limit :: non_neg_integer() | unlimited, fd :: file:fd(), path :: binary(), owner = self() :: pid(), start = 0 :: non_neg_integer(), stop = 0 :: non_neg_integer()}). -define(qlen(Q), element(2, Q)). 07070100000013000081A4000000000000000000000001626FB0410000023B000000000000000000000000000000000000001D00000000p1_utils-1.0.25/rebar.config{erl_opts, [ debug_info, {platform_define, "^(R|1|20|21)", 'USE_OLD_SYS_GET_DEBUG'}, {platform_define, "^(15|16|17)", 'NEED_TIME_FALLBACKS'}, {platform_define, "^(18|19|([2-9][0-9]))", 'HAVE_RAND'} ]}. {cover_enabled, true}. {cover_export_enabled, true}. {coveralls_coverdata , "_build/test/cover/eunit.coverdata"}. {coveralls_service_name , "github"}. {xref_checks, [undefined_function_calls, undefined_functions, deprecated_function_calls, deprecated_functions]}. %% Local Variables: %% mode: erlang %% End: %% vim: set filetype=erlang tabstop=8: 07070100000014000081A4000000000000000000000001626FB041000010EF000000000000000000000000000000000000002400000000p1_utils-1.0.25/rebar.config.script%%%---------------------------------------------------------------------- %%% File : rebar.config.script %%% Author : Mickael Remond <mremond@process-one.net> %%% Purpose : Rebar build script. Compliant with rebar and rebar3. %%% Created : 24 Nov 2015 by Mickael Remond <mremond@process-one.net> %%% %%% Copyright (C) 2002-2022 ProcessOne, SARL. All Rights Reserved. %%% %%% Licensed under the Apache License, Version 2.0 (the "License"); %%% you may not use this file except in compliance with the License. %%% You may obtain a copy of the License at %%% %%% http://www.apache.org/licenses/LICENSE-2.0 %%% %%% Unless required by applicable law or agreed to in writing, software %%% distributed under the License is distributed on an "AS IS" BASIS, %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %%% See the License for the specific language governing permissions and %%% limitations under the License. %%% %%%---------------------------------------------------------------------- SysVersion = lists:map(fun erlang:list_to_integer/1, string:tokens(erlang:system_info(version), ".")), IsRebar3 = case application:get_key(rebar, vsn) of {ok, VSN} -> [VSN1 | _] = string:tokens(VSN, "-"), [Maj|_] = string:tokens(VSN1, "."), (list_to_integer(Maj) >= 3); undefined -> lists:keymember(mix, 1, application:loaded_applications()) end, ModCfg0 = fun(F, Cfg, [Key|Tail], Op, Default) -> {OldVal,PartCfg} = case lists:keytake(Key, 1, Cfg) of {value, {_, V1}, V2} -> {V1, V2}; false -> {if Tail == [] -> Default; true -> [] end, Cfg} end, case Tail of [] -> [{Key, Op(OldVal)} | PartCfg]; _ -> [{Key, F(F, OldVal, Tail, Op, Default)} | PartCfg] end end, ModCfg = fun(Cfg, Keys, Op, Default) -> ModCfg0(ModCfg0, Cfg, Keys, Op, Default) end, ModCfgS = fun(Cfg, Keys, Val) -> ModCfg0(ModCfg0, Cfg, Keys, fun(_V) -> Val end, "") end, FilterConfig = fun(F, Cfg, [{Path, true, ModFun, Default} | Tail]) -> F(F, ModCfg0(ModCfg0, Cfg, Path, ModFun, Default), Tail); (F, Cfg, [_ | Tail]) -> F(F, Cfg, Tail); (F, Cfg, []) -> Cfg end, AppendStr = fun(Append) -> fun("") -> Append; (Val) -> Val ++ " " ++ Append end end, AppendList = fun(Append) -> fun(Val) -> Val ++ Append end end, Rebar3DepsFilter = fun(DepsList) -> lists:map(fun({DepName,_, {git,_, {tag,Version}}}) -> {DepName, Version}; (Dep) -> Dep end, DepsList) end, GlobalDepsFilter = fun(Deps) -> DepNames = lists:map(fun({DepName, _, _}) -> DepName; ({DepName, _}) -> DepName end, Deps), lists:filtermap(fun(Dep) -> case code:lib_dir(Dep) of {error, _} -> {true,"Unable to locate dep '"++atom_to_list(Dep)++"' in system deps."}; _ -> false end end, DepNames) end, GithubConfig = case {os:getenv("GITHUB_ACTIONS"), os:getenv("GITHUB_TOKEN")} of {"true", Token} when is_list(Token) -> CONFIG1 = [{coveralls_repo_token, Token}, {coveralls_service_job_id, os:getenv("GITHUB_RUN_ID")}, {coveralls_commit_sha, os:getenv("GITHUB_SHA")}, {coveralls_service_number, os:getenv("GITHUB_RUN_NUMBER")}], case os:getenv("GITHUB_EVENT_NAME") =:= "pull_request" andalso string:tokens(os:getenv("GITHUB_REF"), "/") of [_, "pull", PRNO, _] -> [{coveralls_service_pull_request, PRNO} | CONFIG1]; _ -> CONFIG1 end; _ -> [] end, Rules = [ {[deps], IsRebar3, Rebar3DepsFilter, []}, {[plugins], IsRebar3, AppendList([pc]), []}, {[plugins], os:getenv("COVERALLS") == "true", AppendList([{coveralls, {git, "https://github.com/processone/coveralls-erl.git", {branch, "addjsonfile"}}} ]), []}, {[deps], os:getenv("USE_GLOBAL_DEPS") /= false, GlobalDepsFilter, []} ], Config = FilterConfig(FilterConfig, CONFIG, Rules) ++ GithubConfig, %io:format("Rules:~n~p~n~nCONFIG:~n~p~n~nConfig:~n~p~n", [Rules, CONFIG, Config]), Config. %% Local Variables: %% mode: erlang %% End: %% vim: set filetype=erlang tabstop=8: 07070100000015000081A4000000000000000000000001626FB04100000004000000000000000000000000000000000000001B00000000p1_utils-1.0.25/rebar.lock[]. 07070100000016000041ED000000000000000000000002626FB04100000000000000000000000000000000000000000000001400000000p1_utils-1.0.25/src07070100000017000081A4000000000000000000000001626FB04100002A5A000000000000000000000000000000000000002600000000p1_utils-1.0.25/src/p1_file_queue.erl%%%------------------------------------------------------------------- %%% @author Evgeny Khramtsov <ekhramtsov@process-one.net> %%% @copyright (C) 2017-2022 Evgeny Khramtsov %%% @doc %%% %%% @end %%% Created : 8 Mar 2017 by Evgeny Khramtsov <ekhramtsov@process-one.net> %%%------------------------------------------------------------------- -module(p1_file_queue). -behaviour(p1_server). %% API -export([new/1, is_queue/1, len/1, is_empty/1, get_limit/1, set_limit/2, in/2, out/1, peek/1, drop/1, from_list/2, to_list/1, foreach/2, foldl/3, dropwhile/2, path/1, clear/1, format_error/1]). -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -export([start/1, stop/0, start_link/1]). %% For tests only -export([close/1]). -include("p1_queue.hrl"). -record(state, {dir :: file:filename(), counter :: non_neg_integer(), files :: map()}). -type error_reason() :: {corrupted | not_owner | file:posix(), binary()}. -type queue() :: #file_q{}. -export_type([queue/0, error_reason/0]). -define(MAX_QUEUES_PER_PROCESS, 10). %%%=================================================================== %%% API %%%=================================================================== new(Limit) -> case get_filename() of {ok, Path} -> case file:open(Path, [read, write, binary, raw]) of {ok, Fd} -> monitor_me(Path), clear(#file_q{fd = Fd, path = Path, limit = Limit}); {error, Err} -> erlang:error({bad_queue, {Err, Path}}) end; {error, Err} -> erlang:error(Err) end. path(#file_q{path = Path}) -> Path. is_queue(#file_q{}) -> true; is_queue(_) -> false. len(#file_q{tail = Tail}) -> Tail. is_empty(#file_q{tail = Tail}) -> Tail == 0. get_limit(#file_q{limit = Limit}) -> Limit. set_limit(Q, Limit) -> Q#file_q{limit = Limit}. %% %% This is the only operation with side-effects, thus if you call %% this function on a queue and get the new queue as a result, %% you *MUST NOT* use the original queue, e.g. the following %% is potientailly dangerous: %% Q2 = p1_queue:in(some, Q1), %% p1_queue:out(Q1) %% ... likely an exception occurs here ... %% in(_, #file_q{owner = Owner, path = Path}) when Owner /= self() -> erlang:error({bad_queue, {not_owner, Path}}); in(Item, #file_q{start = Pos, stop = Pos} = Q) when Pos /= 0 -> in(Item, clear(Q)); in(Item, #file_q{fd = Fd, tail = Tail, stop = Pos, limit = Limit} = Q) when Tail < Limit -> Data = term_to_binary(Item), Size = size(Data), case file:pwrite(Fd, Pos, <<Size:32, Data/binary>>) of ok -> gc(Q#file_q{tail = Tail + 1, stop = Pos + Size + 4}); {error, Err} -> erlang:error({bad_queue, {Err, Q#file_q.path}}) end; in(_, _) -> erlang:error(full). out(#file_q{tail = 0} = Q) -> {empty, Q}; out(#file_q{owner = Owner, path = Path}) when Owner /= self() -> erlang:error({bad_queue, {not_owner, Path}}); out(#file_q{fd = Fd, tail = Tail, head = Head, start = Pos} = Q) -> case read_item(Fd, Pos) of {ok, Item, Next} -> {{value, Item}, Q#file_q{tail = Tail - 1, head = Head + 1, start = Next}}; {error, Err} -> erlang:error({bad_queue, {Err, Q#file_q.path}}) end. peek(#file_q{tail = 0}) -> empty; peek(#file_q{owner = Owner, path = Path}) when Owner /= self() -> erlang:error({bad_queue, {not_owner, Path}}); peek(#file_q{fd = Fd, start = Pos} = Q) -> case read_item(Fd, Pos) of {ok, Item, _} -> {value, Item}; {error, Err} -> erlang:error({bad_queue, {Err, Q#file_q.path}}) end. drop(#file_q{tail = 0}) -> erlang:error(empty); drop(#file_q{owner = Owner, path = Path}) when Owner /= self() -> erlang:error({bad_queue, {not_owner, Path}}); drop(#file_q{fd = Fd, start = Pos, tail = Tail, head = Head} = Q) -> case read_item_size(Fd, Pos) of {ok, Size} -> Q#file_q{tail = Tail - 1, head = Head + 1, start = Pos + Size + 4}; {error, Err} -> erlang:error({bad_queue, {Err, Q#file_q.path}}) end. from_list(Items, Limit) when length(Items) =< Limit -> lists:foldl(fun in/2, new(Limit), Items); from_list(_, _) -> erlang:error(full). to_list(#file_q{owner = Owner, path = Path}) when Owner /= self() -> erlang:error({bad_queue, {not_owner, Path}}); to_list(#file_q{fd = Fd, tail = Tail, start = Pos} = Q) -> case to_list(Fd, Pos, Tail, []) of {ok, L} -> L; {error, Err} -> erlang:error({bad_queue, {Err, Q#file_q.path}}) end. dropwhile(F, Q) -> case peek(Q) of {value, Item} -> case F(Item) of true -> dropwhile(F, drop(Q)); _ -> Q end; empty -> Q end. foldl(F, Acc, Q) -> case out(Q) of {{value, Item}, Q1} -> Acc1 = F(Item, Acc), foldl(F, Acc1, Q1); {empty, _} -> Acc end. foreach(F, Q) -> case out(Q) of {{value, Item}, Q1} -> F(Item), foreach(F, Q1); {empty, _} -> ok end. clear(#file_q{owner = Owner, path = Path}) when Owner /= self() -> erlang:error({bad_queue, {not_owner, Path}}); clear(#file_q{fd = Fd, path = Path, limit = Limit}) -> case file:position(Fd, 0) of {ok, 0} -> case file:truncate(Fd) of ok -> #file_q{fd = Fd, path = Path, limit = Limit}; {error, Err} -> erlang:error({bad_queue, {Err, Path}}) end; {error, Err} -> erlang:error({bad_queue, {Err, Path}}) end. close(#file_q{fd = Fd, path = Path}) -> file:close(Fd), demonitor_me(Path). -spec format_error(error_reason()) -> string(). format_error({corrupted, Path}) -> "file queue is corrupted (" ++ binary_to_list(Path) ++ ")"; format_error({not_owner, Path}) -> "not a file queue owner (" ++ binary_to_list(Path) ++ ")"; format_error({Posix, Path}) -> case file:format_error(Posix) of "unknown POSIX error" -> atom_to_list(Posix) ++ " (" ++ binary_to_list(Path) ++ ")"; Reason -> Reason ++ " (" ++ binary_to_list(Path) ++ ")" end. %%%=================================================================== %%% p1_server API %%%=================================================================== start(Dir) -> Spec = {?MODULE, {?MODULE, start_link, [Dir]}, permanent, 5000, worker, [?MODULE]}, supervisor:start_child(p1_utils_sup, Spec). stop() -> supervisor:terminate_child(p1_utils_sup, ?MODULE), supervisor:delete_child(p1_utils_sup, ?MODULE). start_link(Dir) -> gen_server:start_link({local, ?MODULE}, ?MODULE, [Dir], []). init([Dir]) -> case filelib:ensure_dir(filename:join(Dir, "foo")) of ok -> crypto:start(), process_flag(trap_exit, true), {ok, #state{dir = Dir, files = #{}, counter = 0}}; {error, Reason} -> error_logger:error_msg( "failed to create directory \"~s\": ~s", [Dir, file:format_error(Reason)]), {stop, Reason} end. handle_call({get_filename, Owner}, _, #state{dir = Dir} = State) -> Paths = maps:get(Owner, State#state.files, []), if length(Paths) >= ?MAX_QUEUES_PER_PROCESS -> {reply, {error, emfile}, State}; true -> Counter = State#state.counter + 1, Path = iolist_to_binary(filename:join(Dir, integer_to_list(Counter))), {reply, {ok, Path}, State#state{counter = Counter}} end; handle_call(_Request, _From, State) -> Reply = ok, {reply, Reply, State}. handle_cast({monitor, Owner, Path}, State) -> Paths = maps:get(Owner, State#state.files, []), if Paths == [] -> erlang:monitor(process, Owner); true -> ok end, Files = maps:put(Owner, [Path|Paths], State#state.files), {noreply, State#state{files = Files}}; handle_cast({demonitor, Owner, Path}, State) -> spawn(fun() -> file:delete(Path) end), Paths = maps:get(Owner, State#state.files, []), Files = case lists:delete(Path, Paths) of [] -> %% TODO: demonitor process maps:remove(Owner, State#state.files); NewPaths -> maps:put(Owner, NewPaths, State#state.files) end, {noreply, State#state{files = Files}}; handle_cast(_Msg, State) -> {noreply, State}. handle_info({'DOWN', _MRef, _Type, Owner, _Info}, State) -> Paths = maps:get(Owner, State#state.files, []), spawn(lists, foreach, [fun(Path) -> file:delete(Path) end, Paths]), Files = maps:remove(Owner, State#state.files), {noreply, State#state{files = Files}}; handle_info(Info, State) -> error_logger:error_msg("unexpected info: ~p", [Info]), {noreply, State}. terminate(_Reason, #state{dir = Dir}) -> clean_dir(Dir). code_change(_OldVsn, State, _Extra) -> {ok, State}. %%%=================================================================== %%% Internal functions %%%=================================================================== get_filename() -> p1_server:call(?MODULE, {get_filename, self()}). clean_dir(Dir) -> filelib:fold_files( Dir, "[0-9]+", false, fun(File, _) -> file:delete(File) end, ok). monitor_me(Path) -> p1_server:cast(?MODULE, {monitor, self(), Path}). demonitor_me(Path) -> p1_server:cast(?MODULE, {demonitor, self(), Path}). read_item_size(Fd, Pos) -> case file:pread(Fd, Pos, 4) of {ok, <<Size:32>>} -> {ok, Size}; {error, _} = Err -> Err; _ -> {error, corrupted} end. read_item(Fd, Pos) -> case read_item_size(Fd, Pos) of {ok, Size} -> case file:pread(Fd, Pos+4, Size) of {ok, Data} -> try binary_to_term(Data) of Item -> {ok, Item, Pos + Size + 4} catch _:_ -> {error, corrupted} end; {error, _} = Err -> Err; _ -> {error, corrupted} end; {error, _} = Err -> Err end. to_list(_Fd, _Pos, 0, Items) -> {ok, lists:reverse(Items)}; to_list(Fd, Pos, Len, Items) -> case read_item(Fd, Pos) of {ok, Item, NextPos} -> to_list(Fd, NextPos, Len-1, [Item|Items]); {error, _} = Err -> Err end. -define(MAX_HEAD, 1000). %% @doc shrink head when there are more than MAX_HEAD elements in the head gc(#file_q{fd = Fd, path = Path, limit = Limit, tail = Tail, head = Head, start = Start, stop = Stop} = Q) -> if Head >= ?MAX_HEAD, Stop > Start -> try {ok, NewFd} = file:open(Path, [read, write, raw, binary]), {ok, _} = file:position(Fd, Start), {ok, _} = file:copy(Fd, NewFd, Stop - Start), file:close(Fd), {ok, _} = file:position(NewFd, Stop - Start), ok = file:truncate(NewFd), #file_q{fd = NewFd, start = 0, stop = Stop - Start, head = 0, tail = Tail, path = Path, limit = Limit} catch _:{badmatch, {error, Err}} -> erlang:error({bad_queue, {Err, Path}}); _:{badmatch, eof} -> erlang:error({bad_queue, {corrupted, Path}}) end; true -> Q end. 07070100000018000081A4000000000000000000000001626FB04100008068000000000000000000000000000000000000001F00000000p1_utils-1.0.25/src/p1_fsm.erl%% ``The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved via the world wide web at http://www.erlang.org/. %% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. %% %% The Initial Developer of the Original Code is Ericsson Utvecklings AB. %% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings %% AB. All Rights Reserved.'' %% %% The code has been modified and improved by ProcessOne. %% %% Copyright 2007-2022 ProcessOne %% %% The change adds the following features: %% - You can send exit(priority_shutdown) to the p1_fsm process to %% terminate immediatetly. If the fsm trap_exit process flag has been %% set to true, the FSM terminate function will called. %% - You can pass the gen_fsm options to control resource usage. %% {max_queue, N} will exit the process with priority_shutdown %% - You can limit the time processing a message (TODO): If the %% message processing does not return in a given period of time, the %% process will be terminated. %% - You might customize the State data before sending it to error_logger %% in case of a crash (just export the function print_state/1) %% $Id$ %% -module(p1_fsm). %%%----------------------------------------------------------------- %%% %%% This state machine is somewhat more pure than state_lib. It is %%% still based on State dispatching (one function per state), but %%% allows a function handle_event to take care of events in all states. %%% It's not that pure anymore :( We also allow synchronized event sending. %%% %%% If the Parent process terminates the Module:terminate/2 %%% function is called. %%% %%% The user module should export: %%% %%% init(Args) %%% ==> {ok, StateName, StateData} %%% {ok, StateName, StateData, Timeout} %%% ignore %%% {stop, Reason} %%% %%% StateName(Msg, StateData) %%% %%% ==> {next_state, NewStateName, NewStateData} %%% {next_state, NewStateName, NewStateData, Timeout} %%% {stop, Reason, NewStateData} %%% Reason = normal | shutdown | Term terminate(State) is called %%% %%% StateName(Msg, From, StateData) %%% %%% ==> {next_state, NewStateName, NewStateData} %%% {next_state, NewStateName, NewStateData, Timeout} %%% {reply, Reply, NewStateName, NewStateData} %%% {reply, Reply, NewStateName, NewStateData, Timeout} %%% {stop, Reason, NewStateData} %%% Reason = normal | shutdown | Term terminate(State) is called %%% %%% handle_event(Msg, StateName, StateData) %%% %%% ==> {next_state, NewStateName, NewStateData} %%% {next_state, NewStateName, NewStateData, Timeout} %%% {stop, Reason, Reply, NewStateData} %%% {stop, Reason, NewStateData} %%% Reason = normal | shutdown | Term terminate(State) is called %%% %%% handle_sync_event(Msg, From, StateName, StateData) %%% %%% ==> {next_state, NewStateName, NewStateData} %%% {next_state, NewStateName, NewStateData, Timeout} %%% {reply, Reply, NewStateName, NewStateData} %%% {reply, Reply, NewStateName, NewStateData, Timeout} %%% {stop, Reason, Reply, NewStateData} %%% {stop, Reason, NewStateData} %%% Reason = normal | shutdown | Term terminate(State) is called %%% %%% handle_info(Info, StateName) (e.g. {'EXIT', P, R}, {nodedown, N}, ... %%% %%% ==> {next_state, NewStateName, NewStateData} %%% {next_state, NewStateName, NewStateData, Timeout} %%% {stop, Reason, NewStateData} %%% Reason = normal | shutdown | Term terminate(State) is called %%% %%% terminate(Reason, StateName, StateData) Let the user module clean up %%% always called when server terminates %%% %%% ==> the return value is ignored %%% %%% %%% The work flow (of the fsm) can be described as follows: %%% %%% User module fsm %%% ----------- ------- %%% start -----> start %%% init <----- . %%% %%% loop %%% StateName <----- . %%% %%% handle_event <----- . %%% %%% handle__sunc_event <----- . %%% %%% handle_info <----- . %%% %%% terminate <----- . %%% %%% %%% --------------------------------------------------- -export([start/3, start/4, start_link/3, start_link/4, send_event/2, sync_send_event/2, sync_send_event/3, send_all_state_event/2, sync_send_all_state_event/2, sync_send_all_state_event/3, reply/2, start_timer/2,send_event_after/2,cancel_timer/1, enter_loop/4, enter_loop/5, enter_loop/6, wake_hib/7]). %% Internal exports -export([init_it/6, print_event/3, system_continue/3, system_terminate/4, system_code_change/4, format_status/2]). -import(error_logger , [format/2]). %%% Internal gen_fsm state %%% This state is used to defined resource control values: -record(limits, {max_queue :: non_neg_integer() | undefined}). %%% --------------------------------------------------- %%% Interface functions. %%% --------------------------------------------------- -callback init(Args :: term()) -> {ok, StateName :: atom(), StateData :: term()} | {ok, StateName :: atom(), StateData :: term(), timeout() | hibernate} | {stop, Reason :: term()} | ignore. -callback handle_event(Event :: term(), StateName :: atom(), StateData :: term()) -> {next_state, NextStateName :: atom(), NewStateData :: term()} | {next_state, NextStateName :: atom(), NewStateData :: term(), timeout() | hibernate} | {migrate, NewStateData :: term(), {Node :: atom(), M :: atom(), F :: atom(), A :: list()}, Timeout :: timeout()} | {stop, Reason :: term(), NewStateData :: term()}. -callback handle_sync_event(Event :: term(), From :: {pid(), Tag :: term()}, StateName :: atom(), StateData :: term()) -> {reply, Reply :: term(), NextStateName :: atom(), NewStateData :: term()} | {reply, Reply :: term(), NextStateName :: atom(), NewStateData :: term(), timeout() | hibernate} | {next_state, NextStateName :: atom(), NewStateData :: term()} | {next_state, NextStateName :: atom(), NewStateData :: term(), timeout() | hibernate} | {migrate, NewStateData :: term(), {Node :: atom(), M :: atom(), F :: atom(), A :: list()}, Timeout :: timeout()} | {stop, Reason :: term(), Reply :: term(), NewStateData :: term()} | {stop, Reason :: term(), NewStateData :: term()}. -callback handle_info(Info :: term(), StateName :: atom(), StateData :: term()) -> {next_state, NextStateName :: atom(), NewStateData :: term()} | {next_state, NextStateName :: atom(), NewStateData :: term(), timeout() | hibernate} | {migrate, NewStateData :: term(), {Node :: atom(), M :: atom(), F :: atom(), A :: list()}, Timeout :: timeout()} | {stop, Reason :: normal | term(), NewStateData :: term()}. -callback terminate(Reason :: normal | shutdown | {shutdown, term()} | term(), StateName :: atom(), StateData :: term()) -> term(). -callback code_change(OldVsn :: term() | {down, term()}, StateName :: atom(), StateData :: term(), Extra :: term()) -> {ok, NextStateName :: atom(), NewStateData :: term()}. %%% --------------------------------------------------- %%% Starts a generic state machine. %%% start(Mod, Args, Options) %%% start(Name, Mod, Args, Options) %%% start_link(Mod, Args, Options) %%% start_link(Name, Mod, Args, Options) where: %%% Name ::= {local, atom()} | {global, atom()} %%% Mod ::= atom(), callback module implementing the 'real' fsm %%% Args ::= term(), init arguments (to Mod:init/1) %%% Options ::= [{debug, [Flag]}] %%% Flag ::= trace | log | {logfile, File} | statistics | debug %%% (debug == log && statistics) %%% Returns: {ok, Pid} | %%% {error, {already_started, Pid}} | %%% {error, Reason} %%% --------------------------------------------------- start(Mod, Args, Options) -> gen:start(?MODULE, nolink, Mod, Args, Options). start(Name, Mod, Args, Options) -> gen:start(?MODULE, nolink, Name, Mod, Args, Options). start_link(Mod, Args, Options) -> gen:start(?MODULE, link, Mod, Args, Options). start_link(Name, Mod, Args, Options) -> gen:start(?MODULE, link, Name, Mod, Args, Options). send_event({global, Name}, Event) -> catch global:send(Name, {'$gen_event', Event}), ok; send_event(Name, Event) -> Name ! {'$gen_event', Event}, ok. sync_send_event(Name, Event) -> case catch gen:call(Name, '$gen_sync_event', Event) of {ok,Res} -> Res; {'EXIT',Reason} -> exit({Reason, {?MODULE, sync_send_event, [Name, Event]}}) end. sync_send_event(Name, Event, Timeout) -> case catch gen:call(Name, '$gen_sync_event', Event, Timeout) of {ok,Res} -> Res; {'EXIT',Reason} -> exit({Reason, {?MODULE, sync_send_event, [Name, Event, Timeout]}}) end. send_all_state_event({global, Name}, Event) -> catch global:send(Name, {'$gen_all_state_event', Event}), ok; send_all_state_event(Name, Event) -> Name ! {'$gen_all_state_event', Event}, ok. sync_send_all_state_event(Name, Event) -> case catch gen:call(Name, '$gen_sync_all_state_event', Event) of {ok,Res} -> Res; {'EXIT',Reason} -> exit({Reason, {?MODULE, sync_send_all_state_event, [Name, Event]}}) end. sync_send_all_state_event(Name, Event, Timeout) -> case catch gen:call(Name, '$gen_sync_all_state_event', Event, Timeout) of {ok,Res} -> Res; {'EXIT',Reason} -> exit({Reason, {?MODULE, sync_send_all_state_event, [Name, Event, Timeout]}}) end. %% Designed to be only callable within one of the callbacks %% hence using the self() of this instance of the process. %% This is to ensure that timers don't go astray in global %% e.g. when straddling a failover, or turn up in a restarted %% instance of the process. %% Returns Ref, sends event {timeout,Ref,Msg} after Time %% to the (then) current state. start_timer(Time, Msg) -> erlang:start_timer(Time, self(), {'$gen_timer', Msg}). %% Returns Ref, sends Event after Time to the (then) current state. send_event_after(Time, Event) -> erlang:start_timer(Time, self(), {'$gen_event', Event}). %% Returns the remaining time for the timer if Ref referred to %% an active timer/send_event_after, false otherwise. cancel_timer(Ref) -> case erlang:cancel_timer(Ref) of false -> receive {timeout, Ref, _} -> 0 after 0 -> false end; RemainingTime -> RemainingTime end. %% enter_loop/4,5,6 %% Makes an existing process into a gen_fsm. %% The calling process will enter the gen_fsm receive loop and become a %% gen_fsm process. %% The process *must* have been started using one of the start functions %% in proc_lib, see proc_lib(3). %% The user is responsible for any initialization of the process, %% including registering a name for it. enter_loop(Mod, Options, StateName, StateData) -> enter_loop(Mod, Options, StateName, StateData, self(), infinity). enter_loop(Mod, Options, StateName, StateData, ServerName = {_,_}) -> enter_loop(Mod, Options, StateName, StateData, ServerName,infinity); enter_loop(Mod, Options, StateName, StateData, Timeout) -> enter_loop(Mod, Options, StateName, StateData, self(), Timeout). enter_loop(Mod, Options, StateName, StateData, ServerName, Timeout) -> Name = get_proc_name(ServerName), Parent = get_parent(), Debug = debug_options(Options), Limits = limit_options(Options), Queue = queue:new(), QueueLen = 0, loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug, Limits, Queue, QueueLen). get_proc_name(Pid) when is_pid(Pid) -> Pid; get_proc_name({local, Name}) -> case process_info(self(), registered_name) of {registered_name, Name} -> Name; {registered_name, _Name} -> exit(process_not_registered); [] -> exit(process_not_registered) end; get_proc_name({global, Name}) -> case global:whereis_name(Name) of undefined -> exit(process_not_registered_globally); Pid when Pid==self() -> Name; _Pid -> exit(process_not_registered_globally) end. get_parent() -> case get('$ancestors') of [Parent | _] when is_pid(Parent) -> Parent; [Parent | _] when is_atom(Parent) -> name_to_pid(Parent); _ -> exit(process_was_not_started_by_proc_lib) end. name_to_pid(Name) -> case whereis(Name) of undefined -> case global:whereis_name(Name) of undefined -> exit(could_not_find_registerd_name); Pid -> Pid end; Pid -> Pid end. %%% --------------------------------------------------- %%% Initiate the new process. %%% Register the name using the Rfunc function %%% Calls the Mod:init/Args function. %%% Finally an acknowledge is sent to Parent and the main %%% loop is entered. %%% --------------------------------------------------- init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name0, Mod, Args, Options) -> Name = name(Name0), Debug = debug_options(Options), Limits = limit_options(Options), Queue = queue:new(), QueueLen = 0, case catch Mod:init(Args) of {ok, StateName, StateData} -> proc_lib:init_ack(Starter, {ok, self()}), loop(Parent, Name, StateName, StateData, Mod, infinity, Debug, Limits, Queue, QueueLen); {ok, StateName, StateData, Timeout} -> proc_lib:init_ack(Starter, {ok, self()}), loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug, Limits, Queue, QueueLen); {stop, Reason} -> proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); ignore -> proc_lib:init_ack(Starter, ignore), exit(normal); {'EXIT', Reason} -> proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); Else -> Error = {bad_return_value, Else}, proc_lib:init_ack(Starter, {error, Error}), exit(Error) end. name({local,Name}) -> Name; name({global,Name}) -> Name; name(Pid) when is_pid(Pid) -> Pid. %%----------------------------------------------------------------- %% The MAIN loop %%----------------------------------------------------------------- loop(Parent, Name, StateName, StateData, Mod, hibernate, Debug, Limits, Queue, QueueLen) when QueueLen > 0 -> case queue:out(Queue) of {{value, Msg}, Queue1} -> decode_msg(Msg, Parent, Name, StateName, StateData, Mod, hibernate, Debug, Limits, Queue1, QueueLen - 1, false); {empty, _} -> Reason = internal_queue_error, error_info(Mod, Reason, Name, hibernate, StateName, StateData, Debug), exit(Reason) end; loop(Parent, Name, StateName, StateData, Mod, hibernate, Debug, Limits, _Queue, _QueueLen) -> proc_lib:hibernate(?MODULE,wake_hib, [Parent, Name, StateName, StateData, Mod, Debug, Limits]); %% First we test if we have reach a defined limit ... loop(Parent, Name, StateName, StateData, Mod, Time, Debug, Limits, Queue, QueueLen) -> try message_queue_len(Limits, QueueLen) %% TODO: We can add more limit checking here... catch {process_limit, Limit} -> Reason = {process_limit, Limit}, Msg = {'EXIT', Parent, {error, {process_limit, Limit}}}, terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug, queue:new()) end, process_message(Parent, Name, StateName, StateData, Mod, Time, Debug, Limits, Queue, QueueLen). %% ... then we can process a new message: process_message(Parent, Name, StateName, StateData, Mod, Time, Debug, Limits, Queue, QueueLen) -> {Msg, Queue1, QueueLen1} = collect_messages(Queue, QueueLen, Time), decode_msg(Msg,Parent, Name, StateName, StateData, Mod, Time, Debug, Limits, Queue1, QueueLen1, false). collect_messages(Queue, QueueLen, Time) -> receive Input -> case Input of {'EXIT', _Parent, priority_shutdown} -> {Input, Queue, QueueLen}; _ -> collect_messages( queue:in(Input, Queue), QueueLen + 1, Time) end after 0 -> case queue:out(Queue) of {{value, Msg}, Queue1} -> {Msg, Queue1, QueueLen - 1}; {empty, _} -> receive Input -> {Input, Queue, QueueLen} after Time -> {{'$gen_event', timeout}, Queue, QueueLen} end end end. wake_hib(Parent, Name, StateName, StateData, Mod, Debug, Limits) -> Msg = receive Input -> Input end, Queue = queue:new(), QueueLen = 0, decode_msg(Msg, Parent, Name, StateName, StateData, Mod, hibernate, Debug, Limits, Queue, QueueLen, true). decode_msg(Msg,Parent, Name, StateName, StateData, Mod, Time, Debug, Limits, Queue, QueueLen, Hib) -> put('$internal_queue_len', QueueLen), case Msg of {system, From, Req} -> sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, [Name, StateName, StateData, Mod, Time, Limits, Queue, QueueLen], Hib); {'EXIT', Parent, Reason} -> terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug, Queue); _Msg when Debug == [] -> handle_msg(Msg, Parent, Name, StateName, StateData, Mod, Time, Limits, Queue, QueueLen); _Msg -> Debug1 = sys:handle_debug(Debug, fun print_event/3, {Name, StateName}, {in, Msg}), handle_msg(Msg, Parent, Name, StateName, StateData, Mod, Time, Debug1, Limits, Queue, QueueLen) end. %%----------------------------------------------------------------- %% Callback functions for system messages handling. %%----------------------------------------------------------------- system_continue(Parent, Debug, [Name, StateName, StateData, Mod, Time, Limits, Queue, QueueLen]) -> loop(Parent, Name, StateName, StateData, Mod, Time, Debug, Limits, Queue, QueueLen). -spec system_terminate(term(), _, _, [term(),...]) -> no_return(). system_terminate(Reason, _Parent, Debug, [Name, StateName, StateData, Mod, _Time, _Limits, Queue, _QueueLen]) -> terminate(Reason, Name, [], Mod, StateName, StateData, Debug, Queue). system_code_change([Name, StateName, StateData, Mod, Time, Limits, Queue, QueueLen], _Module, OldVsn, Extra) -> case catch Mod:code_change(OldVsn, StateName, StateData, Extra) of {ok, NewStateName, NewStateData} -> {ok, [Name, NewStateName, NewStateData, Mod, Time, Limits, Queue, QueueLen]}; Else -> Else end. %%----------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees %% them, not as the real erlang messages. Use trace for that. %%----------------------------------------------------------------- print_event(Dev, {in, Msg}, {Name, StateName}) -> case Msg of {'$gen_event', Event} -> io:format(Dev, "*DBG* ~p got event ~p in state ~w~n", [Name, Event, StateName]); {'$gen_all_state_event', Event} -> io:format(Dev, "*DBG* ~p got all_state_event ~p in state ~w~n", [Name, Event, StateName]); {timeout, Ref, {'$gen_timer', Message}} -> io:format(Dev, "*DBG* ~p got timer ~p in state ~w~n", [Name, {timeout, Ref, Message}, StateName]); {timeout, _Ref, {'$gen_event', Event}} -> io:format(Dev, "*DBG* ~p got timer ~p in state ~w~n", [Name, Event, StateName]); _ -> io:format(Dev, "*DBG* ~p got ~p in state ~w~n", [Name, Msg, StateName]) end; print_event(Dev, {out, Msg, To, StateName}, Name) -> io:format(Dev, "*DBG* ~p sent ~p to ~w~n" " and switched to state ~w~n", [Name, Msg, To, StateName]); print_event(Dev, return, {Name, StateName}) -> io:format(Dev, "*DBG* ~p switched to state ~w~n", [Name, StateName]). relay_messages(MRef, TRef, Clone, Queue) -> lists:foreach( fun(Msg) -> Clone ! Msg end, queue:to_list(Queue)), relay_messages(MRef, TRef, Clone). relay_messages(MRef, TRef, Clone) -> receive {'DOWN', MRef, process, Clone, _Reason} -> normal; {'EXIT', _Parent, _Reason} -> {migrated, Clone}; {timeout, TRef, timeout} -> {migrated, Clone}; Msg -> Clone ! Msg, relay_messages(MRef, TRef, Clone) end. handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, Limits, Queue, QueueLen) -> %No debug here From = from(Msg), case catch dispatch(Msg, Mod, StateName, StateData) of {next_state, NStateName, NStateData} -> loop(Parent, Name, NStateName, NStateData, Mod, infinity, [], Limits, Queue, QueueLen); {next_state, NStateName, NStateData, Time1} -> loop(Parent, Name, NStateName, NStateData, Mod, Time1, [], Limits, Queue, QueueLen); {reply, Reply, NStateName, NStateData} when From =/= undefined -> reply(From, Reply), loop(Parent, Name, NStateName, NStateData, Mod, infinity, [], Limits, Queue, QueueLen); {reply, Reply, NStateName, NStateData, Time1} when From =/= undefined -> reply(From, Reply), loop(Parent, Name, NStateName, NStateData, Mod, Time1, [], Limits, Queue, QueueLen); {migrate, NStateData, {Node, M, F, A}, Time1} -> RPCTimeout = if Time1 == 0 -> %% We don't care about a delay, %% so we set it one minute 60000; true -> Time1 end, Now = p1_time_compat:monotonic_time(milli_seconds), Reason = case catch rpc_call(Node, M, F, A, RPCTimeout) of {ok, Clone} -> process_flag(trap_exit, true), MRef = erlang:monitor(process, Clone), NowDiff = p1_time_compat:monotonic_time(milli_seconds) - Now, TimeLeft = lists:max([Time1 - NowDiff, 0]), TRef = erlang:start_timer(TimeLeft, self(), timeout), relay_messages(MRef, TRef, Clone, Queue); _ -> normal end, Queue1 = case Reason of normal -> Queue; _ -> queue:new() end, terminate(Reason, Name, Msg, Mod, StateName, NStateData, [], Queue1); {stop, Reason, NStateData} -> terminate(Reason, Name, Msg, Mod, StateName, NStateData, [], Queue); {stop, Reason, Reply, NStateData} when From =/= undefined -> {'EXIT', R} = (catch terminate(Reason, Name, Msg, Mod, StateName, NStateData, [], Queue)), reply(From, Reply), exit(R); {'EXIT', What} -> terminate(What, Name, Msg, Mod, StateName, StateData, [], Queue); Reply -> terminate({bad_return_value, Reply}, Name, Msg, Mod, StateName, StateData, [], Queue) end. handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, Debug, Limits, Queue, QueueLen) -> From = from(Msg), case catch dispatch(Msg, Mod, StateName, StateData) of {next_state, NStateName, NStateData} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, {Name, NStateName}, return), loop(Parent, Name, NStateName, NStateData, Mod, infinity, Debug1, Limits, Queue, QueueLen); {next_state, NStateName, NStateData, Time1} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, {Name, NStateName}, return), loop(Parent, Name, NStateName, NStateData, Mod, Time1, Debug1, Limits, Queue, QueueLen); {reply, Reply, NStateName, NStateData} when From =/= undefined -> Debug1 = reply(Name, From, Reply, Debug, NStateName), loop(Parent, Name, NStateName, NStateData, Mod, infinity, Debug1, Limits, Queue, QueueLen); {reply, Reply, NStateName, NStateData, Time1} when From =/= undefined -> Debug1 = reply(Name, From, Reply, Debug, NStateName), loop(Parent, Name, NStateName, NStateData, Mod, Time1, Debug1, Limits, Queue, QueueLen); {migrate, NStateData, {Node, M, F, A}, Time1} -> RPCTimeout = if Time1 == 0 -> %% We don't care about a delay, %% so we set it one minute 60000; true -> Time1 end, Now = p1_time_compat:monotonic_time(milli_seconds), Reason = case catch rpc_call(Node, M, F, A, RPCTimeout) of {ok, Clone} -> process_flag(trap_exit, true), MRef = erlang:monitor(process, Clone), NowDiff = p1_time_compat:monotonic_time(milli_seconds) - Now, TimeLeft = lists:max([Time1 - NowDiff, 0]), TRef = erlang:start_timer(TimeLeft, self(), timeout), relay_messages(MRef, TRef, Clone, Queue); _ -> normal end, Queue1 = case Reason of normal -> Queue; _ -> queue:new() end, terminate(Reason, Name, Msg, Mod, StateName, NStateData, Debug, Queue1); {stop, Reason, NStateData} -> terminate(Reason, Name, Msg, Mod, StateName, NStateData, Debug, Queue); {stop, Reason, Reply, NStateData} when From =/= undefined -> {'EXIT', R} = (catch terminate(Reason, Name, Msg, Mod, StateName, NStateData, Debug, Queue)), reply(Name, From, Reply, Debug, StateName), exit(R); {'EXIT', What} -> terminate(What, Name, Msg, Mod, StateName, StateData, Debug, Queue); Reply -> terminate({bad_return_value, Reply}, Name, Msg, Mod, StateName, StateData, Debug, Queue) end. dispatch({'$gen_event', Event}, Mod, StateName, StateData) -> Mod:StateName(Event, StateData); dispatch({'$gen_all_state_event', Event}, Mod, StateName, StateData) -> Mod:handle_event(Event, StateName, StateData); dispatch({'$gen_sync_event', From, Event}, Mod, StateName, StateData) -> Mod:StateName(Event, From, StateData); dispatch({'$gen_sync_all_state_event', From, Event}, Mod, StateName, StateData) -> Mod:handle_sync_event(Event, From, StateName, StateData); dispatch({timeout, Ref, {'$gen_timer', Msg}}, Mod, StateName, StateData) -> Mod:StateName({timeout, Ref, Msg}, StateData); dispatch({timeout, _Ref, {'$gen_event', Event}}, Mod, StateName, StateData) -> Mod:StateName(Event, StateData); dispatch(Info, Mod, StateName, StateData) -> Mod:handle_info(Info, StateName, StateData). from({'$gen_sync_event', From, _Event}) -> From; from({'$gen_sync_all_state_event', From, _Event}) -> From; from(_) -> undefined. %% Send a reply to the client. reply({To, Tag}, Reply) -> catch To ! {Tag, Reply}. reply(Name, {To, Tag}, Reply, Debug, StateName) -> reply({To, Tag}, Reply), sys:handle_debug(Debug, fun print_event/3, Name, {out, Reply, To, StateName}). %%% --------------------------------------------------- %%% Terminate the server. %%% --------------------------------------------------- terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug, Queue) -> lists:foreach( fun(Message) -> self() ! Message end, queue:to_list(Queue)), case catch Mod:terminate(Reason, StateName, StateData) of {'EXIT', R} -> error_info(Mod, R, Name, Msg, StateName, StateData, Debug), exit(R); _ -> case Reason of normal -> exit(normal); shutdown -> exit(shutdown); priority_shutdown -> %% Priority shutdown should be considered as %% shutdown by SASL exit(shutdown); {process_limit, _Limit} -> exit(Reason); {migrated, _Clone} -> exit(normal); _ -> error_info(Mod, Reason, Name, Msg, StateName, StateData, Debug), exit(Reason) end end. error_info(Mod, Reason, Name, Msg, StateName, StateData, Debug) -> Reason1 = case Reason of {undef,[{M,F,A}|MFAs]} -> case code:is_loaded(M) of false -> {'module could not be loaded',[{M,F,A}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> Reason; false -> {'function not exported',[{M,F,A}|MFAs]} end end; _ -> Reason end, StateToPrint = case erlang:function_exported(Mod, print_state, 1) of true -> (catch Mod:print_state(StateData)); false -> StateData end, Str = "** State machine ~p terminating \n" ++ get_msg_str(Msg) ++ "** When State == ~p~n" "** Data == ~p~n" "** Reason for termination = ~n** ~p~n", format(Str, [Name, get_msg(Msg), StateName, StateToPrint, Reason1]), sys:print_log(Debug), ok. get_msg_str({'$gen_event', _Event}) -> "** Last event in was ~p~n"; get_msg_str({'$gen_sync_event', _Event}) -> "** Last sync event in was ~p~n"; get_msg_str({'$gen_all_state_event', _Event}) -> "** Last event in was ~p (for all states)~n"; get_msg_str({'$gen_sync_all_state_event', _Event}) -> "** Last sync event in was ~p (for all states)~n"; get_msg_str({timeout, _Ref, {'$gen_timer', _Msg}}) -> "** Last timer event in was ~p~n"; get_msg_str({timeout, _Ref, {'$gen_event', _Msg}}) -> "** Last timer event in was ~p~n"; get_msg_str(_Msg) -> "** Last message in was ~p~n". get_msg({'$gen_event', Event}) -> Event; get_msg({'$gen_sync_event', Event}) -> Event; get_msg({'$gen_all_state_event', Event}) -> Event; get_msg({'$gen_sync_all_state_event', Event}) -> Event; get_msg({timeout, Ref, {'$gen_timer', Msg}}) -> {timeout, Ref, Msg}; get_msg({timeout, _Ref, {'$gen_event', Event}}) -> Event; get_msg(Msg) -> Msg. %%----------------------------------------------------------------- %% Status information %%----------------------------------------------------------------- format_status(Opt, StatusData) -> [PDict, SysState, Parent, Debug, [Name, StateName, StateData, Mod, _Time, _Limits, _Queue, _QueueLen]] = StatusData, NameTag = if is_pid(Name) -> pid_to_list(Name); is_atom(Name) -> Name end, Header = lists:concat(["Status for state machine ", NameTag]), Log = sys_get_debug(log, Debug, []), Specific = case erlang:function_exported(Mod, format_status, 2) of true -> case catch Mod:format_status(Opt,[PDict,StateData]) of {'EXIT', _} -> [{data, [{"StateData", StateData}]}]; Else -> Else end; _ -> [{data, [{"StateData", StateData}]}] end, [{header, Header}, {data, [{"Status", SysState}, {"Parent", Parent}, {"Logged events", Log}, {"StateName", StateName}]} | Specific]. -ifdef(USE_OLD_SYS_GET_DEBUG). sys_get_debug(Item, Debug, Default) -> sys:get_debug(Item, Debug, Default). -else. sys_get_debug(log, Debug, _Default) -> sys:get_log(Debug). -endif. %%----------------------------------------------------------------- %% Resources limit management %%----------------------------------------------------------------- %% Extract know limit options limit_options(Options) -> limit_options(Options, #limits{}). limit_options([], Limits) -> Limits; %% Maximum number of messages allowed in the process message queue limit_options([{max_queue,N}|Options], Limits) when is_integer(N) -> NewLimits = Limits#limits{max_queue=N}, limit_options(Options, NewLimits); limit_options([_|Options], Limits) -> limit_options(Options, Limits). %% Throw max_queue if we have reach the max queue size %% Returns ok otherwise message_queue_len(#limits{max_queue = undefined}, _QueueLen) -> ok; message_queue_len(#limits{max_queue = MaxQueue}, QueueLen) -> Pid = self(), case process_info(Pid, message_queue_len) of {message_queue_len, N} when N + QueueLen > MaxQueue -> throw({process_limit, {max_queue, N + QueueLen}}); _ -> ok end. rpc_call(Node, Mod, Fun, Args, Timeout) -> Ref = make_ref(), Caller = self(), F = fun() -> group_leader(whereis(user), self()), case catch apply(Mod, Fun, Args) of {'EXIT', _} = Err -> Caller ! {Ref, {badrpc, Err}}; Result -> Caller ! {Ref, Result} end end, Pid = spawn(Node, F), MRef = erlang:monitor(process, Pid), receive {Ref, Result} -> erlang:demonitor(MRef, [flush]), Result; {'DOWN', MRef, _, _, noconnection = Reason} -> {badrpc, Reason} after Timeout -> erlang:demonitor(MRef, [flush]), catch exit(Pid, kill), receive {Ref, Result} -> Result after 0 -> {badrpc, timeout} end end. opt(Op, [{Op, Value}|_]) -> {ok, Value}; opt(Op, [_|Options]) -> opt(Op, Options); opt(_, []) -> false. debug_options(Opts) -> case opt(debug, Opts) of {ok, Options} -> sys:debug_options(Options); _ -> [] end. 07070100000019000081A4000000000000000000000001626FB04100001D9F000000000000000000000000000000000000002000000000p1_utils-1.0.25/src/p1_http.erl%%%------------------------------------------------------------------- %%% File : p1_http.erl %%% Author : Emilio Bustos <ebustos@process-one.net> %%% Purpose : Provide a common API for inets / lhttpc / ibrowse %%% Created : 29 Jul 2010 by Emilio Bustos <ebustos@process-one.net> %%% %%% %%% Copyright (C) 2002-2022 ProcessOne, SARL. All Rights Reserved. %%% %%% Licensed under the Apache License, Version 2.0 (the "License"); %%% you may not use this file except in compliance with the License. %%% You may obtain a copy of the License at %%% %%% http://www.apache.org/licenses/LICENSE-2.0 %%% %%% Unless required by applicable law or agreed to in writing, software %%% distributed under the License is distributed on an "AS IS" BASIS, %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %%% See the License for the specific language governing permissions and %%% limitations under the License. %%% %%%------------------------------------------------------------------- -module(p1_http). -author('ebustos@process-one.net'). -export([start/0, stop/0, get/1, get/2, post/2, post/3, request/3, request/4, request/5, get_pool_size/0, set_pool_size/1]). -type header() :: {string() | atom(), string()}. -type headers() :: [header()]. -type option() :: {connect_timeout, timeout()} | {timeout, timeout()} | {send_retry, non_neg_integer()} | {partial_upload, non_neg_integer() | infinity} | {partial_download, pid(), non_neg_integer() | infinity}. -type options() :: [option()]. -type result() :: {ok, {{pos_integer(), string()}, headers(), string()}} | {error, atom()}. -ifdef(USE_IBROWSE). start() -> application:start(ibrowse). stop() -> application:stop(ibrowse). %% @doc Sends a request with a body. %% Would be the same as calling %% `request(Method, URL, Hdrs, Body, [])', that is {@link request/5} %% with no options. %% @end %% @see request/5 request(Method, URL, Hdrs, Body, Opts) -> TimeOut = proplists:get_value(timeout, Opts, infinity), Options = [{inactivity_timeout, TimeOut} | proplists:delete(timeout, Opts)], case ibrowse:send_req(URL, Hdrs, Method, Body, Options) of {ok, Status, Headers, Response} -> {ok, jlib:binary_to_integer(Status), Headers, Response}; {error, Reason} -> {error, Reason} end. get_pool_size() -> application:get_env(ibrowse, default_max_sessions, 10). set_pool_size(Size) -> application:set_env(ibrowse, default_max_sessions, Size). -else. -ifdef(USE_LHTTPC). start() -> application:start(lhttpc). stop() -> application:stop(lhttpc). %% @doc Sends a request with a body. %% Would be the same as calling %% `request(Method, URL, Hdrs, Body, [])', that is {@link request/5} %% with no options. %% @end %% @see request/5 request(Method, URL, Hdrs, Body, Opts) -> {[TO, SO], Rest} = proplists:split(Opts, [timeout, socket_options]), TimeOut = proplists:get_value(timeout, TO, infinity), SockOpt = proplists:get_value(socket_options, SO, []), Options = [{connect_options, SockOpt} | Rest], Result = lhttpc:request(URL, Method, Hdrs, Body, TimeOut, Options), case Result of {ok, {{Status, _Reason}, Headers, Response}} -> {ok, Status, Headers, (Response)}; {error, Reason} -> {error, Reason} end. get_pool_size() -> Opts = proplists:get_value(lhttpc_manager, lhttpc_manager:list_pools()), proplists:get_value(max_pool_size,Opts). set_pool_size(Size) -> lhttpc_manager:set_max_pool_size(lhttpc_manager, Size). -else. start() -> application:start(inets). stop() -> application:stop(inets). to_list(Str) when is_binary(Str) -> binary_to_list(Str); to_list(Str) -> Str. %% @doc Sends a request with a body. %% Would be the same as calling %% `request(Method, URL, Hdrs, Body, [])', that is {@link request/5} %% with no options. %% @end %% @see request/5 -spec request(atom(), string(), headers(), string(), options()) -> result(). request(Method, URLRaw, HdrsRaw, Body, Opts) -> Hdrs = lists:map(fun({N, V}) -> {to_list(N), to_list(V)} end, HdrsRaw), URL = to_list(URLRaw), Request = case Method of get -> {URL, Hdrs}; head -> {URL, Hdrs}; delete -> {URL, Hdrs}; _ -> % post, etc. {URL, Hdrs, to_list(proplists:get_value(<<"content-type">>, HdrsRaw, [])), Body} end, Options = case proplists:get_value(timeout, Opts, infinity) of infinity -> proplists:delete(timeout, Opts); _ -> Opts end, case httpc:request(Method, Request, Options, []) of {ok, {{_, Status, _}, Headers, Response}} -> {ok, Status, Headers, Response}; {error, Reason} -> {error, Reason} end. get_pool_size() -> {ok, Size} = httpc:get_option(max_sessions), Size. set_pool_size(Size) -> httpc:set_option(max_sessions, Size). -endif. -endif. %% @doc Sends a GET request. %% Would be the same as calling `request(get, URL, [])', %% that is {@link request/3} with an empty header list. %% @end %% @see request/3 -spec get(string()) -> result(). get(URL) -> request(get, URL, []). %% @doc Sends a GET request. %% Would be the same as calling `request(get, URL, Hdrs)'. %% @end %% @see request/3 -spec get(string(), headers()) -> result(). get(URL, Hdrs) -> request(get, URL, Hdrs). %% @doc Sends a POST request with form data. %% Would be the same as calling %% `request(post, URL, [{"content-type", "x-www-form-urlencoded"}], Body)'. %% @end %% @see request/4 -spec post(string(), string()) -> result(). post(URL, Body) -> request(post, URL, [{"content-type", "x-www-form-urlencoded"}], Body). %% @doc Sends a POST request. %% Would be the same as calling %% `request(post, URL, Hdrs, Body)'. %% @end %% @see request/4 -spec post(string(), headers(), string()) -> result(). post(URL, Hdrs, Body) -> NewHdrs = case [X || {X, _} <- Hdrs, to_lower(X) == <<"content-type">>] of [] -> [{<<"content-type">>, <<"x-www-form-urlencoded">>} | Hdrs]; _ -> Hdrs end, request(post, URL, NewHdrs, Body). %% This function is copied from ejabberd's str.erl: -spec to_lower(binary()) -> binary(); (char()) -> char(). to_lower(B) when is_binary(B) -> iolist_to_binary(string:to_lower(binary_to_list(B))); to_lower(C) -> string:to_lower(C). %% @doc Sends a request without a body. %% Would be the same as calling `request(Method, URL, Hdrs, [], [])', %% that is {@link request/5} with an empty body. %% @end %% @see request/5 -spec request(atom(), string(), headers()) -> result(). request(Method, URL, Hdrs) -> request(Method, URL, Hdrs, [], []). %% @doc Sends a request with a body. %% Would be the same as calling %% `request(Method, URL, Hdrs, Body, [])', that is {@link request/5} %% with no options. %% @end %% @see request/5 -spec request(atom(), string(), headers(), string()) -> result(). request(Method, URL, Hdrs, Body) -> request(Method, URL, Hdrs, Body, []). % ibrowse {response_format, response_format()} | % Options - [option()] % Option - {sync, boolean()} | {stream, StreamTo} | {body_format, body_format()} | {full_result, % boolean()} | {headers_as_is, boolean()} %body_format() = string() | binary() % The body_format option is only valid for the synchronous request and the default is string. % When making an asynchronous request the body will always be received as a binary. % lhttpc: always binary 0707010000001A000081A4000000000000000000000001626FB04100000B63000000000000000000000000000000000000002500000000p1_utils-1.0.25/src/p1_nif_utils.erl%%%------------------------------------------------------------------- %%% File : p1_nif_utils.erl %%% Author : Paweł Chmielowski <pawel@process-one.net> %%% Description : Helper utilities for handling nif code %%% %%% Created : 7 Oct 2015 by Paweł Chmielowski <pawel@process-one.net> %%% %%% %%% Copyright (C) 2002-2022 ProcessOne, SARL. All Rights Reserved. %%% %%% Licensed under the Apache License, Version 2.0 (the "License"); %%% you may not use this file except in compliance with the License. %%% You may obtain a copy of the License at %%% %%% http://www.apache.org/licenses/LICENSE-2.0 %%% %%% Unless required by applicable law or agreed to in writing, software %%% distributed under the License is distributed on an "AS IS" BASIS, %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %%% See the License for the specific language governing permissions and %%% limitations under the License. %%% %%%------------------------------------------------------------------- -module(p1_nif_utils). -export([get_so_path/3]). get_so_path(ModuleName, AppNames, SoName) -> PrivDir = first_match(fun(App) -> case code:priv_dir(App) of {error, _} -> none; V -> V end end, AppNames), case PrivDir of none -> Ext = case os:type() of {win32, _} -> ".dll"; _ -> ".so" end, SoFName = filename:join(["priv", "lib", SoName ++ Ext]), LPath = first_match(fun(Path) -> P = case filename:basename(Path) of "ebin" -> filename:dirname(Path); _ -> Path end, case filelib:is_file(filename:join([P, SoFName])) of true -> filename:join([P, "priv", "lib", SoName]); _ -> none end end, code:get_path()), case LPath of none -> EbinDir = filename:dirname(code:which(ModuleName)), AppDir = filename:dirname(EbinDir), filename:join([AppDir, "priv", "lib", SoName]); Val -> Val end; V -> filename:join([V, "lib", SoName]) end. first_match(_Fun, []) -> none; first_match(Fun, [H|T]) -> case Fun(H) of none -> first_match(Fun, T); V -> V end. 0707010000001B000081A4000000000000000000000001626FB04100001932000000000000000000000000000000000000002300000000p1_utils-1.0.25/src/p1_options.erl%%%------------------------------------------------------------------- %%% @author Evgeny Khramtsov <ekhramtsov@process-one.net> %%% %%% %%% Copyright (C) 2002-2022 ProcessOne, SARL. All Rights Reserved. %%% %%% Licensed under the Apache License, Version 2.0 (the "License"); %%% you may not use this file except in compliance with the License. %%% You may obtain a copy of the License at %%% %%% http://www.apache.org/licenses/LICENSE-2.0 %%% %%% Unless required by applicable law or agreed to in writing, software %%% distributed under the License is distributed on an "AS IS" BASIS, %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %%% See the License for the specific language governing permissions and %%% limitations under the License. %%% %%%------------------------------------------------------------------- -module(p1_options). -behaviour(gen_server). %% API -export([start/1, start_link/1, insert/4, delete/3, lookup/3, clear/1, compile/1]). %% For debug only -export([dump/1]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -type scope() :: global | any(). -record(state, {tab :: atom()}). %%%=================================================================== %%% API %%%=================================================================== -spec start(atom()) -> ok | {error, already_started | any()}. start(Tab) -> case whereis(Tab) of undefined -> application:ensure_all_started(p1_utils), Spec = {?MODULE, {?MODULE, start_link, [Tab]}, permanent, 5000, worker, [?MODULE]}, case supervisor:start_child(p1_utils_sup, Spec) of {ok, _} -> ok; {error, {already_started, _}} -> {error, already_started}; {error, _} = Err -> Err end; _ -> {error, already_started} end. -spec start_link(atom()) -> {ok, pid()} | {error, any()}. start_link(Tab) -> gen_server:start_link({local, Tab}, ?MODULE, [Tab], []). -spec insert(atom(), atom(), scope(), any()) -> ok. insert(Tab, Opt, Scope, Val) -> ets:insert(Tab, {{Opt, Scope}, Val}), ok. -spec delete(atom(), atom(), scope()) -> ok. delete(Tab, Opt, Scope) -> ets:delete(Tab, {Opt, Scope}), ok. -spec lookup(atom(), atom(), scope()) -> {ok, any()} | undefined. lookup(Tab, Opt, Scope) -> case ets:lookup(Tab, {Opt, Scope}) of [] -> undefined; [{_, Val}] -> {ok, Val} end. -spec clear(atom()) -> ok. clear(Tab) -> ets:delete_all_objects(Tab), ok. -spec compile(atom()) -> ok. compile(Tab) -> case gen_server:call(Tab, compile, timer:minutes(1)) of ok -> ok; {error, Reason} -> error_logger:error_msg( "Failed to compile configuration for ~p: ~s", [Tab, format_error(Reason)]), erlang:error({compile_failed, Tab}) end. -spec dump(atom()) -> ok. dump(Mod) -> Exprs = get_exprs(Mod), File = filename:join("/tmp", atom_to_list(Mod) ++ ".erl"), case file:write_file(File, string:join(Exprs, io_lib:nl())) of ok -> %% erl_tidy:file(File, [{backups, false}]), io:format("Dynamic module '~s' is written to ~ts~n", [Mod, File]); {error, Reason} -> io:format("Failed to dump dynamic module '~s' to ~ts: ~s~n", [Mod, File, file:format_error(Reason)]) end. %%%=================================================================== %%% gen_server callbacks %%%=================================================================== init([Tab]) -> catch ets:new(Tab, [named_table, public, {read_concurrency, true}]), {ok, #state{tab = Tab}}. handle_call(compile, From, #state{tab = Tab} = State) -> do_compile(Tab, [From]), {noreply, State}; handle_call(_Request, _From, State) -> {noreply, State}. handle_cast(_Msg, State) -> {noreply, State}. handle_info(_Info, State) -> {noreply, State}. terminate(_Reason, _State) -> ok. code_change(_OldVsn, State, _Extra) -> {ok, State}. %%%=================================================================== %%% Internal functions %%%=================================================================== -spec do_compile(atom(), list()) -> ok. do_compile(Tab, Callers) -> receive {'gen_call', Caller, compile} -> do_compile(Tab, [Caller|Callers]) after 0 -> Exprs = get_exprs(Tab), Result = compile_exprs(Tab, Exprs), lists:foreach( fun(Caller) -> gen_server:reply(Caller, Result) end, lists:reverse(Callers)) end. -spec get_exprs(atom()) -> [string()]. get_exprs(Mod) -> OptMap = ets:foldl( fun({{Opt, Scope}, Val}, Acc) -> Vals = maps:get(Opt, Acc, []), maps:put(Opt, [{Scope, Val}|Vals], Acc) end, #{}, Mod), Opts = maps:fold( fun(Opt, Vals, Acc) -> Default = case lists:keyfind(global, 1, Vals) of {_, V} -> {ok, V}; false -> undefined end, [lists:flatmap( fun({Scope, Val}) when {ok, Val} /= Default -> io_lib:format( "~p(~p) -> {ok, ~p};~n", [Opt, Scope, Val]); (_) -> "" end, Vals) ++ io_lib:format("~p(_) -> ~p.", [Opt, Default]) |Acc] end, [], OptMap), Known = maps:fold( fun(Opt, _, Acc) -> io_lib:format( "is_known(~p) -> true;~n", [Opt]) ++ Acc end, "", OptMap) ++ "is_known(_) -> false.", Scopes = maps:fold( fun(Opt, Vals, Acc) -> io_lib:format( "get_scope(~p) -> ~p;~n", [Opt, [Scope || {Scope, _} <- Vals]]) ++ Acc end, "", OptMap) ++ "get_scope(_) -> [].", [io_lib:format("-module(~p).", [Mod]), "-compile(export_all).", Known, Scopes | Opts]. -spec compile_exprs(module(), [string()]) -> ok | {error, any()}. compile_exprs(Mod, Exprs) -> try Forms = lists:map( fun(Expr) -> {ok, Tokens, _} = erl_scan:string(lists:flatten(Expr)), {ok, Form} = erl_parse:parse_form(Tokens), Form end, Exprs), {ok, Code} = case compile:forms(Forms, []) of {ok, Mod, Bin} -> {ok, Bin}; {ok, Mod, Bin, _Warnings} -> {ok, Bin}; Error -> Error end, {module, Mod} = code:load_binary(Mod, "nofile", Code), ok catch _:{badmatch, {error, ErrInfo, _ErrLocation}} -> {error, ErrInfo}; _:{badmatch, {error, _} = Err} -> Err; _:{badmatch, error} -> {error, compile_failed} end. format_error({_Line, _Mod, _Term} = Reason) -> "Syntax error at line " ++ file:format_error(Reason); format_error(Reason) -> atom_to_list(Reason). 0707010000001C000081A4000000000000000000000001626FB04100002778000000000000000000000000000000000000002000000000p1_utils-1.0.25/src/p1_prof.erl%%%------------------------------------------------------------------- %%% File : p1_prof.erl %%% Author : Evgeniy Khramtsov <ekhramtsov@process-one.net> %%% Description : Handy wrapper around eprof and fprof %%% %%% Created : 23 Jan 2010 by Evgeniy Khramtsov <ekhramtsov@process-one.net> %%% %%% %%% ejabberd, Copyright (C) 2002-2022 ProcessOne %%% %%% 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 2 of the %%% License, or (at your option) any later version. %%% %%% This program is distributed in the hope that it will be useful, %%% but WITHOUT ANY WARRANTY; without even the implied warranty of %%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU %%% General Public License for more details. %%% %%% You should have received a copy of the GNU General Public License along %%% with this program; if not, write to the Free Software Foundation, Inc., %%% 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. %%% %%%------------------------------------------------------------------- -module(p1_prof). %% API -export([eprof_start/0, eprof_stop/0, eprof_start/1, fprof_apply/3, fprof_start/0, fprof_start/1, fprof_stop/0, fprof_analyze/0, queue/0, queue/1, memory/0, memory/1, reds/0, reds/1, trace/1, help/0, q/0, m/0, r/0, q/1, m/1, r/1, locks/0, locks/1]). -define(TRACE_FILE, "/tmp/fprof.trace"). -define(ANALYSIS_FILE, "/tmp/fprof.analysis"). %%==================================================================== %% API %%==================================================================== eprof_start() -> eprof_start(get_procs()). eprof_start(Duration) when is_integer(Duration) -> eprof_start(get_procs()), timer:sleep(timer:seconds(Duration)), eprof_stop(); eprof_start([]) -> {error, no_procs_found}; eprof_start(Procs) -> eprof:start(), eprof:start_profiling(Procs). fprof_apply(M, F, A) -> fprof:apply(M, F, A, [{file, ?TRACE_FILE}]), fprof_analyze(). fprof_start() -> fprof_start(0). fprof_start(Duration) -> case get_procs() of [] -> {error, no_procs_found}; Procs -> case fprof:trace([start, {procs, Procs}, {file, ?TRACE_FILE}]) of ok -> io:format("Profiling started, writing trace data to ~s~n", [?TRACE_FILE]), if Duration > 0 -> timer:sleep(Duration*1000), fprof:trace([stop]), fprof:stop(); true-> ok end; Err -> io:format("Couldn't start profiling: ~p~n", [Err]), Err end end. fprof_stop() -> fprof:trace([stop]), case fprof:profile([{file, ?TRACE_FILE}]) of ok -> case fprof:analyse([totals, no_details, {sort, own}, no_callers, {dest, ?ANALYSIS_FILE}]) of ok -> fprof:stop(), format_fprof_analyze(); Err -> io:format("Couldn't analyze: ~p~n", [Err]), Err end; Err -> io:format("Couldn't compile a trace into profile data: ~p~n", [Err]), Err end. fprof_analyze() -> fprof_stop(). eprof_stop() -> eprof:stop_profiling(), eprof:analyze(total). help() -> M = ?MODULE, io:format("Brief help:~n" "~p:queue(N) - show top N pids sorted by queue length~n" "~p:queue() - shorthand for ~p:queue(10)~n" "~p:memory(N) - show top N pids sorted by memory usage~n" "~p:memory() - shorthand for ~p:memory(10)~n" "~p:reds(N) - show top N pids sorted by reductions~n" "~p:reds() - shorthand for ~p:reds(10)~n" "~p:q(N)|~p:q() - same as ~p:queue(N)|~p:queue()~n" "~p:m(N)|~p:m() - same as ~p:memory(N)|~p:memory()~n" "~p:r(N)|~p:r() - same as ~p:reds(N)|~p:reds()~n" "~p:trace(Pid) - trace Pid; to stop tracing close " "Erlang shell with Ctrl+C~n" "~p:eprof_start() - start eprof on all available pids; " "DO NOT use on production system!~n" "~p:eprof_stop() - stop eprof and print result~n" "~p:fprof_start() - start fprof on all available pids; " "DO NOT use on production system!~n" "~p:fprof_stop() - stop eprof and print formatted result~n" "~p:fprof_start(N) - start and run fprof for N seconds; " "use ~p:fprof_analyze() to analyze collected statistics and " "print formatted result; use on production system with CARE~n" "~p:fprof_analyze() - analyze previously collected statistics " "using ~p:fprof_start(N) and print formatted result~n" "~p:help() - print this help~n", lists:duplicate(31, M)). q() -> queue(). q(N) -> queue(N). m() -> memory(). m(N) -> memory(N). r() -> reds(). r(N) -> reds(N). queue() -> queue(10). memory() -> memory(10). reds() -> reds(10). queue(N) -> dump(N, lists:reverse(lists:ukeysort(1, all_pids(queue)))). memory(N) -> dump(N, lists:reverse(lists:ukeysort(2, all_pids(memory)))). reds(N) -> dump(N, lists:reverse(lists:ukeysort(3, all_pids(reductions)))). trace(Pid) -> erlang:trace(Pid, true, [send, 'receive']), trace_loop(). trace_loop() -> receive M -> io:format("~p~n", [M]), trace_loop() end. %%==================================================================== %% Internal functions %%==================================================================== get_procs() -> processes(). format_fprof_analyze() -> case file:consult(?ANALYSIS_FILE) of {ok, [_, [{totals, _, _, TotalOWN}] | Rest]} -> OWNs = lists:flatmap( fun({MFA, _, _, OWN}) -> Percent = OWN*100/TotalOWN, case round(Percent) of 0 -> []; _ -> [{mfa_to_list(MFA), Percent}] end end, Rest), ACCs = collect_accs(Rest), MaxACC = find_max(ACCs), MaxOWN = find_max(OWNs), io:format("=== Sorted by OWN:~n"), lists:foreach( fun({MFA, Per}) -> L = length(MFA), S = lists:duplicate(MaxOWN - L + 2, $ ), io:format("~s~s~.2f%~n", [MFA, S, Per]) end, lists:reverse(lists:keysort(2, OWNs))), io:format("~n=== Sorted by ACC:~n"), lists:foreach( fun({MFA, Per}) -> L = length(MFA), S = lists:duplicate(MaxACC - L + 2, $ ), io:format("~s~s~.2f%~n", [MFA, S, Per]) end, lists:reverse(lists:keysort(2, ACCs))); Err -> Err end. mfa_to_list({M, F, A}) -> atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A); mfa_to_list(F) when is_atom(F) -> atom_to_list(F). find_max(List) -> find_max(List, 0). find_max([{V, _}|Tail], Acc) -> find_max(Tail, lists:max([length(V), Acc])); find_max([], Acc) -> Acc. collect_accs(List) -> List1 = lists:filter( fun({MFA, _, _, _}) -> case MFA of {sys, _, _} -> false; suspend -> false; {gen_fsm, _, _} -> false; {p1_fsm, _, _} -> false; {gen, _, _} -> false; {gen_server, _, _} -> false; {proc_lib, _, _} -> false; _ -> true end end, List), TotalACC = lists:sum([A || {_, _, A, _} <- List1]), lists:flatmap( fun({MFA, _, ACC, _}) -> Percent = ACC*100/TotalACC, case round(Percent) of 0 -> []; _ -> [{mfa_to_list(MFA), Percent}] end end, List1). all_pids(Type) -> lists:foldl( fun(P, Acc) when P == self() -> %% exclude ourself from statistics Acc; (P, Acc) -> case catch process_info( P, [message_queue_len, status, memory, reductions, dictionary, current_function, registered_name]) of [{_, QLen}, {_, Status}, {_, Memory}, {_, Reds}, {_, Dict}, {_, CurFun}, {_, RegName}] -> Dict1 = filter_dict(Dict, RegName), {IntQLen, Dict2} = case lists:keytake('$internal_queue_len', 1, Dict1) of {value, {_, N}, D} -> {N, D}; false -> {0, Dict1} end, Len = QLen + IntQLen, if Type == queue andalso Len == 0 -> Acc; true -> Dict3 = [{message_queue_len, Len}, {status, Status}, {memory, Memory}, {reductions, Reds}, {current_function, CurFun}, {registered_name, RegName}|Dict2], [{Len, Memory, Reds, P, Dict3}|Acc] end; _ -> Acc end end, [], processes()). dump(N, Rs) -> lists:foreach( fun({_, _, _, Pid, Properties}) -> PidStr = pid_to_list(Pid), [_, Maj, Min] = string:tokens( string:substr( PidStr, 2, length(PidStr) - 2), "."), io:put_chars( [io_lib:format("** pid: pid(0,~s,~s)~n", [Maj, Min]), [io_lib:format("** ~s: ~p~n", [Key, Val]) || {Key, Val} <- Properties], io_lib:nl()]) end, nthhead(N, Rs)). nthhead(N, L) -> lists:reverse(nthhead(N, L, [])). nthhead(0, _L, Acc) -> Acc; nthhead(N, [H|T], Acc) -> nthhead(N-1, T, [H|Acc]); nthhead(_N, [], Acc) -> Acc. filter_dict(Dict, RegName) -> lists:filter( fun({'$internal_queue_len', _}) -> true; ({'$initial_call', _}) -> RegName == []; ({'$ancestors', _}) -> RegName == []; (_) -> false end, Dict). % output in the console counts of locks, optionally waiting for few seconds before collect locks() -> locks(5). locks(Time) -> lcnt:rt_opt({copy_save, true}), lcnt:start(), lcnt:clear(), timer:sleep(Time*1000), lcnt:collect(), lcnt:conflicts(), lcnt:stop(), lcnt:rt_opt({copy_save, false}), ok. 0707010000001D000081A4000000000000000000000001626FB041000015EA000000000000000000000000000000000000002A00000000p1_utils-1.0.25/src/p1_proxy_protocol.erl%%%---------------------------------------------------------------------- %%% File : p1_proxy_protocol.erl %%% Author : Paweł Chmielowski <pawel@process-one.net> %%% Purpose : %%% Created : 27 Nov 2018 by Paweł Chmielowski <pawel@process-one.net> %%% %%% %%% Copyright (C) 2002-2022 ProcessOne, SARL. All Rights Reserved. %%% %%% Licensed under the Apache License, Version 2.0 (the "License"); %%% you may not use this file except in compliance with the License. %%% You may obtain a copy of the License at %%% %%% http://www.apache.org/licenses/LICENSE-2.0 %%% %%% Unless required by applicable law or agreed to in writing, software %%% distributed under the License is distributed on an "AS IS" BASIS, %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %%% See the License for the specific language governing permissions and %%% limitations under the License. %%% %%%---------------------------------------------------------------------- -module(p1_proxy_protocol). -author("pawel@process-one.net"). %% API -export([decode/3]). -spec decode(gen_tcp | ssl, inet:socket(), integer()) -> {{inet:ip_address(), inet:port_number()}, {inet:ip_address(), inet:port_number()}} | {error, atom()} | {undefined, undefined}. decode(SockMod, Socket, Timeout) -> V = SockMod:recv(Socket, 6, Timeout), case V of {ok, <<"PROXY ">>} -> decode_v1(SockMod, Socket, Timeout); {ok, <<16#0d, 16#0a, 16#0d, 16#0a, 16#00, 16#0d>>} -> decode_v2(SockMod, Socket, Timeout); _ -> {error, eproto} end. decode_v1(SockMod, Socket, Timeout) -> case read_until_rn(SockMod, Socket, <<>>, false, Timeout) of {error, _} = Err -> Err; Val -> case binary:split(Val, <<" ">>, [global]) of [<<"TCP4">>, SAddr, DAddr, SPort, DPort] -> try {inet_parse:ipv4strict_address(binary_to_list(SAddr)), inet_parse:ipv4strict_address(binary_to_list(DAddr)), binary_to_integer(SPort), binary_to_integer(DPort)} of {{ok, DA}, {ok, SA}, DP, SP} -> {{SA, SP}, {DA, DP}}; _ -> {error, eproto} catch error:badarg -> {error, eproto} end; [<<"TCP6">>, SAddr, DAddr, SPort, DPort] -> try {inet_parse:ipv6strict_address(binary_to_list(SAddr)), inet_parse:ipv6strict_address(binary_to_list(DAddr)), binary_to_integer(SPort), binary_to_integer(DPort)} of {{ok, DA}, {ok, SA}, DP, SP} -> {{SA, SP}, {DA, DP}}; _ -> {error, eproto} catch error:badarg -> {error, eproto} end; [<<"UNKNOWN">> | _] -> {undefined, undefined} end end. decode_v2(SockMod, Socket, Timeout) -> case SockMod:recv(Socket, 10, Timeout) of {error, _} = Err -> Err; {ok, <<16#0a, 16#51, 16#55, 16#49, 16#54, 16#0a, 2:4, Command:4, Transport:8, AddrLen:16/big-unsigned-integer>>} -> case SockMod:recv(Socket, AddrLen, Timeout) of {error, _} = Err -> Err; {ok, Data} -> case Command of 0 -> case {inet:sockname(Socket), inet:peername(Socket)} of {{ok, SA}, {ok, DA}} -> {SA, DA}; {{error, _} = E, _} -> E; {_, {error, _} = E} -> E end; 1 -> case Transport of % UNSPEC or UNIX V when V == 0; V == 16#31; V == 16#32 -> {{unknown, unknown}, {unknown, unknown}}; % IPV4 over TCP or UDP V when V == 16#11; V == 16#12 -> case Data of <<D1:8, D2:8, D3:8, D4:8, S1:8, S2:8, S3:8, S4:8, DP:16/big-unsigned-integer, SP:16/big-unsigned-integer, _/binary>> -> {{{S1, S2, S3, S4}, SP}, {{D1, D2, D3, D4}, DP}}; _ -> {error, eproto} end; % IPV6 over TCP or UDP V when V == 16#21; V == 16#22 -> case Data of <<D1:16/big-unsigned-integer, D2:16/big-unsigned-integer, D3:16/big-unsigned-integer, D4:16/big-unsigned-integer, D5:16/big-unsigned-integer, D6:16/big-unsigned-integer, D7:16/big-unsigned-integer, D8:16/big-unsigned-integer, S1:16/big-unsigned-integer, S2:16/big-unsigned-integer, S3:16/big-unsigned-integer, S4:16/big-unsigned-integer, S5:16/big-unsigned-integer, S6:16/big-unsigned-integer, S7:16/big-unsigned-integer, S8:16/big-unsigned-integer, DP:16/big-unsigned-integer, SP:16/big-unsigned-integer, _/binary>> -> {{{S1, S2, S3, S4, S5, S6, S7, S8}, SP}, {{D1, D2, D3, D4, D5, D6, D7, D8}, DP}}; _ -> {error, eproto} end end; _ -> {error, eproto} end end; <<16#0a, 16#51, 16#55, 16#49, 16#54, 16#0a, _/binary>> -> {error, eproto}; _ -> {error, eproto} end. read_until_rn(_SockMod, _Socket, Data, _, _) when size(Data) > 107 -> {error, eproto}; read_until_rn(SockMod, Socket, Data, true, Timeout) -> case SockMod:recv(Socket, 1, Timeout) of {ok, <<"\n">>} -> Data; {ok, <<"\r">>} -> read_until_rn(SockMod, Socket, <<Data/binary, "\r">>, true, Timeout); {ok, Other} -> read_until_rn(SockMod, Socket, <<Data/binary, "\r", Other/binary>>, false, Timeout); {error, _} = Err -> Err end; read_until_rn(SockMod, Socket, Data, false, Timeout) -> case SockMod:recv(Socket, 2, Timeout) of {ok, <<"\r\n">>} -> Data; {ok, <<Byte:8, "\r">>} -> read_until_rn(SockMod, Socket, <<Data/binary, Byte:8>>, true, Timeout); {ok, Other} -> read_until_rn(SockMod, Socket, <<Data/binary, Other/binary>>, false, Timeout); {error, _} = Err -> Err end. 0707010000001E000081A4000000000000000000000001626FB0410000175E000000000000000000000000000000000000002100000000p1_utils-1.0.25/src/p1_queue.erl%%%------------------------------------------------------------------- %%% @author Evgeny Khramtsov <ekhramtsov@process-one.net> %%% @copyright (C) 2017-2022 Evgeny Khramtsov %%% @doc %%% %%% @end %%% Created : 8 Mar 2017 by Evgeny Khramtsov <ekhramtsov@process-one.net> %%%------------------------------------------------------------------- -module(p1_queue). %% API -export([new/0, new/1, new/2, is_queue/1, len/1, is_empty/1, in/2, out/1, peek/1, drop/1, from_list/1, from_list/2, from_list/3, to_list/1, clear/1, foreach/2, foldl/3, dropwhile/2, type/1, format_error/1, ram_to_file/1, file_to_ram/1, get_limit/1, set_limit/2]). -export([start/1, stop/0]). -type limit() :: non_neg_integer() | unlimited. -type rqueue() :: rqueue(any()). -type rqueue(T) :: {queue:queue(T), non_neg_integer(), limit()}. -type fqueue() :: p1_file_queue:queue(). -type queue() :: rqueue(any()) | fqueue(). -type queue(T) :: rqueue(T) | fqueue(). -type queue_type() :: ram | file. -type error_reason() :: p1_file_queue:error_reason(). -export_type([queue/0, queue/1, queue_type/0, error_reason/0]). %%%=================================================================== %%% API %%%=================================================================== -spec start(file:filename()) -> ok | {error, any()}. start(Dir) -> application:ensure_all_started(p1_utils), case p1_file_queue:start(Dir) of {ok, _} -> ok; {error, {already_started, _}} -> ok; Err -> Err end. -spec stop() -> ok | {error, any()}. stop() -> p1_file_queue:stop(). -spec new() -> rqueue(). new() -> new(ram). -spec new(ram) -> rqueue(); (file) -> fqueue(). new(Type) -> new(Type, unlimited). -spec new(ram, limit()) -> rqueue(); (file, limit()) -> fqueue(). new(ram, Limit) -> {queue:new(), 0, Limit}; new(file, Limit) -> p1_file_queue:new(Limit). -spec type(queue()) -> ram | {file, file:filename()}. type({_, _, _}) -> ram; type(Q) -> {file, p1_file_queue:path(Q)}. -spec is_queue(any()) -> boolean(). is_queue({Q, Len, _}) when is_integer(Len), Len >= 0 -> queue:is_queue(Q); is_queue(Q) -> p1_file_queue:is_queue(Q). -spec len(queue()) -> non_neg_integer(). len({_, Len, _}) -> Len; len(Q) -> p1_file_queue:len(Q). -spec is_empty(queue()) -> boolean(). is_empty({_, Len, _}) -> Len == 0; is_empty(Q) -> p1_file_queue:is_empty(Q). -spec get_limit(queue()) -> limit(). get_limit({_, _, Limit}) -> Limit; get_limit(Q) -> p1_file_queue:get_limit(Q). -spec set_limit(rqueue(T), limit()) -> rqueue(T); (fqueue(), limit()) -> fqueue(). set_limit({Q, Len, _}, Limit) -> {Q, Len, Limit}; set_limit(Q, Limit) -> p1_file_queue:set_limit(Q, Limit). -spec in(term(), rqueue(T)) -> rqueue(T); (term(), fqueue()) -> fqueue(). in(Item, {Q, Len, Limit}) -> if Len < Limit -> {queue:in(Item, Q), Len+1, Limit}; true -> erlang:error(full) end; in(Item, Q) -> p1_file_queue:in(Item, Q). -spec out(rqueue(T)) -> {{value, term()}, rqueue(T)} | {empty, rqueue(T)}; (fqueue()) -> {{value, term()}, fqueue()} | {empty, fqueue()}. out({Q, 0, Limit}) -> {empty, {Q, 0, Limit}}; out({Q, Len, Limit}) -> {{value, Item}, Q1} = queue:out(Q), {{value, Item}, {Q1, Len-1, Limit}}; out(Q) -> p1_file_queue:out(Q). -spec peek(queue(T)) -> empty | {value, T}. peek({Q, _, _}) -> queue:peek(Q); peek(Q) -> p1_file_queue:peek(Q). -spec drop(rqueue(T)) -> rqueue(T); (fqueue()) -> fqueue(). drop({Q, Len, Limit}) -> {queue:drop(Q), Len-1, Limit}; drop(Q) -> p1_file_queue:drop(Q). -spec from_list([T]) -> rqueue(T). from_list(L) -> from_list(L, ram, unlimited). -spec from_list([T], ram) -> rqueue(T); (list(), file) -> fqueue(). from_list(L, Type) -> from_list(L, Type, unlimited). -spec from_list([T], ram, limit()) -> rqueue(T); (list(), file, limit()) -> fqueue(). from_list(L, ram, Limit) -> Len = length(L), if Len =< Limit -> {queue:from_list(L), Len, Limit}; true -> erlang:error(full) end; from_list(L, file, Limit) -> p1_file_queue:from_list(L, Limit). -spec to_list(queue(T)) -> [T]. to_list({Q, _, _}) -> queue:to_list(Q); to_list(Q) -> p1_file_queue:to_list(Q). -spec foreach(fun((T) -> term()), queue(T)) -> ok. foreach(F, {Q, Len, Limit}) -> case queue:out(Q) of {{value, Item}, Q1} -> F(Item), foreach(F, {Q1, Len-1, Limit}); {empty, _} -> ok end; foreach(F, Q) -> p1_file_queue:foreach(F, Q). -spec foldl(fun((T1, T2) -> T2), T2, queue(T1)) -> T2. foldl(F, Acc, {Q, Len, Limit}) -> case queue:out(Q) of {{value, Item}, Q1} -> Acc1 = F(Item, Acc), foldl(F, Acc1, {Q1, Len-1, Limit}); {empty, _} -> Acc end; foldl(F, Acc, Q) -> p1_file_queue:foldl(F, Acc, Q). -spec dropwhile(fun((T) -> boolean()), rqueue(T)) -> rqueue(T); (fun((term()) -> boolean()), fqueue()) -> fqueue(). dropwhile(_, {_, 0, _} = Q) -> Q; dropwhile(F, {Q, Len, Limit}) -> {value, Item} = queue:peek(Q), case F(Item) of true -> dropwhile(F, {queue:drop(Q), Len-1, Limit}); _ -> {Q, Len, Limit} end; dropwhile(F, Q) -> p1_file_queue:dropwhile(F, Q). -spec clear(rqueue(T)) -> rqueue(T); (fqueue()) -> fqueue(). clear({_, _, Limit}) -> {queue:new(), 0, Limit}; clear(Q) -> p1_file_queue:clear(Q). -spec ram_to_file(queue()) -> fqueue(). ram_to_file({_, _, Limit} = Q) -> foldl(fun p1_file_queue:in/2, new(file, Limit), Q); ram_to_file(Q) -> Q. -spec file_to_ram(queue()) -> rqueue(). file_to_ram({_, _, _} = Q) -> Q; file_to_ram(Q) -> Limit = p1_file_queue:get_limit(Q), p1_file_queue:foldl(fun in/2, new(ram, Limit), Q). -spec format_error(error_reason()) -> string(). format_error(Reason) -> p1_file_queue:format_error(Reason). %%%=================================================================== %%% Internal functions %%%=================================================================== 0707010000001F000081A4000000000000000000000001626FB04100000A8F000000000000000000000000000000000000002000000000p1_utils-1.0.25/src/p1_rand.erl%%%---------------------------------------------------------------------- %%% File : p1_rand.erl %%% Author : Alexey Shchepin <alexey@process-one.net> %%% Purpose : Random generation number wrapper %%% Created : 13 Dec 2002 by Alexey Shchepin <alexey@process-one.net> %%% %%% %%% ejabberd, Copyright (C) 2002-2022 ProcessOne %%% %%% 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 2 of the %%% License, or (at your option) any later version. %%% %%% This program is distributed in the hope that it will be useful, %%% but WITHOUT ANY WARRANTY; without even the implied warranty of %%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU %%% General Public License for more details. %%% %%% You should have received a copy of the GNU General Public License along %%% with this program; if not, write to the Free Software Foundation, Inc., %%% 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. %%% %%%---------------------------------------------------------------------- -module(p1_rand). -author('alexey@process-one.net'). -export([get_string/0, uniform/0, uniform/1, uniform/2, bytes/1, round_robin/1, get_alphanum_string/1]). -define(THRESHOLD, 16#10000000000000000). -ifdef(HAVE_RAND). get_string() -> R = rand:uniform(?THRESHOLD), integer_to_binary(R). uniform() -> rand:uniform(). uniform(N) -> rand:uniform(N). uniform(N, M) -> rand:uniform(M-N+1) + N-1. -else. get_string() -> R = crypto:rand_uniform(0, ?THRESHOLD), integer_to_binary(R). uniform() -> crypto:rand_uniform(0, ?THRESHOLD)/?THRESHOLD. uniform(N) -> crypto:rand_uniform(1, N+1). uniform(N, M) -> crypto:rand_uniform(N, M+1). -endif. -spec bytes(non_neg_integer()) -> binary(). bytes(N) -> crypto:strong_rand_bytes(N). -spec round_robin(pos_integer()) -> non_neg_integer(). round_robin(N) -> p1_time_compat:unique_integer([monotonic, positive]) rem N. -spec get_alphanum_string(non_neg_integer()) -> binary(). get_alphanum_string(Length) -> list_to_binary(get_alphanum_string([], Length)). -spec get_alphanum_string(string(), non_neg_integer()) -> string(). get_alphanum_string(S, 0) -> S; get_alphanum_string(S, N) -> get_alphanum_string([make_rand_char() | S], N - 1). -spec make_rand_char() -> char(). make_rand_char() -> map_int_to_char(uniform(0, 61)). -spec map_int_to_char(0..61) -> char(). map_int_to_char(N) when N =< 9 -> N + 48; % Digit. map_int_to_char(N) when N =< 35 -> N + 55; % Upper-case character. map_int_to_char(N) when N =< 61 -> N + 61. % Lower-case character. 07070100000020000081A4000000000000000000000001626FB04100008DC4000000000000000000000000000000000000002200000000p1_utils-1.0.25/src/p1_server.erl%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. %% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. %% %% %CopyrightEnd% %% %% The code has been modified and improved by ProcessOne. %% %% Copyright 2007-2022 ProcessOne %% %% The change adds the following features: %% - You can send exit(priority_shutdown) to the p1_fsm process to %% terminate immediatetly. If the fsm trap_exit process flag has been %% set to true, the FSM terminate function will called. %% - You can pass the gen_fsm options to control resource usage. %% {max_queue, N} will exit the process with priority_shutdown %% - You can limit the time processing a message (TODO): If the %% message processing does not return in a given period of time, the %% process will be terminated. %% - You might customize the State data before sending it to error_logger %% in case of a crash (just export the function print_state/1) %% -module(p1_server). %%% --------------------------------------------------- %%% %%% The idea behind THIS server is that the user module %%% provides (different) functions to handle different %%% kind of inputs. %%% If the Parent process terminates the Module:terminate/2 %%% function is called. %%% %%% The user module should export: %%% %%% init(Args) %%% ==> {ok, State} %%% {ok, State, Timeout} %%% ignore %%% {stop, Reason} %%% %%% handle_call(Msg, {From, Tag}, State) %%% %%% ==> {reply, Reply, State} %%% {reply, Reply, State, Timeout} %%% {noreply, State} %%% {noreply, State, Timeout} %%% {stop, Reason, Reply, State} %%% Reason = normal | shutdown | Term terminate(State) is called %%% %%% handle_cast(Msg, State) %%% %%% ==> {noreply, State} %%% {noreply, State, Timeout} %%% {stop, Reason, State} %%% Reason = normal | shutdown | Term terminate(State) is called %%% %%% handle_info(Info, State) Info is e.g. {'EXIT', P, R}, {nodedown, N}, ... %%% %%% ==> {noreply, State} %%% {noreply, State, Timeout} %%% {stop, Reason, State} %%% Reason = normal | shutdown | Term, terminate(State) is called %%% %%% terminate(Reason, State) Let the user module clean up %%% always called when server terminates %%% %%% ==> ok %%% %%% %%% The work flow (of the server) can be described as follows: %%% %%% User module Generic %%% ----------- ------- %%% start -----> start %%% init <----- . %%% %%% loop %%% handle_call <----- . %%% -----> reply %%% %%% handle_cast <----- . %%% %%% handle_info <----- . %%% %%% terminate <----- . %%% %%% -----> reply %%% %%% %%% --------------------------------------------------- %% API -export([start/3, start/4, start_link/3, start_link/4, call/2, call/3, cast/2, reply/2, abcast/2, abcast/3, multi_call/2, multi_call/3, multi_call/4, enter_loop/3, enter_loop/4, enter_loop/5, wake_hib/6]). %% System exports -export([system_continue/3, system_terminate/4, system_code_change/4, system_get_state/1, system_replace_state/2, format_status/2]). %% Internal exports -export([init_it/6]). -import(error_logger, [format/2]). %%% Internal gen_fsm state %%% This state is used to defined resource control values: -record(limits, {max_queue :: non_neg_integer() | undefined}). %%%========================================================================= %%% API %%%========================================================================= -callback init(Args :: term()) -> {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | {stop, Reason :: term()} | ignore. -callback handle_call(Request :: term(), From :: {pid(), Tag :: term()}, State :: term()) -> {reply, Reply :: term(), NewState :: term()} | {reply, Reply :: term(), NewState :: term(), timeout() | hibernate} | {noreply, NewState :: term()} | {noreply, NewState :: term(), timeout() | hibernate} | {stop, Reason :: term(), Reply :: term(), NewState :: term()} | {stop, Reason :: term(), NewState :: term()}. -callback handle_cast(Request :: term(), State :: term()) -> {noreply, NewState :: term()} | {noreply, NewState :: term(), timeout() | hibernate} | {stop, Reason :: term(), NewState :: term()}. -callback handle_info(Info :: timeout | term(), State :: term()) -> {noreply, NewState :: term()} | {noreply, NewState :: term(), timeout() | hibernate} | {stop, Reason :: term(), NewState :: term()}. -callback terminate(Reason :: (normal | shutdown | {shutdown, term()} | term()), State :: term()) -> term(). -callback code_change(OldVsn :: (term() | {down, term()}), State :: term(), Extra :: term()) -> {ok, NewState :: term()} | {error, Reason :: term()}. %%% ----------------------------------------------------------------- %%% Starts a generic server. %%% start(Mod, Args, Options) %%% start(Name, Mod, Args, Options) %%% start_link(Mod, Args, Options) %%% start_link(Name, Mod, Args, Options) where: %%% Name ::= {local, atom()} | {global, atom()} | {via, atom(), term()} %%% Mod ::= atom(), callback module implementing the 'real' server %%% Args ::= term(), init arguments (to Mod:init/1) %%% Options ::= [{timeout, Timeout} | {debug, [Flag]}] %%% Flag ::= trace | log | {logfile, File} | statistics | debug %%% (debug == log && statistics) %%% Returns: {ok, Pid} | %%% {error, {already_started, Pid}} | %%% {error, Reason} %%% ----------------------------------------------------------------- start(Mod, Args, Options) -> gen:start(?MODULE, nolink, Mod, Args, Options). start(Name, Mod, Args, Options) -> gen:start(?MODULE, nolink, Name, Mod, Args, Options). start_link(Mod, Args, Options) -> gen:start(?MODULE, link, Mod, Args, Options). start_link(Name, Mod, Args, Options) -> gen:start(?MODULE, link, Name, Mod, Args, Options). %% ----------------------------------------------------------------- %% Make a call to a generic server. %% If the server is located at another node, that node will %% be monitored. %% If the client is trapping exits and is linked server termination %% is handled here (? Shall we do that here (or rely on timeouts) ?). %% ----------------------------------------------------------------- call(Name, Request) -> case catch gen:call(Name, '$gen_call', Request) of {ok,Res} -> Res; {'EXIT',Reason} -> exit({Reason, {?MODULE, call, [Name, Request]}}) end. call(Name, Request, Timeout) -> case catch gen:call(Name, '$gen_call', Request, Timeout) of {ok,Res} -> Res; {'EXIT',Reason} -> exit({Reason, {?MODULE, call, [Name, Request, Timeout]}}) end. %% ----------------------------------------------------------------- %% Make a cast to a generic server. %% ----------------------------------------------------------------- cast({global,Name}, Request) -> catch global:send(Name, cast_msg(Request)), ok; cast({via, Mod, Name}, Request) -> catch Mod:send(Name, cast_msg(Request)), ok; cast({Name,Node}=Dest, Request) when is_atom(Name), is_atom(Node) -> do_cast(Dest, Request); cast(Dest, Request) when is_atom(Dest) -> do_cast(Dest, Request); cast(Dest, Request) when is_pid(Dest) -> do_cast(Dest, Request). do_cast(Dest, Request) -> do_send(Dest, cast_msg(Request)), ok. cast_msg(Request) -> {'$gen_cast',Request}. %% ----------------------------------------------------------------- %% Send a reply to the client. %% ----------------------------------------------------------------- reply({To, Tag}, Reply) -> catch To ! {Tag, Reply}. %% ----------------------------------------------------------------- %% Asynchronous broadcast, returns nothing, it's just send 'n' pray %%----------------------------------------------------------------- abcast(Name, Request) when is_atom(Name) -> do_abcast([node() | nodes()], Name, cast_msg(Request)). abcast(Nodes, Name, Request) when is_list(Nodes), is_atom(Name) -> do_abcast(Nodes, Name, cast_msg(Request)). do_abcast([Node|Nodes], Name, Msg) when is_atom(Node) -> do_send({Name,Node},Msg), do_abcast(Nodes, Name, Msg); do_abcast([], _,_) -> abcast. %%% ----------------------------------------------------------------- %%% Make a call to servers at several nodes. %%% Returns: {[Replies],[BadNodes]} %%% A Timeout can be given %%% %%% A middleman process is used in case late answers arrives after %%% the timeout. If they would be allowed to glog the callers message %%% queue, it would probably become confused. Late answers will %%% now arrive to the terminated middleman and so be discarded. %%% ----------------------------------------------------------------- multi_call(Name, Req) when is_atom(Name) -> do_multi_call([node() | nodes()], Name, Req, infinity). multi_call(Nodes, Name, Req) when is_list(Nodes), is_atom(Name) -> do_multi_call(Nodes, Name, Req, infinity). multi_call(Nodes, Name, Req, infinity) -> do_multi_call(Nodes, Name, Req, infinity); multi_call(Nodes, Name, Req, Timeout) when is_list(Nodes), is_atom(Name), is_integer(Timeout), Timeout >= 0 -> do_multi_call(Nodes, Name, Req, Timeout). %%----------------------------------------------------------------- %% enter_loop(Mod, Options, State, <ServerName>, <TimeOut>) ->_ %% %% Description: Makes an existing process into a gen_server. %% The calling process will enter the gen_server receive %% loop and become a gen_server process. %% The process *must* have been started using one of the %% start functions in proc_lib, see proc_lib(3). %% The user is responsible for any initialization of the %% process, including registering a name for it. %%----------------------------------------------------------------- enter_loop(Mod, Options, State) -> enter_loop(Mod, Options, State, self(), infinity). enter_loop(Mod, Options, State, ServerName = {Scope, _}) when Scope == local; Scope == global -> enter_loop(Mod, Options, State, ServerName, infinity); enter_loop(Mod, Options, State, ServerName = {via, _, _}) -> enter_loop(Mod, Options, State, ServerName, infinity); enter_loop(Mod, Options, State, Timeout) -> enter_loop(Mod, Options, State, self(), Timeout). enter_loop(Mod, Options, State, ServerName, Timeout) -> Name = get_proc_name(ServerName), Parent = get_parent(), Debug = debug_options(Name, Options), Limits = limit_options(Options), Queue = queue:new(), QueueLen = 0, loop(Parent, Name, State, Mod, Timeout, Debug, Limits, Queue, QueueLen). %%%======================================================================== %%% Gen-callback functions %%%======================================================================== %%% --------------------------------------------------- %%% Initiate the new process. %%% Register the name using the Rfunc function %%% Calls the Mod:init/Args function. %%% Finally an acknowledge is sent to Parent and the main %%% loop is entered. %%% --------------------------------------------------- init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name0, Mod, Args, Options) -> Name = name(Name0), Debug = debug_options(Name, Options), Limits = limit_options(Options), Queue = queue:new(), QueueLen = 0, case catch Mod:init(Args) of {ok, State} -> proc_lib:init_ack(Starter, {ok, self()}), loop(Parent, Name, State, Mod, infinity, Debug, Limits, Queue, QueueLen); {ok, State, Timeout} -> proc_lib:init_ack(Starter, {ok, self()}), loop(Parent, Name, State, Mod, Timeout, Debug, Limits, Queue, QueueLen); {stop, Reason} -> %% For consistency, we must make sure that the %% registered name (if any) is unregistered before %% the parent process is notified about the failure. %% (Otherwise, the parent process could get %% an 'already_started' error if it immediately %% tried starting the process again.) unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); ignore -> unregister_name(Name0), proc_lib:init_ack(Starter, ignore), exit(normal); {'EXIT', Reason} -> unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); Else -> Error = {bad_return_value, Else}, proc_lib:init_ack(Starter, {error, Error}), exit(Error) end. name({local,Name}) -> Name; name({global,Name}) -> Name; name({via,_, Name}) -> Name; name(Pid) when is_pid(Pid) -> Pid. unregister_name({local,Name}) -> _ = (catch unregister(Name)); unregister_name({global,Name}) -> _ = global:unregister_name(Name); unregister_name({via, Mod, Name}) -> _ = Mod:unregister_name(Name); unregister_name(Pid) when is_pid(Pid) -> Pid. %%%======================================================================== %%% Internal functions %%%======================================================================== %%% --------------------------------------------------- %%% The MAIN loop. %%% --------------------------------------------------- loop(Parent, Name, State, Mod, hibernate, Debug, Limits, Queue, QueueLen) when QueueLen > 0 -> case queue:out(Queue) of {{value, Msg}, Queue1} -> decode_msg(Msg, Parent, Name, State, Mod, hibernate, Debug, Limits, Queue1, QueueLen - 1, false); {empty, _} -> Reason = internal_queue_error, error_info(Mod, Reason, Name, hibernate, State, Debug), exit(Reason) end; loop(Parent, Name, State, Mod, hibernate, Debug, Limits, _Queue, _QueueLen) -> proc_lib:hibernate(?MODULE,wake_hib,[Parent, Name, State, Mod, Debug, Limits]); %% First we test if we have reach a defined limit ... loop(Parent, Name, State, Mod, Time, Debug, Limits, Queue, QueueLen) -> try message_queue_len(Limits, QueueLen) %% TODO: We can add more limit checking here... catch {process_limit, Limit} -> Reason = {process_limit, Limit}, Msg = {'EXIT', Parent, {error, {process_limit, Limit}}}, terminate(Reason, Name, Msg, Mod, State, Debug, queue:new()) end, process_message(Parent, Name, State, Mod, Time, Debug, Limits, Queue, QueueLen). %% ... then we can process a new message: process_message(Parent, Name, State, Mod, Time, Debug, Limits, Queue, QueueLen) -> {Msg, Queue1, QueueLen1} = collect_messages(Queue, QueueLen, Time), decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, Limits, Queue1, QueueLen1, false). collect_messages(Queue, QueueLen, Time) -> receive Input -> case Input of {'EXIT', _Parent, priority_shutdown} -> {Input, Queue, QueueLen}; _ -> collect_messages( queue:in(Input, Queue), QueueLen + 1, Time) end after 0 -> case queue:out(Queue) of {{value, Msg}, Queue1} -> {Msg, Queue1, QueueLen - 1}; {empty, _} -> receive Input -> {Input, Queue, QueueLen} after Time -> {timeout, Queue, QueueLen} end end end. wake_hib(Parent, Name, State, Mod, Debug, Limits) -> Msg = receive Input -> Input end, Queue = queue:new(), QueueLen = 0, decode_msg(Msg, Parent, Name, State, Mod, hibernate, Debug, Limits, Queue, QueueLen, true). decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, Limits, Queue, QueueLen, Hib) -> put('$internal_queue_len', QueueLen), case Msg of {system, From, Req} -> sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, [Name, State, Mod, Time, Limits, Queue, QueueLen], Hib); {'EXIT', Parent, Reason} -> terminate(Reason, Name, Msg, Mod, State, Debug, Queue); _Msg when Debug =:= [] -> handle_msg(Msg, Parent, Name, State, Mod, Limits, Queue, QueueLen); _Msg -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {in, Msg}), handle_msg(Msg, Parent, Name, State, Mod, Debug1, Limits, Queue, QueueLen) end. %%% --------------------------------------------------- %%% Send/receive functions %%% --------------------------------------------------- do_send(Dest, Msg) -> case catch erlang:send(Dest, Msg, [noconnect]) of noconnect -> spawn(erlang, send, [Dest,Msg]); Other -> Other end. do_multi_call(Nodes, Name, Req, infinity) -> Tag = make_ref(), Monitors = send_nodes(Nodes, Name, Tag, Req), rec_nodes(Tag, Monitors, Name, undefined); do_multi_call(Nodes, Name, Req, Timeout) -> Tag = make_ref(), Caller = self(), Receiver = spawn( fun() -> %% Middleman process. Should be unsensitive to regular %% exit signals. The synchronization is needed in case %% the receiver would exit before the caller started %% the monitor. process_flag(trap_exit, true), Mref = erlang:monitor(process, Caller), receive {Caller,Tag} -> Monitors = send_nodes(Nodes, Name, Tag, Req), TimerId = erlang:start_timer(Timeout, self(), ok), Result = rec_nodes(Tag, Monitors, Name, TimerId), exit({self(),Tag,Result}); {'DOWN',Mref,_,_,_} -> %% Caller died before sending us the go-ahead. %% Give up silently. exit(normal) end end), Mref = erlang:monitor(process, Receiver), Receiver ! {self(),Tag}, receive {'DOWN',Mref,_,_,{Receiver,Tag,Result}} -> Result; {'DOWN',Mref,_,_,Reason} -> %% The middleman code failed. Or someone did %% exit(_, kill) on the middleman process => Reason==killed exit(Reason) end. send_nodes(Nodes, Name, Tag, Req) -> send_nodes(Nodes, Name, Tag, Req, []). send_nodes([Node|Tail], Name, Tag, Req, Monitors) when is_atom(Node) -> Monitor = start_monitor(Node, Name), %% Handle non-existing names in rec_nodes. catch {Name, Node} ! {'$gen_call', {self(), {Tag, Node}}, Req}, send_nodes(Tail, Name, Tag, Req, [Monitor | Monitors]); send_nodes([_Node|Tail], Name, Tag, Req, Monitors) -> %% Skip non-atom Node send_nodes(Tail, Name, Tag, Req, Monitors); send_nodes([], _Name, _Tag, _Req, Monitors) -> Monitors. %% Against old nodes: %% If no reply has been delivered within 2 secs. (per node) check that %% the server really exists and wait for ever for the answer. %% %% Against contemporary nodes: %% Wait for reply, server 'DOWN', or timeout from TimerId. rec_nodes(Tag, Nodes, Name, TimerId) -> rec_nodes(Tag, Nodes, Name, [], [], 2000, TimerId). rec_nodes(Tag, [{N,R}|Tail], Name, Badnodes, Replies, Time, TimerId ) -> receive {'DOWN', R, _, _, _} -> rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, Time, TimerId); {{Tag, N}, Reply} -> %% Tag is bound !!! erlang:demonitor(R, [flush]), rec_nodes(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies], Time, TimerId); {timeout, TimerId, _} -> erlang:demonitor(R, [flush]), %% Collect all replies that already have arrived rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies) end; rec_nodes(Tag, [N|Tail], Name, Badnodes, Replies, Time, TimerId) -> %% R6 node receive {nodedown, N} -> monitor_node(N, false), rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, 2000, TimerId); {{Tag, N}, Reply} -> %% Tag is bound !!! receive {nodedown, N} -> ok after 0 -> ok end, monitor_node(N, false), rec_nodes(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies], 2000, TimerId); {timeout, TimerId, _} -> receive {nodedown, N} -> ok after 0 -> ok end, monitor_node(N, false), %% Collect all replies that already have arrived rec_nodes_rest(Tag, Tail, Name, [N | Badnodes], Replies) after Time -> case rpc:call(N, erlang, whereis, [Name]) of Pid when is_pid(Pid) -> % It exists try again. rec_nodes(Tag, [N|Tail], Name, Badnodes, Replies, infinity, TimerId); _ -> % badnode receive {nodedown, N} -> ok after 0 -> ok end, monitor_node(N, false), rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, 2000, TimerId) end end; rec_nodes(_, [], _, Badnodes, Replies, _, TimerId) -> case catch erlang:cancel_timer(TimerId) of false -> % It has already sent it's message receive {timeout, TimerId, _} -> ok after 0 -> ok end; _ -> % Timer was cancelled, or TimerId was 'undefined' ok end, {Replies, Badnodes}. %% Collect all replies that already have arrived rec_nodes_rest(Tag, [{N,R}|Tail], Name, Badnodes, Replies) -> receive {'DOWN', R, _, _, _} -> rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies); {{Tag, N}, Reply} -> %% Tag is bound !!! erlang:demonitor(R, [flush]), rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies]) after 0 -> erlang:demonitor(R, [flush]), rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies) end; rec_nodes_rest(Tag, [N|Tail], Name, Badnodes, Replies) -> %% R6 node receive {nodedown, N} -> monitor_node(N, false), rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies); {{Tag, N}, Reply} -> %% Tag is bound !!! receive {nodedown, N} -> ok after 0 -> ok end, monitor_node(N, false), rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies]) after 0 -> receive {nodedown, N} -> ok after 0 -> ok end, monitor_node(N, false), rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies) end; rec_nodes_rest(_Tag, [], _Name, Badnodes, Replies) -> {Replies, Badnodes}. %%% --------------------------------------------------- %%% Monitor functions %%% --------------------------------------------------- start_monitor(Node, Name) when is_atom(Node), is_atom(Name) -> if node() =:= nonode@nohost, Node =/= nonode@nohost -> Ref = make_ref(), self() ! {'DOWN', Ref, process, {Name, Node}, noconnection}, {Node, Ref}; true -> case catch erlang:monitor(process, {Name, Node}) of {'EXIT', _} -> %% Remote node is R6 monitor_node(Node, true), Node; Ref when is_reference(Ref) -> {Node, Ref} end end. %%% --------------------------------------------------- %%% Message handling functions %%% --------------------------------------------------- dispatch({'$gen_cast', Msg}, Mod, State) -> Mod:handle_cast(Msg, State); dispatch(Info, Mod, State) -> Mod:handle_info(Info, State). handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Limits, Queue, QueueLen) -> case catch Mod:handle_call(Msg, From, State) of {reply, Reply, NState} -> reply(From, Reply), loop(Parent, Name, NState, Mod, infinity, [], Limits, Queue, QueueLen); {reply, Reply, NState, Time1} -> reply(From, Reply), loop(Parent, Name, NState, Mod, Time1, [], Limits, Queue, QueueLen); {noreply, NState} -> loop(Parent, Name, NState, Mod, infinity, [], Limits, Queue, QueueLen); {noreply, NState, Time1} -> loop(Parent, Name, NState, Mod, Time1, [], Limits, Queue, QueueLen); {stop, Reason, Reply, NState} -> {'EXIT', R} = (catch terminate(Reason, Name, Msg, Mod, NState, [], Queue)), reply(From, Reply), exit(R); Other -> handle_common_reply(Other, Parent, Name, Msg, Mod, State, Limits, Queue, QueueLen) end; handle_msg(Msg, Parent, Name, State, Mod, Limits, Queue, QueueLen) -> Reply = (catch dispatch(Msg, Mod, State)), handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Limits, Queue, QueueLen). handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug, Limits, Queue, QueueLen) -> case catch Mod:handle_call(Msg, From, State) of {reply, Reply, NState} -> Debug1 = reply(Name, From, Reply, NState, Debug), loop(Parent, Name, NState, Mod, infinity, Debug1, Limits, Queue, QueueLen); {reply, Reply, NState, Time1} -> Debug1 = reply(Name, From, Reply, NState, Debug), loop(Parent, Name, NState, Mod, Time1, Debug1, Limits, Queue, QueueLen); {noreply, NState} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, infinity, Debug1, Limits, Queue, QueueLen); {noreply, NState, Time1} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1, Limits, Queue, QueueLen); {stop, Reason, Reply, NState} -> {'EXIT', R} = (catch terminate(Reason, Name, Msg, Mod, NState, Debug, Queue)), reply(Name, From, Reply, NState, Debug), exit(R); Other -> handle_common_reply(Other, Parent, Name, Msg, Mod, State, Debug, Limits, Queue, QueueLen) end; handle_msg(Msg, Parent, Name, State, Mod, Debug, Limits, Queue, QueueLen) -> Reply = (catch dispatch(Msg, Mod, State)), handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug, Limits, Queue, QueueLen). handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Limits, Queue, QueueLen) -> case Reply of {noreply, NState} -> loop(Parent, Name, NState, Mod, infinity, [], Limits, Queue, QueueLen); {noreply, NState, Time1} -> loop(Parent, Name, NState, Mod, Time1, [], Limits, Queue, QueueLen); {stop, Reason, NState} -> terminate(Reason, Name, Msg, Mod, NState, [], Queue); {'EXIT', What} -> terminate(What, Name, Msg, Mod, State, [], Queue); _ -> terminate({bad_return_value, Reply}, Name, Msg, Mod, State, [], Queue) end. handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug, Limits, Queue, QueueLen) -> case Reply of {noreply, NState} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, infinity, Debug1, Limits, Queue, QueueLen); {noreply, NState, Time1} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1, Limits, Queue, QueueLen); {stop, Reason, NState} -> terminate(Reason, Name, Msg, Mod, NState, Debug, Queue); {'EXIT', What} -> terminate(What, Name, Msg, Mod, State, Debug, Queue); _ -> terminate({bad_return_value, Reply}, Name, Msg, Mod, State, Debug, Queue) end. reply(Name, {To, Tag}, Reply, State, Debug) -> reply({To, Tag}, Reply), sys:handle_debug(Debug, fun print_event/3, Name, {out, Reply, To, State} ). %%----------------------------------------------------------------- %% Callback functions for system messages handling. %%----------------------------------------------------------------- system_continue(Parent, Debug, [Name, State, Mod, Time, Limits, Queue, QueueLen]) -> loop(Parent, Name, State, Mod, Time, Debug, Limits, Queue, QueueLen). -spec system_terminate(_, _, _, [_]) -> no_return(). system_terminate(Reason, _Parent, Debug, [Name, State, Mod, _Time, _Limits, Queue, _QueueLen]) -> terminate(Reason, Name, [], Mod, State, Debug, Queue). system_code_change([Name, State, Mod, Time, Limits, Queue, QueueLen], _Module, OldVsn, Extra) -> case catch Mod:code_change(OldVsn, State, Extra) of {ok, NewState} -> {ok, [Name, NewState, Mod, Time, Limits, Queue, QueueLen]}; Else -> Else end. system_get_state([_Name, State, _Mod, _Time, _Limits, _Queue, _QueueLen]) -> {ok, State}. system_replace_state(StateFun, [Name, State, Mod, Time, Limits, Queue, QueueLen]) -> NState = StateFun(State), {ok, NState, [Name, NState, Mod, Time, Limits, Queue, QueueLen]}. %%----------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees %% them, not as the real erlang messages. Use trace for that. %%----------------------------------------------------------------- print_event(Dev, {in, Msg}, Name) -> case Msg of {'$gen_call', {From, _Tag}, Call} -> io:format(Dev, "*DBG* ~p got call ~p from ~w~n", [Name, Call, From]); {'$gen_cast', Cast} -> io:format(Dev, "*DBG* ~p got cast ~p~n", [Name, Cast]); _ -> io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg]) end; print_event(Dev, {out, Msg, To, State}, Name) -> io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n", [Name, Msg, To, State]); print_event(Dev, {noreply, State}, Name) -> io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]); print_event(Dev, Event, Name) -> io:format(Dev, "*DBG* ~p dbg ~p~n", [Name, Event]). %%% --------------------------------------------------- %%% Terminate the server. %%% --------------------------------------------------- terminate(Reason, Name, Msg, Mod, State, Debug, Queue) -> lists:foreach( fun(Message) -> self() ! Message end, queue:to_list(Queue)), case catch Mod:terminate(Reason, State) of {'EXIT', R} -> error_info(Mod, R, Name, Msg, State, Debug), exit(R); _ -> case Reason of normal -> exit(normal); shutdown -> exit(shutdown); {shutdown,_}=Shutdown -> exit(Shutdown); priority_shutdown -> %% Priority shutdown should be considered as %% shutdown by SASL exit(shutdown); {process_limit, _Limit} -> exit(Reason); _ -> FmtState = case erlang:function_exported(Mod, format_status, 2) of true -> Args = [get(), State], case catch Mod:format_status(terminate, Args) of {'EXIT', _} -> State; Else -> Else end; _ -> State end, error_info(Mod, Reason, Name, Msg, FmtState, Debug), exit(Reason) end end. error_info(_Mod, _Reason, application_controller, _Msg, _State, _Debug) -> %% OTP-5811 Don't send an error report if it's the system process %% application_controller which is terminating - let init take care %% of it instead ok; error_info(Mod, Reason, Name, Msg, State, Debug) -> Reason1 = case Reason of {undef,[{M,F,A,L}|MFAs]} -> case code:is_loaded(M) of false -> {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> Reason; false -> {'function not exported',[{M,F,A,L}|MFAs]} end end; _ -> Reason end, StateToPrint = case erlang:function_exported(Mod, print_state, 1) of true -> (catch Mod:print_state(State)); false -> State end, format("** Generic server ~p terminating \n" "** Last message in was ~p~n" "** When Server state == ~p~n" "** Reason for termination == ~n** ~p~n", [Name, Msg, StateToPrint, Reason1]), sys:print_log(Debug), ok. %%% --------------------------------------------------- %%% Misc. functions. %%% --------------------------------------------------- opt(Op, [{Op, Value}|_]) -> {ok, Value}; opt(Op, [_|Options]) -> opt(Op, Options); opt(_, []) -> false. debug_options(Name, Opts) -> case opt(debug, Opts) of {ok, Options} -> dbg_opts(Name, Options); _ -> dbg_opts(Name, []) end. dbg_opts(Name, Opts) -> case catch sys:debug_options(Opts) of {'EXIT',_} -> format("~p: ignoring erroneous debug options - ~p~n", [Name, Opts]), []; Dbg -> Dbg end. get_proc_name(Pid) when is_pid(Pid) -> Pid; get_proc_name({local, Name}) -> case process_info(self(), registered_name) of {registered_name, Name} -> Name; {registered_name, _Name} -> exit(process_not_registered); [] -> exit(process_not_registered) end; get_proc_name({global, Name}) -> case global:whereis_name(Name) of undefined -> exit(process_not_registered_globally); Pid when Pid =:= self() -> Name; _Pid -> exit(process_not_registered_globally) end; get_proc_name({via, Mod, Name}) -> case Mod:whereis_name(Name) of undefined -> exit({process_not_registered_via, Mod}); Pid when Pid =:= self() -> Name; _Pid -> exit({process_not_registered_via, Mod}) end. get_parent() -> case get('$ancestors') of [Parent | _] when is_pid(Parent)-> Parent; [Parent | _] when is_atom(Parent)-> name_to_pid(Parent); _ -> exit(process_was_not_started_by_proc_lib) end. name_to_pid(Name) -> case whereis(Name) of undefined -> case global:whereis_name(Name) of undefined -> exit(could_not_find_registered_name); Pid -> Pid end; Pid -> Pid end. %%----------------------------------------------------------------- %% Status information %%----------------------------------------------------------------- format_status(Opt, StatusData) -> [PDict, SysState, Parent, Debug, [Name, State, Mod, _Time, _Limits, _Queue, _QueueLen]] = StatusData, Header = gen:format_status_header("Status for generic server", Name), Log = sys_get_debug(log, Debug, []), DefaultStatus = [{data, [{"State", State}]}], Specific = case erlang:function_exported(Mod, format_status, 2) of true -> case catch Mod:format_status(Opt, [PDict, State]) of {'EXIT', _} -> DefaultStatus; StatusList when is_list(StatusList) -> StatusList; Else -> [Else] end; _ -> DefaultStatus end, [{header, Header}, {data, [{"Status", SysState}, {"Parent", Parent}, {"Logged events", Log}]} | Specific]. -ifdef(USE_OLD_SYS_GET_DEBUG). sys_get_debug(Item, Debug, Default) -> sys:get_debug(Item, Debug, Default). -else. sys_get_debug(log, Debug, _Default) -> sys:get_log(Debug). -endif. %%----------------------------------------------------------------- %% Resources limit management %%----------------------------------------------------------------- %% Extract know limit options limit_options(Options) -> limit_options(Options, #limits{}). limit_options([], Limits) -> Limits; %% Maximum number of messages allowed in the process message queue limit_options([{max_queue,N}|Options], Limits) when is_integer(N) -> NewLimits = Limits#limits{max_queue=N}, limit_options(Options, NewLimits); limit_options([_|Options], Limits) -> limit_options(Options, Limits). %% Throw max_queue if we have reach the max queue size %% Returns ok otherwise message_queue_len(#limits{max_queue = undefined}, _QueueLen) -> ok; message_queue_len(#limits{max_queue = MaxQueue}, QueueLen) -> Pid = self(), case process_info(Pid, message_queue_len) of {message_queue_len, N} when N + QueueLen > MaxQueue -> throw({process_limit, {max_queue, N + QueueLen}}); _ -> ok end. 07070100000021000081A4000000000000000000000001626FB0410000092F000000000000000000000000000000000000002200000000p1_utils-1.0.25/src/p1_shaper.erl%%%------------------------------------------------------------------- %%% @author Evgeny Khramtsov <ekhramtsov@process-one.net> %%% %%% %%% Copyright (C) 2002-2022 ProcessOne, SARL. All Rights Reserved. %%% %%% Licensed under the Apache License, Version 2.0 (the "License"); %%% you may not use this file except in compliance with the License. %%% You may obtain a copy of the License at %%% %%% http://www.apache.org/licenses/LICENSE-2.0 %%% %%% Unless required by applicable law or agreed to in writing, software %%% distributed under the License is distributed on an "AS IS" BASIS, %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %%% See the License for the specific language governing permissions and %%% limitations under the License. %%% %%%------------------------------------------------------------------- -module(p1_shaper). %% API -export([new/1, new/2, update/2, pp/1]). -record(state, {maxrate = 0 :: integer(), burst_size = 0 :: integer(), acquired_credit = 0 :: integer(), lasttime = 0 :: integer()}). -opaque state() :: #state{}. -export_type([state/0]). %%%=================================================================== %%% API %%%=================================================================== -spec new(integer()) -> state(). new(MaxRate) -> new(MaxRate, MaxRate). -spec new(integer(), integer()) -> state(). new(MaxRate, BurstSize) -> #state{maxrate = MaxRate, burst_size = BurstSize, acquired_credit = BurstSize, lasttime = p1_time_compat:system_time(micro_seconds)}. -spec update(state(), non_neg_integer()) -> {state(), non_neg_integer()}. update(#state{maxrate = MR, burst_size = BS, acquired_credit = AC, lasttime = L} = State, Size) -> Now = p1_time_compat:system_time(micro_seconds), AC2 = min(BS, AC + (MR*(Now - L) div 1000000) - Size), Pause = if AC2 >= 0 -> 0; true -> -1000*AC2 div MR end, {State#state{acquired_credit = AC2, lasttime = Now}, Pause}. -spec pp(any()) -> iolist(). pp(Term) -> io_lib_pretty:print(Term, fun pp/2). %%%=================================================================== %%% Internal functions %%%=================================================================== -spec pp(atom(), non_neg_integer()) -> [atom()] | no. pp(state, 4) -> record_info(fields, state); pp(_, _) -> no. 07070100000022000081A4000000000000000000000001626FB04100001AC1000000000000000000000000000000000000002700000000p1_utils-1.0.25/src/p1_time_compat.erl%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 2014-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% %% %CopyrightEnd% %% %% %% If your code need to be able to execute on ERTS versions both %% earlier and later than 7.0, the best approach is to use the new %% time API introduced in ERTS 7.0 and implement a fallback %% solution using the old primitives to be used on old ERTS %% versions. This way your code can automatically take advantage %% of the improvements in the API when available. This is an %% example of how to implement such an API, but it can be used %% as is if you want to. Just add (a preferably renamed version of) %% this module to your project, and call the API via this module %% instead of calling the BIFs directly. %% -module(p1_time_compat). %% We don't want warnings about the use of erlang:now/0 in %% this module. -compile(nowarn_deprecated_function). %% %% We don't use %% -compile({nowarn_deprecated_function, [{erlang, now, 0}]}). %% since this will produce warnings when compiled on systems %% where it has not yet been deprecated. %% -export([monotonic_time/0, monotonic_time/1, system_time/0, system_time/1, os_system_time/0, os_system_time/1, time_offset/0, time_offset/1, convert_time_unit/3, timestamp/0, unique_timestamp/0, unique_integer/0, unique_integer/1, monitor/2, system_info/1, system_flag/2]). -ifdef(NEED_TIME_FALLBACKS). monotonic_time() -> erlang_system_time_fallback(). monotonic_time(Unit) -> STime = erlang_system_time_fallback(), convert_time_unit_fallback(STime, native, Unit). system_time() -> erlang_system_time_fallback(). system_time(Unit) -> STime = erlang_system_time_fallback(), convert_time_unit_fallback(STime, native, Unit). os_system_time() -> os_system_time_fallback(). os_system_time(Unit) -> STime = os_system_time_fallback(), try convert_time_unit_fallback(STime, native, Unit) catch error:bad_time_unit -> erlang:error(badarg, [Unit]) end. time_offset() -> %% Erlang system time and Erlang monotonic %% time are always aligned 0. time_offset(Unit) -> _ = integer_time_unit(Unit), %% Erlang system time and Erlang monotonic %% time are always aligned 0. convert_time_unit(Time, FromUnit, ToUnit) -> try convert_time_unit_fallback(Time, FromUnit, ToUnit) catch _:_ -> erlang:error(badarg, [Time, FromUnit, ToUnit]) end. timestamp() -> erlang:now(). unique_timestamp() -> erlang:now(). unique_integer() -> {MS, S, US} = erlang:now(), (MS*1000000+S)*1000000+US. unique_integer(Modifiers) -> case is_valid_modifier_list(Modifiers) of true -> %% now() converted to an integer %% fulfill the requirements of %% all modifiers: unique, positive, %% and monotonic... {MS, S, US} = erlang:now(), (MS*1000000+S)*1000000+US; false -> erlang:error(badarg, [Modifiers]) end. monitor(Type, Item) -> try erlang:monitor(Type, Item) catch error:Error -> case {Error, Type, Item} of {badarg, time_offset, clock_service} -> %% Time offset is final and will never change. %% Return a dummy reference, there will never %% be any need for 'CHANGE' messages... make_ref(); _ -> erlang:error(Error, [Type, Item]) end end. system_info(Item) -> try erlang:system_info(Item) catch error:badarg -> case Item of time_correction -> case erlang:system_info(tolerant_timeofday) of enabled -> true; disabled -> false end; time_warp_mode -> no_time_warp; time_offset -> final; NotSupArg when NotSupArg == os_monotonic_time_source; NotSupArg == os_system_time_source; NotSupArg == start_time; NotSupArg == end_time -> %% Cannot emulate this... erlang:error(notsup, [NotSupArg]); _ -> erlang:error(badarg, [Item]) end; error:Error -> erlang:error(Error, [Item]) end. system_flag(Flag, Value) -> try erlang:system_flag(Flag, Value) catch error:Error -> case {Error, Flag, Value} of {badarg, time_offset, finalize} -> %% Time offset is final final; _ -> erlang:error(Error, [Flag, Value]) end end. %% %% Internal functions %% integer_time_unit(native) -> 1000*1000; integer_time_unit(nano_seconds) -> 1000*1000*1000; integer_time_unit(micro_seconds) -> 1000*1000; integer_time_unit(milli_seconds) -> 1000; integer_time_unit(seconds) -> 1; integer_time_unit(I) when is_integer(I), I > 0 -> I; integer_time_unit(BadRes) -> erlang:error(badarg, [BadRes]). erlang_system_time_fallback() -> {MS, S, US} = erlang:now(), (MS*1000000+S)*1000000+US. os_system_time_fallback() -> {MS, S, US} = os:timestamp(), (MS*1000000+S)*1000000+US. convert_time_unit_fallback(Time, FromUnit, ToUnit) -> FU = integer_time_unit(FromUnit), TU = integer_time_unit(ToUnit), case Time < 0 of true -> TU*Time - (FU - 1); false -> TU*Time end div FU. is_valid_modifier_list([positive|Ms]) -> is_valid_modifier_list(Ms); is_valid_modifier_list([monotonic|Ms]) -> is_valid_modifier_list(Ms); is_valid_modifier_list([]) -> true; is_valid_modifier_list(_) -> false. -else. monotonic_time() -> erlang:monotonic_time(). monotonic_time(Unit) -> erlang:monotonic_time(Unit). system_time() -> erlang:system_time(). system_time(Unit) -> erlang:system_time(Unit). os_system_time() -> os:system_time(). os_system_time(Unit) -> os:system_time(Unit). time_offset() -> erlang:time_offset(). time_offset(Unit) -> erlang:time_offset(Unit). convert_time_unit(Time, FromUnit, ToUnit) -> erlang:convert_time_unit(Time, FromUnit, ToUnit). timestamp() -> erlang:timestamp(). unique_timestamp() -> {MS, S, _} = erlang:timestamp(), {MS, S, erlang:unique_integer([positive, monotonic])}. unique_integer() -> erlang:unique_integer(). unique_integer(Modifiers) -> erlang:unique_integer(Modifiers). monitor(Type, Item) -> erlang:monitor(Type, Item). system_info(Item) -> erlang:system_info(Item). system_flag(Flag, Value) -> erlang:system_flag(Flag, Value). -endif. 07070100000023000081A4000000000000000000000001626FB041000001B4000000000000000000000000000000000000002500000000p1_utils-1.0.25/src/p1_utils.app.src{application, p1_utils, [ {description, "Erlang utility modules from ProcessOne"}, {vsn, "1.0.25"}, {modules, []}, {registered, []}, {applications, [ kernel, stdlib, compiler, crypto ]}, {env, []}, {mod, {p1_utils, []}}, %% hex.pm packaging: {licenses, ["Apache 2.0"]}, {links, [{"Github", "https://github.com/processone/p1_utils"}]} ]}. 07070100000024000081A4000000000000000000000001626FB04100000442000000000000000000000000000000000000002100000000p1_utils-1.0.25/src/p1_utils.erl%%%------------------------------------------------------------------- %%% @author Evgeny Khramtsov <ekhramtsov@process-one.net> %%% @copyright (C) 2017-2022 Evgeny Khramtsov %%% @doc %%% %%% @end %%% Created : 8 Mar 2017 by Evgeny Khramtsov <ekhramtsov@process-one.net> %%%------------------------------------------------------------------- -module(p1_utils). -behaviour(application). %% Application callbacks -export([start/2, stop/1]). -export([start/0, stop/0]). %%%=================================================================== %%% Application callbacks %%%=================================================================== start(_StartType, _StartArgs) -> case p1_utils_sup:start_link() of {ok, Pid} -> {ok, Pid}; Error -> Error end. stop(_State) -> ok. %%%=================================================================== %%% API %%%=================================================================== start() -> case application:ensure_all_started(p1_utils) of {ok, _} -> ok; Err -> Err end. stop() -> application:stop(p1_utils). 07070100000025000081A4000000000000000000000001626FB0410000045A000000000000000000000000000000000000002500000000p1_utils-1.0.25/src/p1_utils_sup.erl%%%------------------------------------------------------------------- %%% @author Evgeny Khramtsov <ekhramtsov@process-one.net> %%% @copyright (C) 2017-2022 Evgeny Khramtsov %%% @doc %%% %%% @end %%% Created : 8 Mar 2017 by Evgeny Khramtsov <ekhramtsov@process-one.net> %%%------------------------------------------------------------------- -module(p1_utils_sup). -behaviour(supervisor). %% API -export([start_link/0]). %% Supervisor callbacks -export([init/1]). -define(SERVER, ?MODULE). %%%=================================================================== %%% API functions %%%=================================================================== start_link() -> supervisor:start_link({local, ?SERVER}, ?MODULE, []). %%%=================================================================== %%% Supervisor callbacks %%%=================================================================== init([]) -> {ok, {{one_for_one, 10, 1}, []}}. %%%=================================================================== %%% Internal functions %%%=================================================================== 07070100000026000081A4000000000000000000000001626FB04100001772000000000000000000000000000000000000001E00000000p1_utils-1.0.25/src/treap.erl%%%---------------------------------------------------------------------- %%% File : treap.erl %%% Author : Alexey Shchepin <alexey@process-one.net> %%% Purpose : Treaps implementation %%% Created : 22 Apr 2008 by Alexey Shchepin <alexey@process-one.net> %%% %%% %%% Copyright (C) 2002-2022 ProcessOne, SARL. All Rights Reserved. %%% %%% Licensed under the Apache License, Version 2.0 (the "License"); %%% you may not use this file except in compliance with the License. %%% You may obtain a copy of the License at %%% %%% http://www.apache.org/licenses/LICENSE-2.0 %%% %%% Unless required by applicable law or agreed to in writing, software %%% distributed under the License is distributed on an "AS IS" BASIS, %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %%% See the License for the specific language governing permissions and %%% limitations under the License. %%% %%%---------------------------------------------------------------------- -module(treap). -export([empty/0, insert/4, delete/2, delete_root/1, get_root/1, lookup/2, is_empty/1, fold/3, from_list/1, to_list/1, delete_higher_priorities/2, priority_from_current_time/0, priority_from_current_time/1]). -type hashkey() :: {non_neg_integer(), any()}. -type treap() :: {hashkey(), any(), any(), treap(), treap()} | nil. -export_type([treap/0]). empty() -> nil. insert(Key, Priority, Value, Tree) -> HashKey = {erlang:phash2(Key), Key}, insert1(Tree, HashKey, Priority, Value). insert1(nil, HashKey, Priority, Value) -> {HashKey, Priority, Value, nil, nil}; insert1({HashKey1, Priority1, Value1, Left, Right} = Tree, HashKey, Priority, Value) -> if HashKey < HashKey1 -> heapify({HashKey1, Priority1, Value1, insert1(Left, HashKey, Priority, Value), Right}); HashKey > HashKey1 -> heapify({HashKey1, Priority1, Value1, Left, insert1(Right, HashKey, Priority, Value)}); Priority == Priority1 -> {HashKey, Priority, Value, Left, Right}; true -> insert1(delete_root(Tree), HashKey, Priority, Value) end. heapify({_HashKey, _Priority, _Value, nil, nil} = Tree) -> Tree; heapify({HashKey, Priority, Value, nil = Left, {HashKeyR, PriorityR, ValueR, LeftR, RightR}} = Tree) -> if PriorityR > Priority -> {HashKeyR, PriorityR, ValueR, {HashKey, Priority, Value, Left, LeftR}, RightR}; true -> Tree end; heapify({HashKey, Priority, Value, {HashKeyL, PriorityL, ValueL, LeftL, RightL}, nil = Right} = Tree) -> if PriorityL > Priority -> {HashKeyL, PriorityL, ValueL, LeftL, {HashKey, Priority, Value, RightL, Right}}; true -> Tree end; heapify({HashKey, Priority, Value, {HashKeyL, PriorityL, ValueL, LeftL, RightL} = Left, {HashKeyR, PriorityR, ValueR, LeftR, RightR} = Right} = Tree) -> if PriorityR > Priority -> {HashKeyR, PriorityR, ValueR, {HashKey, Priority, Value, Left, LeftR}, RightR}; PriorityL > Priority -> {HashKeyL, PriorityL, ValueL, LeftL, {HashKey, Priority, Value, RightL, Right}}; true -> Tree end. delete(Key, Tree) -> HashKey = {erlang:phash2(Key), Key}, delete1(HashKey, Tree). delete1(_HashKey, nil) -> nil; delete1(HashKey, {HashKey1, Priority1, Value1, Left, Right} = Tree) -> if HashKey < HashKey1 -> {HashKey1, Priority1, Value1, delete1(HashKey, Left), Right}; HashKey > HashKey1 -> {HashKey1, Priority1, Value1, Left, delete1(HashKey, Right)}; true -> delete_root(Tree) end. delete_root({HashKey, Priority, Value, Left, Right}) -> case {Left, Right} of {nil, nil} -> nil; {_, nil} -> Left; {nil, _} -> Right; {{HashKeyL, PriorityL, ValueL, LeftL, RightL}, {HashKeyR, PriorityR, ValueR, LeftR, RightR}} -> if PriorityL > PriorityR -> {HashKeyL, PriorityL, ValueL, LeftL, delete_root({HashKey, Priority, Value, RightL, Right})}; true -> {HashKeyR, PriorityR, ValueR, delete_root({HashKey, Priority, Value, Left, LeftR}), RightR} end end. delete_higher_priorities(Treap, DeletePriority) -> case treap:is_empty(Treap) of true -> Treap; false -> {_Key, Priority, _Value} = treap:get_root(Treap), if Priority > DeletePriority -> delete_higher_priorities(treap:delete_root(Treap), DeletePriority); true -> Treap end end. priority_from_current_time() -> priority_from_current_time(0). -ifdef(NEED_TIME_FALLBACKS). priority_from_current_time(MsOffset) -> {MS, S, US} = now(), -((MS*1000000+S)*1000000+US) + MsOffset. -else. priority_from_current_time(MsOffset) -> case MsOffset of 0 -> {-erlang:monotonic_time(micro_seconds), -erlang:unique_integer([positive])}; _ -> {-erlang:monotonic_time(micro_seconds) + MsOffset, 0} end. -endif. is_empty(nil) -> true; is_empty({_HashKey, _Priority, _Value, _Left, _Right}) -> false. get_root({{_Hash, Key}, Priority, Value, _Left, _Right}) -> {Key, Priority, Value}. lookup(Key, Tree) -> HashKey = {erlang:phash2(Key), Key}, lookup1(Tree, HashKey). lookup1(nil, _HashKey) -> error; lookup1({HashKey1, Priority1, Value1, Left, Right}, HashKey) -> if HashKey < HashKey1 -> lookup1(Left, HashKey); HashKey > HashKey1 -> lookup1(Right, HashKey); true -> {ok, Priority1, Value1} end. fold(_F, Acc, nil) -> Acc; fold(F, Acc, {{_Hash, Key}, Priority, Value, Left, Right}) -> Acc1 = F({Key, Priority, Value}, Acc), Acc2 = fold(F, Acc1, Left), fold(F, Acc2, Right). to_list(Tree) -> to_list(Tree, []). to_list(nil, Acc) -> Acc; to_list(Tree, Acc) -> Root = get_root(Tree), to_list(delete_root(Tree), [Root | Acc]). from_list(List) -> from_list(List, nil). from_list([{Key, Priority, Value} | Tail], Tree) -> from_list(Tail, insert(Key, Priority, Value, Tree)); from_list([], Tree) -> Tree. 07070100000027000041ED000000000000000000000002626FB04100000000000000000000000000000000000000000000001500000000p1_utils-1.0.25/test07070100000028000081A4000000000000000000000001626FB04100003DE1000000000000000000000000000000000000002700000000p1_utils-1.0.25/test/p1_queue_test.erl%%%------------------------------------------------------------------- %%% @author Evgeny Khramtsov <ekhramtsov@process-one.net> %%% @copyright (C) 2017-2022 Evgeny Khramtsov %%% @doc %%% %%% @end %%% Created : 9 Mar 2017 by Evgeny Khramtsov <ekhramtsov@process-one.net> %%%------------------------------------------------------------------- -module(p1_queue_test). -compile(export_all). -include_lib("eunit/include/eunit.hrl"). -include("p1_queue.hrl"). queue_dir() -> {ok, Cwd} = file:get_cwd(), filename:join(Cwd, "p1_queue"). eacces_dir() -> {ok, Cwd} = file:get_cwd(), filename:join(Cwd, "eacces_queue"). mk_list() -> mk_list(1, 10). mk_list(From, To) -> lists:seq(From, To). start_test() -> ?assertEqual(ok, p1_queue:start(queue_dir())). double_start_test() -> ?assertEqual(ok, p1_queue:start(queue_dir())). new_ram_test() -> p1_queue:new(). new_file_test() -> Q = p1_queue:new(file), ?assertEqual(ok, p1_file_queue:close(Q)). double_close_test() -> Q = p1_queue:new(file), ?assertEqual(ok, p1_file_queue:close(Q)), ?assertEqual(ok, p1_file_queue:close(Q)). close_test() -> Q1 = p1_queue:new(file), Q2 = p1_queue:new(file), ?assertEqual(ok, p1_file_queue:close(Q1)), ?assertEqual(ok, p1_file_queue:close(Q2)). type_ram_test() -> Q = p1_queue:new(ram), ?assertEqual(ram, p1_queue:type(Q)). type_file_test() -> Q = p1_queue:new(file), ?assertMatch({file, _}, p1_queue:type(Q)), ?assertEqual(ok, p1_file_queue:close(Q)). is_queue_ram_test() -> Q = p1_queue:new(ram), ?assertEqual(true, p1_queue:is_queue(Q)). is_queue_file_test() -> Q = p1_queue:new(file), ?assertEqual(true, p1_queue:is_queue(Q)), ?assertEqual(ok, p1_file_queue:close(Q)). is_queue_not_queue_test() -> ?assertEqual(false, p1_queue:is_queue(some)). from_list_ram_test() -> L = mk_list(), Q = p1_queue:from_list(L), ?assertEqual(ram, p1_queue:type(Q)). from_list_file_test() -> L = mk_list(), Q = p1_queue:from_list(L, file), ?assertMatch({file, _}, p1_queue:type(Q)), ?assertEqual(ok, p1_file_queue:close(Q)). to_list_ram_test() -> L = mk_list(), Q = p1_queue:from_list(L, ram), ?assertEqual(L, p1_queue:to_list(Q)). to_list_file_test() -> L = mk_list(), Q = p1_queue:from_list(L, file), ?assertEqual(L, p1_queue:to_list(Q)), ?assertEqual(ok, p1_file_queue:close(Q)). len_ram_test() -> L = mk_list(), Q = p1_queue:from_list(L, ram), ?assertEqual(10, p1_queue:len(Q)). len_file_test() -> L = mk_list(), Q = p1_queue:from_list(L, file), ?assertEqual(10, p1_queue:len(Q)), ?assertEqual(ok, p1_file_queue:close(Q)). len_macro_ram_test() -> L = mk_list(), Q = p1_queue:from_list(L, ram), ?assertMatch(X when ?qlen(X) == 10, Q). len_macro_file_test() -> L = mk_list(), Q = p1_queue:from_list(L, file), ?assertMatch(X when ?qlen(X) == 10, Q), ?assertEqual(ok, p1_file_queue:close(Q)). is_empty_ram_test() -> Q = p1_queue:new(ram), ?assertEqual(true, p1_queue:is_empty(Q)). is_empty_file_test() -> Q = p1_queue:new(file), ?assertEqual(true, p1_queue:is_empty(Q)), ?assertEqual(ok, p1_file_queue:close(Q)). clear_ram_test() -> L = mk_list(), Q = p1_queue:from_list(L, ram), Q1 = p1_queue:clear(Q), ?assertEqual(true, p1_queue:is_empty(Q1)). clear_file_test() -> L = mk_list(), Q = p1_queue:from_list(L, file), Q1 = p1_queue:clear(Q), ?assertEqual(true, p1_queue:is_empty(Q1)), ?assertEqual(ok, p1_file_queue:close(Q1)). in_ram_test() -> Q = p1_queue:new(ram), Q1 = p1_queue:in(1, Q), ?assertEqual([1], p1_queue:to_list(Q1)). in_file_test() -> Q = p1_queue:new(file), Q1 = p1_queue:in(1, Q), ?assertEqual([1], p1_queue:to_list(Q1)), ?assertEqual(ok, p1_file_queue:close(Q1)). out_ram_test() -> Q = p1_queue:new(ram), Q1 = p1_queue:in(1, Q), ?assertMatch({{value, 1}, Q}, p1_queue:out(Q1)). out_file_test() -> Q = p1_queue:new(file), Q1 = p1_queue:in(1, Q), ?assertMatch({{value, 1}, Q2} when ?qlen(Q2) == 0, p1_queue:out(Q1)), ?assertEqual(ok, p1_file_queue:close(Q1)). out_empty_ram_test() -> Q = p1_queue:new(ram), ?assertMatch({empty, Q}, p1_queue:out(Q)). out_empty_file_test() -> Q = p1_queue:new(file), ?assertMatch({empty, Q}, p1_queue:out(Q)), ?assertEqual(ok, p1_file_queue:close(Q)). clear_in_test() -> Q = p1_queue:from_list([1], file), Q1 = p1_queue:drop(Q), Q2 = p1_queue:in(2, Q1), ?assertEqual([2], p1_queue:to_list(Q2)), ?assertEqual(ok, p1_file_queue:close(Q2)). get_limit_ram_test() -> Q = p1_queue:from_list(mk_list(), ram, 10), ?assertEqual(10, p1_queue:get_limit(Q)), ?assertError(full, p1_queue:in(11, Q)). get_limit_file_test() -> Q = p1_queue:from_list(mk_list(), file, 10), ?assertEqual(10, p1_queue:get_limit(Q)), ?assertError(full, p1_queue:in(11, Q)), ?assertEqual(ok, p1_file_queue:close(Q)). set_limit_ram_test() -> Q = p1_queue:new(ram), ?assertEqual(unlimited, p1_queue:get_limit(Q)), Q1 = p1_queue:set_limit(Q, 10), ?assertEqual(10, p1_queue:get_limit(Q1)). set_limit_file_test() -> Q = p1_queue:new(file), ?assertEqual(unlimited, p1_queue:get_limit(Q)), Q1 = p1_queue:set_limit(Q, 10), ?assertEqual(10, p1_queue:get_limit(Q1)), ?assertEqual(ok, p1_file_queue:close(Q)). from_list_limit_ram_test() -> ?assertError(full, p1_queue:from_list(mk_list(), ram, 9)). from_list_limit_file_test() -> ?assertError(full, p1_queue:from_list(mk_list(), file, 9)). peek_ram_test() -> Q = p1_queue:from_list([1], ram), ?assertEqual({value, 1}, p1_queue:peek(Q)). peek_file_test() -> Q = p1_queue:from_list([1], file), ?assertEqual({value, 1}, p1_queue:peek(Q)), ?assertEqual(ok, p1_file_queue:close(Q)). peek_empty_ram_test() -> Q = p1_queue:new(ram), ?assertEqual(empty, p1_queue:peek(Q)). peek_empty_file_test() -> Q = p1_queue:new(file), ?assertEqual(empty, p1_queue:peek(Q)), ?assertEqual(ok, p1_file_queue:close(Q)). drop_ram_test() -> Q = p1_queue:new(ram), Q1 = p1_queue:in(1, Q), ?assertEqual(Q, p1_queue:drop(Q1)). drop_file_test() -> Q = p1_queue:new(file), Q1 = p1_queue:in(1, Q), ?assertMatch(Q2 when ?qlen(Q2) == 0, p1_queue:drop(Q1)), ?assertEqual(ok, p1_file_queue:close(Q1)). drop_empty_ram_test() -> Q = p1_queue:new(ram), ?assertError(empty, p1_queue:drop(Q)). drop_empty_file_test() -> Q = p1_queue:new(file), ?assertError(empty, p1_queue:drop(Q)), ?assertEqual(ok, p1_file_queue:close(Q)). foreach_ram_test() -> L = mk_list(), Q = p1_queue:from_list(L, ram), put(p1_queue, []), F = fun(X) -> put(p1_queue, get(p1_queue) ++ [X]) end, ?assertEqual(ok, p1_queue:foreach(F, Q)), ?assertEqual(L, get(p1_queue)). foreach_file_test() -> L = mk_list(), Q = p1_queue:from_list(L, file), put(p1_queue, []), F = fun(X) -> put(p1_queue, get(p1_queue) ++ [X]) end, ?assertEqual(ok, p1_queue:foreach(F, Q)), ?assertEqual(L, get(p1_queue)), ?assertEqual(ok, p1_file_queue:close(Q)). foldl_ram_test() -> L = mk_list(), Q = p1_queue:from_list(L, ram), F = fun(X, Acc) -> Acc ++ [X] end, ?assertEqual(L, p1_queue:foldl(F, [], Q)). foldl_file_test() -> L = mk_list(), Q = p1_queue:from_list(L, file), F = fun(X, Acc) -> Acc ++ [X] end, ?assertEqual(L, p1_queue:foldl(F, [], Q)), ?assertEqual(ok, p1_file_queue:close(Q)). dropwhile_ram_test() -> L = mk_list(), Q = p1_queue:from_list(L, ram), F = fun(X) -> X < 6 end, Q1 = p1_queue:dropwhile(F, Q), ?assertEqual([6,7,8,9,10], p1_queue:to_list(Q1)). dropwhile_file_test() -> L = mk_list(), Q = p1_queue:from_list(L, file), F = fun(X) -> X < 6 end, Q1 = p1_queue:dropwhile(F, Q), ?assertEqual([6,7,8,9,10], p1_queue:to_list(Q1)), ?assertEqual(ok, p1_file_queue:close(Q1)). drop_until_empty_ram_test() -> L = mk_list(), Q = p1_queue:from_list(L, ram), Q1 = p1_queue:dropwhile(fun(_) -> true end, Q), ?assertEqual(true, p1_queue:is_empty(Q1)). drop_until_empty_file_test() -> L = mk_list(), Q = p1_queue:from_list(L, file), Q1 = p1_queue:dropwhile(fun(_) -> true end, Q), ?assertEqual(true, p1_queue:is_empty(Q1)), ?assertEqual(ok, p1_file_queue:close(Q)). ram_to_file_test() -> L = mk_list(), RQ = p1_queue:from_list(L, ram), FQ = p1_queue:ram_to_file(RQ), ?assertEqual(L, p1_file_queue:to_list(FQ)), ?assertEqual(FQ, p1_queue:ram_to_file(FQ)), ?assertEqual(ok, p1_file_queue:close(FQ)). file_to_ram_test() -> L = mk_list(), FQ = p1_queue:from_list(L, file), RQ = p1_queue:file_to_ram(FQ), ?assertEqual(L, p1_queue:to_list(RQ)), ?assertEqual(RQ, p1_queue:file_to_ram(RQ)), ?assertEqual(ok, p1_file_queue:close(FQ)). not_owner_test() -> Pid = self(), Owner = spawn_link( fun() -> Q = p1_queue:from_list(mk_list(), file), Pid ! {Q, p1_file_queue:path(Q)}, receive stop -> Pid ! stopped end end), {Q, Path} = receive M -> M end, ?assertError({bad_queue, {not_owner, Path}}, p1_queue:in(11, Q)), ?assertError({bad_queue, {not_owner, Path}}, p1_queue:out(Q)), ?assertError({bad_queue, {not_owner, Path}}, p1_queue:peek(Q)), ?assertError({bad_queue, {not_owner, Path}}, p1_queue:drop(Q)), ?assertError({bad_queue, {not_owner, Path}}, p1_queue:to_list(Q)), ?assertError({bad_queue, {not_owner, Path}}, p1_queue:clear(Q)), ?assertError({bad_queue, {not_owner, Path}}, p1_queue:foreach(fun(_) -> ok end, Q)), ?assertError({bad_queue, {not_owner, Path}}, p1_queue:dropwhile(fun(_) -> true end, Q)), ?assertError({bad_queue, {not_owner, Path}}, p1_queue:foldl(fun(_, X) -> X end, ok, Q)), Owner ! stop, receive stopped -> ok end. format_error_test() -> Path = "/path/to/queue", PathBin = list_to_binary(Path), ?assertEqual("foo1234 (" ++ Path ++ ")", p1_queue:format_error({foo1234, PathBin})), ?assertNotEqual("not_owner (" ++ Path ++ ")", p1_queue:format_error({not_owner, PathBin})), ?assertNotEqual("corrupted (" ++ Path ++ ")", p1_queue:format_error({corrupted, PathBin})). bad_size_test() -> #file_q{fd = Fd, path = Path} = Q = p1_queue:from_list([1], file), ?assertMatch({ok, _}, file:position(Fd, 0)), ?assertEqual(ok, file:truncate(Fd)), ?assertEqual(ok, file:pwrite(Fd, 0, <<1>>)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:out(Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:peek(Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:drop(Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:to_list(Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:dropwhile(fun(_) -> true end, Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:foreach(fun(_) -> ok end, Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:foldl(fun(_, _) -> ok end, ok, Q)), ?assertEqual(ok, p1_file_queue:close(Q)). eof_test() -> #file_q{fd = Fd, path = Path} = Q = p1_queue:from_list([1], file), ?assertMatch({ok, _}, file:position(Fd, 0)), ?assertEqual(ok, file:truncate(Fd)), ?assertEqual(ok, file:pwrite(Fd, 0, <<1:32>>)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:out(Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:peek(Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:to_list(Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:dropwhile(fun(_) -> true end, Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:foreach(fun(_) -> ok end, Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:foldl(fun(_, _) -> ok end, ok, Q)), ?assertEqual(ok, p1_file_queue:close(Q)). bad_term_test() -> #file_q{fd = Fd, path = Path} = Q = p1_queue:from_list([1], file), ?assertMatch({ok, _}, file:position(Fd, 0)), ?assertEqual(ok, file:truncate(Fd)), ?assertEqual(ok, file:pwrite(Fd, 0, <<5:32, 1>>)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:out(Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:peek(Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:to_list(Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:dropwhile(fun(_) -> true end, Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:foreach(fun(_) -> ok end, Q)), ?assertError({bad_queue, {corrupted, Path}}, p1_queue:foldl(fun(_, _) -> ok end, ok, Q)), ?assertEqual(ok, p1_file_queue:close(Q)). closed_test() -> #file_q{path = Path} = Q = p1_queue:from_list([1], file), ?assertEqual(ok, p1_file_queue:close(Q)), ?assertError({bad_queue, {einval, Path}}, p1_queue:in(2, Q)), ?assertError({bad_queue, {einval, Path}}, p1_queue:out(Q)), ?assertError({bad_queue, {einval, Path}}, p1_queue:peek(Q)), ?assertError({bad_queue, {einval, Path}}, p1_queue:drop(Q)), ?assertError({bad_queue, {einval, Path}}, p1_queue:to_list(Q)), ?assertError({bad_queue, {einval, Path}}, p1_queue:dropwhile(fun(_) -> true end, Q)), ?assertError({bad_queue, {einval, Path}}, p1_queue:foreach(fun(_) -> ok end, Q)), ?assertError({bad_queue, {einval, Path}}, p1_queue:foldl(fun(_, _) -> ok end, ok, Q)), ?assertError({bad_queue, {einval, Path}}, p1_file_queue:clear(Q)), ?assertEqual(ok, p1_file_queue:close(Q)). write_fail_test() -> #file_q{fd = Fd, path = Path} = Q = p1_queue:new(file), ?assertEqual(ok, file:close(Fd)), %% Open file in read-only mode, so write operations fail {ok, NewFd} = file:open(Path, [read, binary, raw]), Q1 = Q#file_q{fd = NewFd}, ?assertError({bad_queue, {ebadf, Path}}, p1_queue:in(1, Q1)), ?assertError({bad_queue, {einval, Path}}, p1_file_queue:clear(Q1)), ?assertEqual(ok, p1_file_queue:close(Q1)). gc_test() -> Q = p1_queue:from_list(lists:seq(1, 1001), file), Q1 = p1_queue:dropwhile(fun(X) -> X =< 1000 end, Q), ?assertMatch(#file_q{head = 1000, tail = 1}, Q1), %% GC should be called here Q2 = p1_queue:in(1002, Q1), ?assertMatch(#file_q{head = 0, tail = 2}, Q2), ?assertEqual(ok, p1_file_queue:close(Q2)). destruction_test() -> %% Check if drop/1 and out/1 don't destruct original queue Q = p1_queue:from_list([1], file), p1_queue:drop(Q), ?assertMatch({_, _}, p1_queue:out(Q)), ?assertEqual(true, p1_queue:is_queue(Q)), ?assertEqual(1, p1_queue:len(Q)), ?assertEqual(false, p1_queue:is_empty(Q)), ?assertEqual({value, 1}, p1_queue:peek(Q)), ?assertEqual([1], p1_queue:to_list(Q)), ?assertEqual(Q, p1_queue:dropwhile(fun(_) -> false end, Q)), ?assertEqual([1], p1_queue:foldl(fun(X, Acc) -> [X|Acc] end, [], Q)), ?assertEqual(ok, p1_queue:foreach(fun(_) -> ok end, Q)), ?assertEqual(ok, p1_file_queue:close(Q)). emfile_test() -> _ = [p1_queue:new(file) || _ <- lists:seq(1, 10)], ?assertError(emfile, p1_queue:new(file)). stop_test() -> ?assertMatch({ok, [_|_]}, file:list_dir(queue_dir())), ?assertEqual(ok, p1_queue:stop()), ?assertEqual({ok, []}, file:list_dir(queue_dir())). start_fail_test() -> Dir = eacces_dir(), QDir = filename:join(Dir, "p1_queue"), ?assertEqual(ok, filelib:ensure_dir(QDir)), ?assertEqual(ok, file:change_mode(Dir, 8#00000)), ?assertMatch({error, _}, p1_queue:start(QDir)). start_eacces_test() -> ?assertMatch(ok, p1_queue:start(eacces_dir())). new_eacces_test() -> ?assertError({bad_queue, {eacces, _}}, p1_queue:new(file)). from_list_eacces_test() -> L = mk_list(), ?assertError({bad_queue, {eacces, _}}, p1_queue:from_list(L, file)). stop_eaccess_test() -> ?assertEqual(ok, p1_queue:stop()). 07070100000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000B00000000TRAILER!!!382 blocks
Locations
Projects
Search
Status Monitor
Help
OpenBuildService.org
Documentation
API Documentation
Code of Conduct
Contact
Support
@OBShq
Terms
openSUSE Build Service is sponsored by
The Open Build Service is an
openSUSE project
.
Sign Up
Log In
Places
Places
All Projects
Status Monitor
