├── .github └── workflows │ └── erlang.yml ├── .gitignore ├── .travis.yml ├── LICENSE ├── Makefile ├── README.md ├── bin ├── escriptize.es └── release.es ├── build-aux └── docs-addon.mk ├── include ├── iif.hrl ├── inet.hrl ├── sntp.hrl └── stringx.hrl ├── priv └── sample-logger.config ├── rebar.config └── src ├── alias.erl ├── base32.erl ├── cipher.erl ├── compile_time.ex ├── csv.erl ├── decompiler.erl ├── env.erl ├── erlang_scan.xrl ├── file_log_reader.erl ├── gin.erl ├── hex.erl ├── io_lib_pretty_limited.erl ├── listx.erl ├── osx.erl ├── pcap.erl ├── pmap.erl ├── prof.erl ├── restrict_remsh_mod.erl ├── smerl.erl ├── smtp.erl ├── sntp.erl ├── ssh_sign.erl ├── ssh_tunnel.erl ├── stringx.erl ├── sup_bridge.erl ├── throttle.erl ├── trunc_io.erl ├── ttl_map.erl ├── user_default.erl ├── util.app.src ├── util_log_color_formatter.erl ├── util_log_formatter.erl ├── xmltree.erl └── xref_test.erl /.github/workflows/erlang.yml: -------------------------------------------------------------------------------- 1 | name: build 2 | 3 | on: 4 | push: 5 | branches: [ master ] 6 | pull_request: 7 | branches: [ master ] 8 | 9 | jobs: 10 | 11 | build: 12 | 13 | runs-on: ubuntu-latest 14 | 15 | container: 16 | image: erlang:25.2 17 | 18 | steps: 19 | - uses: actions/checkout@v2 20 | with: 21 | # Checkout all history for all branches and tags 22 | fetch-depth: 0 23 | # - uses: actions/setup-elixir@v1 24 | # with: 25 | # otp-version: '24.0' 26 | # elixir-version: '1.13.2' 27 | - name: Current Directory 28 | run: pwd 29 | - name: Compile 30 | run: make 31 | - name: Run tests 32 | run: make eunit 33 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | .eunit 3 | .rebar* 4 | rebar.lock 5 | deps 6 | doc/ 7 | ebin 8 | src/erlang_scan.erl 9 | build-aux/overview.edoc 10 | *.o 11 | *.beam 12 | *.plt 13 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: erlang 2 | script: "make eunit" 3 | otp_release: 4 | - 23.0 5 | - 24.0 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD LICENSE 2 | =========== 3 | 4 | Copyright (C) 2003 Serge Aleynikov 5 | 6 | All rights reserved. 7 | 8 | Redistribution and use in source and binary forms, with or without 9 | modification, are permitted provided that the following conditions are met: 10 | 11 | 1. Redistributions of source code must retain the above copyright notice, 12 | this list of conditions and the following disclaimer. 13 | 14 | 2. Redistributions in binary form must reproduce the above copyright 15 | notice, this list of conditions and the following disclaimer in 16 | the documentation and/or other materials provided with the distribution. 17 | 18 | 3. The names of the authors may not be used to endorse or promote products 19 | derived from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED WARRANTIES, 22 | INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 23 | FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL JCRAFT, 24 | INC. OR ANY CONTRIBUTORS TO THIS SOFTWARE BE LIABLE FOR ANY DIRECT, INDIRECT, 25 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, 27 | OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 28 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 29 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, 30 | EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # See LICENSE for licensing information. 2 | 3 | ifeq ($(shell uname -o), Cygwin) 4 | EXT=".cmd" 5 | else 6 | EXT= 7 | endif 8 | 9 | .PHONY: all all-fast clean clean-docs github-docs tar 10 | 11 | PROJECT := $(notdir $(PWD)) 12 | TARBALL := $(PROJECT) 13 | 14 | REBAR := $(shell whereis rebar3 2>/dev/null | awk '{print $$2}') 15 | REBAR := $(if $(REBAR),$(REBAR),rebar)$(EXT) 16 | 17 | empty := 18 | space := $(empty) $(empty) 19 | delim := $(empty),\n $(empty) 20 | 21 | all: compile 22 | 23 | compile: 24 | @$(REBAR) compile 25 | @if ! which elixirc &>/dev/null; then \ 26 | true; \ 27 | else \ 28 | for f in src/*.ex; do elixirc -o _build/default/lib/util/ebin --ignore-module-conflict $$f; done; \ 29 | fi 30 | 31 | test eunit: 32 | @$(REBAR) eunit 33 | 34 | -include build-aux/docs-addon.mk 35 | 36 | clean: 37 | @$(REBAR) clean 38 | @rm -fr ebin doc 39 | 40 | doc: 41 | $(REBAR) ex_doc 42 | 43 | publish cut: 44 | $(REBAR) hex $@ -r hexpm $(if $(replace),--replace) $(if $(noconfirm),--yes) 45 | 46 | tar: 47 | @rm -f $(TARBALL).tgz; \ 48 | tar zcf $(TARBALL).tgz --transform 's|^|$(TARBALL)/|' --exclude="core*" --exclude="erl_crash.dump" \ 49 | --exclude="*.tgz" --exclude="*.swp" --exclude="c_src" \ 50 | --exclude="Makefile" --exclude="rebar.*" --exclude="*.mk" \ 51 | --exclude="*.o" --exclude=".git*" * && \ 52 | echo "Created $(TARBALL).tgz" 53 | 54 | build-aux/docs-addon.mk: 55 | git co master build-aux/docs-addon.mk 56 | 57 | .PHONY: test 58 | .SUFFIX: 59 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Erlang Utility Modules 2 | 3 | [![build](https://github.com/saleyn/util/actions/workflows/erlang.yml/badge.svg)](https://github.com/saleyn/util/actions/workflows/erlang.yml) 4 | 5 | **Author** Serge Aleynikov 6 | 7 | ## Installation 8 | 9 | - Add dependency in `rebar.config`: 10 | ```erlang 11 | {deps, 12 | [% ... 13 | {util, "~> 1.0"} 14 | ]}. 15 | ``` 16 | 17 | ## Content 18 | 19 | | Module | Description | 20 | | ------------------------- | ------------------------------------------------------------------------------------ | 21 | | decompiler | decompiles modules and functions (useful for verifying accuracy of code generation) | 22 | | csv | CSV parsing and loading data to MySQL | 23 | | env | environment variables substitution, path normalization | 24 | | file_log_reader | Periodically read an append-only log file and parse newly added data | 25 | | iif | Ternery if function including `iif/3`, `iif/4`, `ife/3`, `ife/4` parse transforms | 26 | | io_lib_pretty_limited | Print term to binary by constraining the output size | 27 | | gin | Convenient parse transform for `in(Value, [A,B,C])` type of guards | 28 | | hex | Hex to bin conversion | 29 | | listx | Miscelaneous list handling functions | 30 | | osx | Execution of os commands with returned stdout and exit status | 31 | | pcap | reader/writer of packet capture files (tcpdump, wireshark) | 32 | | restrict_remsh_mod | to be used for remote shells to restrict `q()`, `init:stop()`, `erlang:halt()`, etc. | 33 | | smtp | SMTP client supporting tcp and ssl protocols | 34 | | sntp | simple SNTP client | 35 | | str | stringification functions including `str/1` and `str/2` parse transforms | 36 | | stringx | miscelaneous string functions | 37 | | throttle | implements a rate limitting algorithm | 38 | | user_default | extending shell with useful debugging and profiling commands | 39 | | build-aux/md-to-edoc.awk | AWK script for converting `README.md` files to `overview.edoc` | 40 | 41 | Additionally, the following Elixir modules are included: 42 | 43 | | Module | File | Description | 44 | |--------------|------------------| -------------------------------------------------------------------------------| 45 | | CompileTime | compile_time.ex | Evaluate lambdas at compile time | 46 | 47 | ## Documentation 48 | 49 | * See [project documentation](https://saleyn.github.io/util) 50 | 51 | This project implements an extension of `EDoc` documentation by using the color scheme similar 52 | to `GitHub`, and generate the `overview.edoc` from the `README.md`. 53 | 54 | In order to use this feature, modify your `Makefile` to include: 55 | 56 | ``` 57 | -include build-aux/docs-addon.mk 58 | 59 | build-aux/docs-addon.mk: 60 | @echo "Fetching build-aux/docs-addon.mk" && \ 61 | mkdir -p build-aux && \ 62 | curl -s -o build-aux/docs-addon.mk https://raw.githubusercontent.com/saleyn/util/master/build-aux/docs-addon.mk 63 | ``` 64 | Also in your `rebar.config` add: 65 | ``` 66 | {edoc_opts, [{overview, "build-aux/overview.edoc"}, 67 | {stylesheet_file, "build-aux/edoc.css"}, 68 | {title, "Project title used by rebar and also inserted as title to the index.html"}, 69 | {keywords, "HTML meta keywords (comma-delimited) for search engine crawlers"}, 70 | ...]}. 71 | ``` 72 | NOTE: the `keywords` option is not specific to `EDoc` but used by the HTML reformatting make 73 | file `docs-addon.mk`. 74 | 75 | This will add the following targets to your `Makefile`: 76 | 77 | - `docs` - Make documentation from source code 78 | - `gh-pages` - Create GitHub pages for the current project 79 | - `get-version` - Show application release version from the `*.app.src` and `rebar.config` 80 | - `set-version` - Set the version number for the above `(make set-version version=X.Y.Z)` 81 | - `clean-docs` - Remove the generated files in the `doc` directory 82 | 83 | ## Elixir 84 | 85 | To add functions from `user_default.erl` to Elixir's `iex` shell, add `~/.iex.exs` file 86 | containing: 87 | ``` 88 | import :user_default 89 | ``` 90 | 91 | ## Download 92 | 93 | * [GitHub](http://saleyn.github.io/util) 94 | -------------------------------------------------------------------------------- /bin/escriptize.es: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env escript 2 | %%! -env ERL_CRASH_DUMP /dev/null +sbtu +A0 -mode minimal 3 | 4 | %%------------------------------------------------------------------- 5 | %% This script compiles an escript into a binary executable 6 | %%------------------------------------------------------------------- 7 | 8 | -record(args, { 9 | input, 10 | output 11 | }). 12 | 13 | main(Args) -> 14 | try 15 | #args{input=In, output=Out} = parse(Args, #args{}), 16 | In == undefined 17 | andalso throw("Missing input file name!"), 18 | Output = case Out of 19 | undefined -> output_name(In); 20 | _ -> Out 21 | end, 22 | case escript:extract(In, [compile_source]) of 23 | {ok, S} -> 24 | is_binary(proplists:get_value(beam, S)) 25 | andalso throw("Script " ++ In ++ " is already compiled!"), 26 | case escript:create(Output, S) of 27 | ok -> 28 | ok = file:change_mode(Output, 8#0755), 29 | io:format("~s executable file created\n", [Output]); 30 | {error, {Reason, _}} -> 31 | throw(io_lib:format( 32 | "Cannot create file '~s': ~s", [Output, file:format_error(Reason)])); 33 | {error, Reason} -> 34 | throw(io_lib:format( 35 | "Cannot create file '~s': ~p", [Output, Reason])) 36 | end; 37 | {error, Reason} when is_list(Reason) -> 38 | throw(io_lib:format( 39 | "Cannot create file '~s': ~s", [Output, Reason])); 40 | {error, Reason} -> 41 | throw(io_lib:format( 42 | "Cannot create file '~s': ~p", [Output, Reason])) 43 | end 44 | catch _:Why -> 45 | io:format(standard_error, "~s\n", [Why]), 46 | halt(1) 47 | end. 48 | 49 | parse([], Args) -> Args; 50 | parse(["-f", File|T], Args) -> parse(T, Args#args{input=File}); 51 | parse(["-o", File|T], Args) -> parse(T, Args#args{output=File}); 52 | parse([[C|_] = File|T], Args) when C /= $- -> parse(T, Args#args{input=File}); 53 | parse([H|_], _) when H=="-h"; H=="--help" -> 54 | io:format(standard_error, 55 | "Compile source escript to a binary executable\n" 56 | "Author: Serge Aleynikov \n\n" 57 | "Usage: ~s [-h|--help] [-o OutputName] [-f] ScriptName\n", [escript:script_name()]), 58 | halt(1); 59 | parse([H|_], _) -> 60 | throw("Invalid argument: " ++ H). 61 | 62 | output_name(File) -> 63 | re:replace(File,"\.(es|escript)$",".bin",[{return,list}]). 64 | -------------------------------------------------------------------------------- /bin/release.es: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env escript 2 | %%! -smp disable -env ERL_CRASH_DUMP /dev/null +sbtu +A0 -mode minimal -boot start_clean -pa ebin -pa deps/lager/ebin -pa deps/util/ebin -pa deps/goldrush/ebin 3 | 4 | %%------------------------------------------------------------------- 5 | %% This script creates a release file given a release template file. 6 | %% The template should be in the standard *.rel file format. All 7 | %% versions of applications will be replaced by current versions 8 | %% of the applications found in the installed Erlang distribution. 9 | %% 10 | %% Assuming that you need to build a boot file containing 11 | %% applications found in "./ebin" and "deps/*/ebin" directories, you 12 | %% can include the following make targets for building the boot file: 13 | %% 14 | %% ``` 15 | %% EBIN_DEPS=ebin $(wildcard deps/*/ebin) 16 | %% LIB_ARGS=$(EBIN_DEPS:%=-pa %) 17 | %% 18 | %% priv/release.es: 19 | %% curl -s https://raw.github.com/saleyn/util/master/bin/release.es | \ 20 | %% awk '/^%%!/ { print "%%! $(LIB_ARGS)" } !/^%%!/ {print}' > $@ 21 | %% 22 | %% priv/myapp.rel: src/myapp.template.rel priv/release.es 23 | %% escript priv/release.es $< $@ 24 | %% 25 | %% priv/myapp.boot: priv/myapp.rel 26 | %% erlc $(LIB_ARGS) -o $(@D) $< 27 | %% ``` 28 | %%------------------------------------------------------------------- 29 | -mode(compile). 30 | 31 | -include_lib("sasl/src/systools.hrl"). 32 | 33 | main([TemplateRelFile, OutRelFile]) -> 34 | create_release_file(TemplateRelFile, OutRelFile, undefined); 35 | main(_) -> 36 | io:format("Usage: ~s TemplateRelFile OutRelFile\n\n" 37 | " Example:\n" 38 | " ~s myapp.rel.src ./ebin/myapp.rel\n", 39 | [escript:script_name(), escript:script_name()]), 40 | halt(1). 41 | 42 | %%------------------------------------------------------------------- 43 | %% @spec create_release_file(TemplateRelFile, OutRelFile, Vsn) -> ok 44 | %% TemplateRelFile = filename() 45 | %% OutRelFile = filename() 46 | %% Vsn = string() 47 | %% @doc Create a release file given a release template file. The 48 | %% release template file should have the same structure as the 49 | %% release file. This function will ensure that latest 50 | %% application versions are included in the release. It will 51 | %% also ensure that the latest erts version is specified in 52 | %% the release file. Note that both arguments may contain the 53 | %% ".rel" extension, however the actual TemplateRelFile must 54 | %% have a ".rel" extension. The TemplateRelFile doesn't need 55 | %% to contain application version numbers - an empty string will 56 | %% do: {kernel, ""}. This function will populate 57 | %% the version number with current version of the application. 58 | %% ``Vsn'' is the version number associated with the generated 59 | %% release file. If it is ``undefined'', the version from the 60 | %% ``TemplateRelFile'' will be used. 61 | %% ``` 62 | %% Example: 63 | %% create_release_file("myapp.rel.src", "./ebin/myapp.rel"). 64 | %% ''' 65 | %% @end 66 | %%------------------------------------------------------------------- 67 | create_release_file(TemplateRelFile, OutRelFile, Vsn) -> 68 | Template = strip_ext(TemplateRelFile), 69 | try 70 | create_file_link(Template, TemplateRelFile), 71 | Rel = get_release(Template), 72 | write_file(Template, OutRelFile, Rel, Vsn) 73 | catch _:Error -> 74 | io:format("Error: ~p\n ~p\n", [Error, erlang:get_stacktrace()]), 75 | init:stop(1) 76 | after 77 | remove_file_link(Template) 78 | end. 79 | 80 | write_file(TemplateRelFile, OutRelFile, Rel, Vsn) -> 81 | OutFileName = filename:join(filename:dirname(OutRelFile), 82 | filename:basename(OutRelFile,".rel")++".rel"), 83 | case file:open(OutFileName, [write]) of 84 | {ok, FD} -> 85 | io:format(FD, "%%%~n" 86 | "%%% This file is automatically generated from ~s~n" 87 | "%%%~n~n", [TemplateRelFile]), 88 | io:format(FD, "{release, {~p, ~p}, {erts, ~p},~n [~n~s ]~n}.~n", 89 | [Rel#release.name, 90 | case Vsn of 91 | undefined -> Rel#release.vsn; 92 | _ -> Vsn 93 | end, 94 | Rel#release.erts_vsn, 95 | format_list(Rel#release.applications)]), 96 | file:close(FD); 97 | {error, Reason} -> 98 | throw({error, file:format_error(Reason)}) 99 | end. 100 | 101 | get_release(Filename) -> 102 | File = filename:basename(Filename, ".rel"), 103 | Dir = [filename:dirname(Filename) | code:get_path()], 104 | {ok, Release, _} = systools_make:read_release(File, Dir), 105 | case systools_make:get_release(File, Dir) of 106 | {ok, Rel, _, _} -> 107 | Rel#release{erts_vsn = erlang:system_info(version)}; 108 | {error,systools_make,List} -> 109 | NewList = 110 | lists:foldl(fun({error_reading,{Mod,{not_found,AppFile}}}, {Ok, Err}) -> 111 | {Ok, [{not_found, {Mod, AppFile}} | Err]}; 112 | ({error_reading,{Mod,{no_valid_version, 113 | {{"should be",_}, {"found file", _, Vsn}}}}}, {Ok, Err}) -> 114 | {[{Mod, Vsn} | Ok], Err} 115 | end, {[],[]}, List), 116 | case NewList of 117 | {ModVsn, []} -> 118 | substitute_versions(Release, ModVsn); 119 | {_, ErrMod} -> 120 | throw({error, ErrMod}) 121 | end 122 | end. 123 | 124 | substitute_versions(Release, []) -> 125 | Release; 126 | substitute_versions(Release, [{Mod, Vsn} | Tail]) -> 127 | Apps = Release#release.applications, 128 | NewApps = 129 | case lists:keysearch(Mod, 1, Apps) of 130 | {value, {Mod, _Vsn, Type}} -> 131 | lists:keyreplace(Mod, 1, Apps, {Mod, Vsn, Type}); 132 | false -> 133 | Apps 134 | end, 135 | substitute_versions(Release#release{applications = NewApps, 136 | erts_vsn = erlang:system_info(version)}, Tail). 137 | 138 | format_list(A) -> 139 | {LN, LV} = 140 | lists:foldl(fun({N,V,_}, {L1, L2}) -> 141 | {erlang:max(L1, length(atom_to_list(N))), 142 | erlang:max(L2, length(V))} 143 | end, {0,0}, A), 144 | format_list(A, [], {LN, LV}). 145 | format_list([], [$\n, $, | Acc], _) -> 146 | lists:reverse([$\n | Acc]); 147 | format_list([{App,Vsn,permanent} | Tail], Acc, {LN, _LA} = Len) -> 148 | Str = lists:flatten(io_lib:format(" {~-*w, ~s},~n", [LN, App, [$"]++Vsn++[$"]])), 149 | format_list(Tail, lists:reverse(Str) ++ Acc, Len); 150 | format_list([{App,Vsn,Type} | Tail], Acc, {LN, LA} = Len) -> 151 | Str = lists:flatten(io_lib:format(" {~-*w, ~-*s, ~p},~n", [LN, App, LA+2, [$"]++Vsn++[$"], Type])), 152 | format_list(Tail, lists:reverse(Str) ++ Acc, Len). 153 | 154 | strip_ext(Filename) -> 155 | case filename:extension(Filename) of 156 | ".rel" -> 157 | Filename; 158 | ".src" -> 159 | filename:join( 160 | filename:dirname(Filename), 161 | filename:basename(Filename, ".src")) 162 | end. 163 | 164 | create_file_link(Filename, Filename) -> 165 | ok; 166 | create_file_link(File, Filename) -> 167 | case file:read_link(File) of 168 | {ok, _} -> ok; 169 | _ -> 170 | Cmd = "ln -s -r " ++ Filename ++ " " ++ File, 171 | case os:cmd(Cmd) of 172 | [] -> ok; 173 | _ -> 174 | %% Most likely can't created links on this filesystem 175 | [] = os:cmd("cp " ++ Filename ++ " " ++ File) 176 | end 177 | end. 178 | 179 | remove_file_link(File) -> 180 | case file:read_link(File) of 181 | {ok, _} -> file:delete(File); 182 | _ -> ok 183 | end. 184 | -------------------------------------------------------------------------------- /build-aux/docs-addon.mk: -------------------------------------------------------------------------------- 1 | GIT_ROOT=$(shell A=$$(git rev-parse --show-toplevel); [ -z $$A ] && echo ".git" || echo "$$A/.git") 2 | MASTER=$(shell [ -f $(GIT_ROOT)/refs/heads/master ] && echo master || echo main) 3 | 4 | info:: 5 | @echo "make docs - Generate documentation" 6 | @echo "make get-version - Get version of $(PROJECT)" 7 | @echo "make set-version version=X.Y.Z - Set version of $(PROJECT)" 8 | @echo "make gh-pages - Generate and push Github pages" 9 | @echo "make clean-docs - Delete generated documentation" 10 | 11 | docs:: 12 | @mkdir -p build-aux 13 | @if [ -f build-aux/docs-addon.mk ]; then \ 14 | true; \ 15 | else \ 16 | echo "Fetching docs-addon.mk from github.com/saleyn/util" && \ 17 | curl -s -o build-aux/docs-addon.mk https://raw.githubusercontent.com/saleyn/util/master/build-aux/docs-addon.mk; \ 18 | fi 19 | $(REBAR) ex_doc 20 | 21 | clean-docs:: 22 | @rm -f doc/*.{css,html,png} doc/edoc-info 23 | 24 | get-version set-version: APPFILE:=$(shell find . -name $(PROJECT).app.src) 25 | get-version set-version: PROJECT:=$(if $(PROJECT),$(PROJECT),$(notdir $(PWD))) 26 | get-version: 27 | @echo "App file: $(APPFILE)" 28 | @printf "%-20s: %s\n" "$(notdir $(APPFILE))" "$$(sed -n 's/.*{vsn, *\"\([0-9]\+\)\(\(\.[0-9]\+\)\+\)\"}.*/\1\2/p' $(APPFILE))" 29 | @printf "%-20s: %s\n" "rebar.config" "$$(sed -n 's/.*{$(PROJECT), *\"\([0-9]\+\)\(\(\.[0-9]\+\)\+\)\"}.*/\1\2/p' rebar.config)" 30 | 31 | set-version: 32 | @[ -z $(version) ] && echo "Missing version=X.Y.Z!" && exit 1 || true 33 | @sed -i "s/{vsn, \"\([0-9]\+\)\(\(\.[0-9]\+\)\+\)\"}/{vsn, \"$(version)\"}/" $(APPFILE) 34 | @sed -i "s/{$(PROJECT), \"[[:digit:]]\+\.[[:digit:]]\+\.[[:digit:]]\+\"}/{$(PROJECT), \"$(version)\"}/" rebar.config 35 | 36 | github-docs gh-pages: GVER=$(shell git ls-tree --name-only -r $(MASTER) build-aux | grep 'google.*\.html') 37 | github-docs gh-pages: LOCAL_GVER=$(notdir $(GVER)) 38 | github-docs gh-pages: 39 | @# The git config params must be set when this target is executed by a GitHub workflow 40 | @[ -z "$(git config user.name)" ] && \ 41 | git config user.name github-actions && \ 42 | git config user.email github-actions@github.com 43 | @if git branch | grep -q gh-pages ; then \ 44 | git checkout gh-pages; \ 45 | else \ 46 | git checkout -b gh-pages; \ 47 | fi 48 | @echo "Git root: $(git rev-parse --show-toplevel)" 49 | @echo "Main branch: $(MASTER)" 50 | rm -f rebar.lock 51 | git checkout $(MASTER) -- src $(shell [ -d include ] && echo include) 52 | git checkout $(MASTER) -- Makefile rebar.* README.md $(GH_PAGES_FILES) 53 | git show $(MASTER):LICENSE >LICENSE 2>/dev/null 54 | @# Create google verification file if one exists in the master 55 | [ -n "$(GVER)" ] && git show $(MASTER):$(GVER) 2>/dev/null > "$(LOCAL_GVER)" || true 56 | make docs 57 | mv doc/*.* . 58 | make clean 59 | find . -maxdepth 1 -type d -not -name ".git" -a -not -name "." -exec rm -fr {} \; 60 | find . -maxdepth 1 -type f -not -name ".git" -a -not -name "*.html" -a -not -name "*.css" -a -not -name "*.js" -a -not -name "*.png" -exec rm -f {} \; 61 | @FILES=`git status -uall --porcelain | sed -n '/^?? [A-Za-z0-9]/{s/?? //p}'`; \ 62 | for f in $$FILES ; do \ 63 | echo "Adding $$f"; git add $$f; \ 64 | done 65 | @sh -c "ret=0; set +e; \ 66 | if git commit -a --amend -m 'Documentation updated'; \ 67 | then git push origin +gh-pages; echo 'Pushed gh-pages to origin'; \ 68 | else ret=1; git reset --hard; \ 69 | fi; \ 70 | set -e; git checkout $(MASTER) && echo 'Switched to $(MASTER)'; exit $$ret" 71 | 72 | -------------------------------------------------------------------------------- /include/iif.hrl: -------------------------------------------------------------------------------- 1 | -define(IIF(Cond,True,False), case Cond of true -> True; _ -> False end). 2 | -------------------------------------------------------------------------------- /include/inet.hrl: -------------------------------------------------------------------------------- 1 | %% On Windows REUSEADDR socket option is implemented. 2 | %% Instead, when opening UDP sockets, use: gen_udp:open(12345, [?REUSEADDR_OPT]) 3 | -define(REUSEADDR_OPT, {raw, 16#ffff, 16#0200, <<1:32/native>>}). 4 | -------------------------------------------------------------------------------- /include/sntp.hrl: -------------------------------------------------------------------------------- 1 | %% 2 | %% SNTP - Simple Network Time Protocol (RFC-2030) 3 | %% 4 | 5 | -record(sntp, { 6 | version, % NTP version (3 or 4) 7 | stratum, % 1 - primary ref, 2-15 secondary ref. 8 | precision, % Precision of local clock in us. 9 | rootdelay, % float() - Total roundtrip delay to the primary reference source in ms. 10 | rootdisp, % float() - Nominal error relative to the primary reference source in ms. 11 | refid, % Server reference string 12 | reftime, % Time at which the local clock was last set (in now() format). 13 | transtime, % Time at which the response left NTP server (in now() format). 14 | delay, % Roundtrip delay in us. 15 | offset % Local clock offset in us. 16 | }). 17 | -------------------------------------------------------------------------------- /include/stringx.hrl: -------------------------------------------------------------------------------- 1 | %%% vim:ts=2:sw=2:et 2 | 3 | % Options for table pretty printing (see stringx:pretty_print_table/3) 4 | -record(opts, { 5 | number_pad = $\s :: char(), % Padding character for numbers 6 | header = true :: boolean(), % Output header row 7 | th_dir = both :: both|leading|trailing, % table header padding dir 8 | td_dir = trailing :: both|leading|trailing, % table row padding dir 9 | td_pad = #{} :: map(), % Map of column padding directions #{Col::integer() => both|leading|trailing} 10 | td_start = 1 :: integer(), % Start printing from this field number 11 | td_exclude = [] :: list(), % Exclude columns (start with 1) or names 12 | td_sep = " | " :: string(), % Column separator 13 | tr_sep = "-" :: string(), 14 | tr_sep_td = "+" :: string(), % Delimiter header/footer column sep 15 | prefix = "" :: string(), % Use this prefix in front of each row 16 | translate, % Value translation function `(Val) -> any()` 17 | footer_rows= 0 :: integer(), % Number of footer rows 18 | td_formats :: undefined|tuple(), % Optional tuple containing value format for columns 19 | % (each item is either a Fmt string or fun(Value)). 20 | thousands :: undefined|string()|binary(),% Number thousands separator 21 | ccy_sym :: undefined|string()|binary(),% Currency prefix/suffix 22 | ccy_sep = <<"">>:: string()|binary(),% Currency separator 23 | ccy_pos = left :: left|right, % Currency symbol position 24 | outline = [bottom]::none|full|[top|bottom|left|right]|map(),% Draw outline box on all sides of a table [top,bottom,left,right] 25 | unicode = false :: boolean() % Use unicode symbols for box borders 26 | }). 27 | 28 | 29 | -------------------------------------------------------------------------------- /priv/sample-logger.config: -------------------------------------------------------------------------------- 1 | %% This is a sample config for the util_log_formatter 2 | [ 3 | {kernel, [ 4 | {logger, [ 5 | % Print errors only to system_errors log 6 | {handler, default, logger_std_h, #{ % {handler, HandlerId, Module, Config} 7 | level => error 8 | , config => #{ 9 | type => {file, "${HOME}/log/erl-error.log"} 10 | , max_no_bytes => 10485760 11 | , max_no_files => 5 12 | , file_check => 5000 13 | } 14 | , formatter => {util_log_formatter, #{ 15 | max_size => 2048 16 | , depth => 10 17 | , single_line => true 18 | , time_designator => $\s 19 | , time_offset => none 20 | , time_unit => millisecond 21 | % , report_prefix => "" 22 | , template => [time," ", 23 | {report, ['LEVEL', " [",modline,":",regpid,"]\n"], [" [",lev,"] "]}, 24 | msg, 25 | {report, ["\n"], [" [",modline,":",regpid,"]"]}, 26 | "\n"] 27 | }} 28 | }} 29 | % Print all log events to debug log 30 | , {handler, debug_log, logger_std_h, #{ 31 | level => debug 32 | , config => #{ 33 | type => {file, "${HOME}/log/erl-debug.log"} 34 | , max_no_bytes => 10485760 35 | , max_no_files => 5 36 | , file_check => 5000 37 | } 38 | , formatter => {util_log_formatter, #{ 39 | legacy_header => true 40 | , time_designator => $\s 41 | , single_line => false 42 | , time_offset => none 43 | , time_unit => millisecond 44 | % , report_prefix => "" 45 | , template => [time," ", 46 | {report, ['LEVEL', " [",modline,":",regpid,"]\n"], ["[",lev,"] "]}, 47 | msg, 48 | {report, ["\n"], [" [",modline,":",regpid,"]"]}, 49 | "\n"] 50 | }} 51 | }} 52 | % Print all log events to display log 53 | , {handler, screen_log, logger_std_h, #{ 54 | level => debug 55 | , formatter => {util_log_color_formatter, #{ 56 | legacy_header => true 57 | , time_designator => $\s 58 | , single_line => false 59 | }} 60 | }} 61 | ]} 62 | ]} 63 | ]. 64 | -------------------------------------------------------------------------------- /rebar.config: -------------------------------------------------------------------------------- 1 | {erl_opts, [debug_info, warn_export_all]}. 2 | 3 | {hex, [{doc, ex_doc}]}. 4 | %{hex, [{doc, edoc}]}. 5 | 6 | {ex_doc, [ 7 | {extras, [ 8 | {"README.md", #{title => "Overview"}}, 9 | {"LICENSE", #{title => "License"}} 10 | ]}, 11 | {main, "README.md"}, 12 | {source_url, "https://github.com/saleyn/util"} 13 | ]}. 14 | 15 | {plugins, [rebar3_hex, {rebar3_ex_doc, "0.2.12"}]}. 16 | -------------------------------------------------------------------------------- /src/alias.erl: -------------------------------------------------------------------------------- 1 | %%% vim:ts=2:sw=2:et 2 | %%%----------------------------------------------------------------------------- 3 | %%% @doc Creation of module aliases 4 | %%% 5 | %%% @author Serge Aleynikov 6 | %%% @copyright 2021 Serge Aleynikov 7 | %%% @end 8 | %%%----------------------------------------------------------------------------- 9 | %%% Created 2021-06-01 10 | %%%----------------------------------------------------------------------------- 11 | -module(alias). 12 | -export([create/2, create/3]). 13 | 14 | %% @doc Create a module `Alias' for the given `OrigMod' module. 15 | %% This function is useful for creating in-memory Elixir wrapper modules without 16 | %% needing to maintain persistent files with such wrappers. 17 | %% `IncFuns' argument can be `all' or a list of `{Fun, Arity}' values which 18 | %% only export a subset of functions from the `OrigMod'. 19 | 20 | create(Alias, OrigMod) -> 21 | create(Alias, OrigMod, all). 22 | create(Alias, OrigMod, IncFuns) when IncFuns == all; is_list(IncFuns) -> 23 | Exports = [T || T <- OrigMod:module_info(exports) 24 | , element(1, T) /= module_info 25 | , IncFuns==all orelse lists:member(T, IncFuns)], 26 | AST = [{attribute, ?LINE, module, Alias} 27 | ,{attribute, ?LINE, export, Exports} 28 | |[begin 29 | % AST of a function call from the OrigMod module 30 | Remote = {remote, ?LINE, {atom, ?LINE, OrigMod}, {atom, ?LINE, Fun}}, 31 | Args = [{var, ?LINE, list_to_atom("A" ++ integer_to_list(N))} 32 | || N <- lists:seq(1, Arity)], 33 | {function, ?LINE, Fun, Arity, [{clause, ?LINE, Args, [], [{call, ?LINE, Remote, Args}]}]} 34 | end || {Fun, Arity} <- Exports] 35 | ], 36 | {ok, Alias, Bin} = compile:forms(AST), 37 | {module, Alias} = code:load_binary(Alias, "/dev/null", Bin), 38 | {ok, Alias}. 39 | -------------------------------------------------------------------------------- /src/base32.erl: -------------------------------------------------------------------------------- 1 | %% ------------------------------------------------------------------- 2 | %% 3 | %% Copyright (c) 2012 Andrew Tunnell-Jones. All Rights Reserved. 4 | %% 5 | %% This file is provided to you under the Apache License, 6 | %% Version 2.0 (the "License"); you may not use this file 7 | %% except in compliance with the License. You may obtain 8 | %% a copy of the License at 9 | %% 10 | %% http://www.apache.org/licenses/LICENSE-2.0 11 | %% 12 | %% Unless required by applicable law or agreed to in writing, 13 | %% software distributed under the License is distributed on an 14 | %% "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 15 | %% KIND, either express or implied. See the License for the 16 | %% specific language governing permissions and limitations 17 | %% under the License. 18 | %% 19 | %% ------------------------------------------------------------------- 20 | -module(base32). 21 | -export([encode/1, encode/2, decode/1, decode/2]). 22 | 23 | -ifdef(TEST). 24 | -include_lib("eunit/include/eunit.hrl"). 25 | -endif. 26 | 27 | encode(Bin) when is_binary(Bin) -> encode(Bin, []); 28 | encode(List) when is_list(List) -> encode(list_to_binary(List), []). 29 | 30 | encode(Bin, Opts) when is_binary(Bin) andalso is_list(Opts) -> 31 | Hex = proplists:get_bool(hex, Opts), 32 | Lower = proplists:get_bool(lower, Opts), 33 | Fun = case Hex of 34 | true -> fun(I) -> hex_enc(Lower, I) end; 35 | false -> fun(I) -> std_enc(Lower, I) end 36 | end, 37 | {Encoded0, Rest} = encode_body(Fun, Bin), 38 | {Encoded1, PadBy} = encode_rest(Fun, Rest), 39 | Padding = case proplists:get_bool(nopad, Opts) of 40 | true -> <<>>; 41 | false -> list_to_binary(lists:duplicate(PadBy, $=)) 42 | end, 43 | <>; 44 | encode(List, Opts) when is_list(List) andalso is_list(Opts) -> 45 | encode(list_to_binary(List), Opts). 46 | 47 | encode_body(Fun, Bin) -> 48 | Offset = 5 * (byte_size(Bin) div 5), 49 | <> = Bin, 50 | {<< <<(Fun(I))>> || <> <= Body>>, Rest}. 51 | 52 | encode_rest(Fun, Bin) -> 53 | Whole = bit_size(Bin) div 5, 54 | Offset = 5 * Whole, 55 | <> = Bin, 56 | Body0 = << <<(Fun(I))>> || <> <= Body>>, 57 | {Body1, Pad} = case Rest of 58 | <> -> {<<(Fun(I bsl 2))>>, 6}; 59 | <> -> {<<(Fun(I bsl 4))>>, 4}; 60 | <> -> {<<(Fun(I bsl 1))>>, 3}; 61 | <> -> {<<(Fun(I bsl 3))>>, 1}; 62 | <<>> -> {<<>>, 0} 63 | end, 64 | {<>, Pad}. 65 | 66 | std_enc(_, I) when is_integer(I) andalso I >= 26 andalso I =< 31 -> I + 24; 67 | std_enc(Lower, I) when is_integer(I) andalso I >= 0 andalso I =< 25 -> 68 | case Lower of 69 | true -> I + $a; 70 | false -> I + $A 71 | end. 72 | 73 | hex_enc(_, I) when is_integer(I) andalso I >= 0 andalso I =< 9 -> I + 48; 74 | hex_enc(Lower, I) when is_integer(I) andalso I >= 10 andalso I =< 31 -> 75 | case Lower of 76 | true -> I + 87; 77 | false -> I + 55 78 | end. 79 | 80 | decode(Bin) when is_binary(Bin) -> decode(Bin, []); 81 | decode(List) when is_list(List) -> decode(list_to_binary(List), []). 82 | 83 | decode(Bin, Opts) when is_binary(Bin) andalso is_list(Opts) -> 84 | Fun = case proplists:get_bool(hex, Opts) of 85 | true -> fun hex_dec/1; 86 | false -> fun std_dec/1 87 | end, 88 | decode(Fun, Bin, <<>>); 89 | decode(List, Opts) when is_list(List) andalso is_list(Opts) -> 90 | decode(list_to_binary(List), Opts). 91 | 92 | decode(Fun, <>, Bits) -> 93 | <>; 94 | decode(Fun, <>, Bits) -> 95 | <>; 96 | decode(Fun, <>, Bits) -> 97 | <>; 98 | decode(Fun, <>, <<"">>}, 116 | {<<"f">>, <<"MY======">>}, 117 | {<<"fo">>, <<"MZXQ====">>}, 118 | {<<"foo">>, <<"MZXW6===">>}, 119 | {<<"foob">>, <<"MZXW6YQ=">>}, 120 | {<<"fooba">>, <<"MZXW6YTB">>}, 121 | {<<"foobar">>, <<"MZXW6YTBOI======">>}]. 122 | 123 | lower_cases(Cases) -> 124 | [{I, << <<(string:to_lower(C))>> || <> <= O >>} || {I, O} <- Cases ]. 125 | 126 | nopad_cases(Cases) -> 127 | [{I, << <> || <> <= O, C =/= $= >>} || {I, O} <- Cases]. 128 | 129 | stringinput_cases(Cases) -> [{binary_to_list(I), O} || {I, O} <- Cases]. 130 | 131 | stringoutput_cases(Cases) -> [{I, binary_to_list(O)} || {I, O} <- Cases]. 132 | 133 | std_encode_test_() -> 134 | [ ?_assertEqual(Out, encode(In)) || {In, Out} <- std_cases() ]. 135 | 136 | std_decode_test_() -> 137 | [ ?_assertEqual(Out, decode(In)) || {Out, In} <- std_cases() ]. 138 | 139 | std_encode_lower_test_() -> 140 | [ ?_assertEqual(Out, encode(In, [lower])) || 141 | {In, Out} <- lower_cases(std_cases()) ]. 142 | 143 | std_decode_lower_test_() -> 144 | [ ?_assertEqual(Out, decode(In)) || {Out, In} <- lower_cases(std_cases()) ]. 145 | 146 | std_encode_nopad_test_() -> 147 | [ ?_assertEqual(Out, encode(In, [nopad])) 148 | || {In, Out} <- nopad_cases(std_cases()) ]. 149 | 150 | std_encode_lower_nopad_test_() -> 151 | [ ?_assertEqual(Out, encode(In, [lower,nopad])) 152 | || {In, Out} <- nopad_cases(lower_cases(std_cases())) ]. 153 | 154 | std_encode_string_test_() -> 155 | [ ?_assertEqual(Out, encode(In)) 156 | || {In, Out} <- stringinput_cases(std_cases()) ]. 157 | 158 | std_decode_string_test_() -> 159 | [ ?_assertEqual(Out, decode(In)) 160 | || {Out, In} <- stringoutput_cases(std_cases()) ]. 161 | 162 | hex_cases() -> 163 | [{<<>>, <<>>}, 164 | {<<"f">>, <<"CO======">>}, 165 | {<<"fo">>, <<"CPNG====">>}, 166 | {<<"foo">>, <<"CPNMU===">>}, 167 | {<<"foob">>, <<"CPNMUOG=">>}, 168 | {<<"fooba">>, <<"CPNMUOJ1">>}, 169 | {<<"foobar">>, <<"CPNMUOJ1E8======">>}]. 170 | 171 | hex_encode_test_() -> 172 | [ ?_assertEqual(Out, encode(In, [hex])) || {In, Out} <- hex_cases() ]. 173 | 174 | hex_decode_test_() -> 175 | [ ?_assertEqual(Out, decode(In, [hex])) || {Out, In} <- hex_cases() ]. 176 | 177 | hex_encode_lower_test_() -> 178 | [ ?_assertEqual(Out, encode(In, [hex,lower])) 179 | || {In, Out} <- lower_cases(hex_cases()) ]. 180 | 181 | hex_decode_lower_test_() -> 182 | [ ?_assertEqual(Out, decode(In, [hex])) 183 | || {Out, In} <- lower_cases(hex_cases()) ]. 184 | 185 | hex_encode_nopad_test_() -> 186 | [ ?_assertEqual(Out, encode(In, [hex,nopad])) 187 | || {In, Out} <- nopad_cases(hex_cases()) ]. 188 | 189 | hex_encode_lower_nopad_test_() -> 190 | [ ?_assertEqual(Out, encode(In, [hex,lower,nopad])) 191 | || {In, Out} <- nopad_cases(lower_cases(hex_cases())) ]. 192 | 193 | hex_encode_string_test_() -> 194 | [ ?_assertEqual(Out, encode(In, [hex])) 195 | || {In, Out} <- stringinput_cases(hex_cases()) ]. 196 | 197 | hex_decode_string_test_() -> 198 | [ ?_assertEqual(Out, decode(In, [hex])) 199 | || {Out, In} <- stringoutput_cases(hex_cases()) ]. 200 | 201 | -endif. 202 | -------------------------------------------------------------------------------- /src/cipher.erl: -------------------------------------------------------------------------------- 1 | -module(cipher). 2 | 3 | -export([encrypt/2, decrypt/2, make_key/1, make_key_base64/1]). 4 | -export([encrypt_base64/2, decrypt_base64/2]). 5 | -export([gpg_key_decode/1]). 6 | 7 | -define(AAD, <<"AES256GCM">>). 8 | 9 | encrypt(Text, KeyPlainText) when (is_list(Text) orelse is_binary(Text)), is_list(KeyPlainText) -> 10 | Key = make_key(KeyPlainText), 11 | {encrypt(Text, Key), Key}; 12 | 13 | encrypt(Text, Key) when (is_list(Text) orelse is_binary(Text)), is_binary(Key), byte_size(Key) =:= 32 -> 14 | Data = iolist_to_binary([<<(erlang:system_time(microsecond)):64/integer>>, Text]), 15 | IV = crypto:strong_rand_bytes(16), % create random Initialisation Vector 16 | {Ciphertext, Tag} = crypto:crypto_one_time_aead(aes_256_gcm, Key, IV, Data, ?AAD, true), 17 | <>. % "return" iv with the cipher tag & ciphertext 18 | 19 | decrypt(_Encrypted = <>, Key) when byte_size(Key) =:= 32 -> 20 | <<_Time:64/integer, Text/binary>> = 21 | crypto:crypto_one_time_aead(aes_256_gcm, Key, IV, Cipher, ?AAD, Tag, false), 22 | Text. 23 | 24 | make_key(PlainKey) when is_list(PlainKey); is_binary(PlainKey) -> 25 | crypto:hash(sha256, PlainKey). 26 | 27 | 28 | encrypt_base64(Text, KeyBase64) -> 29 | base64:encode(encrypt(Text, base64:decode(KeyBase64))). 30 | 31 | decrypt_base64(EncryptedBase64, KeyBase64) when is_list(EncryptedBase64) -> 32 | decrypt_base64(list_to_binary(EncryptedBase64), KeyBase64); 33 | decrypt_base64(EncryptedBase64, KeyBase64) when is_binary(EncryptedBase64) -> 34 | decrypt(base64:decode(EncryptedBase64), base64:decode(KeyBase64)). 35 | 36 | make_key_base64(PlainKey) when is_list(PlainKey); is_binary(PlainKey) -> 37 | base64:encode(crypto:hash(sha256, PlainKey)). 38 | 39 | %% @doc Decode PGP public key 40 | -spec gpg_key_decode(string()|binary()) -> [public_key:pem_entry()]. 41 | gpg_key_decode(File) when is_list(File) -> 42 | {ok, B} = file:read_file(File), 43 | gpg_key_decode(B); 44 | gpg_key_decode(Bin) when is_binary(Bin) -> 45 | B1 = re:replace(Bin, <<"-----BEGIN PGP (PUBLIC|PRIVATE) KEY BLOCK-----">>, 46 | <<"-----BEGIN RSA \\1 KEY-----">>, [{return, binary}]), 47 | B2 = re:replace(B1, <<"-----END PGP (PUBLIC|PRIVATE) KEY BLOCK-----">>, 48 | <<"-----END RSA \\1 KEY-----">>, [{return, binary}]), 49 | B3 = re:replace(B2, <<"\n.+(\n-----END)">>, <<"\\1">>, [{return, binary}]), % Remove checksum 50 | B4 = re:replace(B3, <<"\nVersion:.+\n\r?\n">>, <<"\n">>, [{return, binary}]), % Remove version 51 | public_key:pem_decode(B4). 52 | 53 | -ifdef(TEST). 54 | -include_lib("eunit/include/eunit.hrl"). 55 | -endif. 56 | 57 | -ifdef(EUNIT). 58 | run_test() -> 59 | Text = <<"This is a test">>, 60 | Key = make_key("Test"), 61 | Text = cipher:decrypt(cipher:encrypt(Text, Key), Key), 62 | Key64 = base64:encode(Key), 63 | Text = cipher:decrypt_base64(cipher:encrypt_base64(Text, Key64), Key64). 64 | 65 | decode_gpg_key_test() -> 66 | Key = <<"-----BEGIN PGP PUBLIC KEY BLOCK-----\r\n" 67 | "Version: GnuPG v1.4.11 (GNU/Linux)\r\n" 68 | "\r\n" 69 | "mQINBE9NBIQBEADMSzN6b0FaPP0rGiLDWKfH4ehN66Z0SAIynXm6lBHjmO69pNsm\r\n" 70 | "iIe4p1X9aXhr7EgEZKdbqevfXW7NuA/oL7Rbt+tzBT5nS2cYSHoZhUC/onVhJxUb\r\n" 71 | "drCR9NsBDZc1wZs+b95K3vWW91wMPYs4tn71DeeNgUVCcZOGofWltI7+etTVVIyG\r\n" 72 | "zMEW4lOiEwBgLee+5u3XyGsBbyhtWnbp8ZMewiXjo14w0UCMEQxvf55NjggAO/vR\r\n" 73 | "C+Czz5FQ7m9AnZwqIZJfaAw+aM81lmcXRZenGZ/H25H6WLq2DrVXnRjEyUvK+juj\r\n" 74 | "K6rTHcot6K4Cgvo3P47uZcze92c4KaI22jTePRB1qov8ygAQw8BPsaZ+cA3AQ2Zv\r\n" 75 | "4hjIyx2Qovs+vb1xWhk9Mgqyt0ToMZ6HNn386ICxaeYR8XY/rhf9ej0PJOS5c9Nx\r\n" 76 | "reeTdrYXeco27kp/x+nDSWzqy0MrSAAD19xCK1w8Eiwc9MmjAAX1yarQzUy/ICey\r\n" 77 | "eY6SaBfdK7x7A1ecUSu7mS7LmGFWB49Tx5u3ENXw9rU2hKbmGbbQsc+xCx5s7ZM1\r\n" 78 | "q0aATJsUO4fsNe+4/9cBXCSP+4P6irX1EfliqaySt0LEr0WYhIgNgYq8PB7yx4Cv\r\n" 79 | "0mOMv8lXBMYZs8NTrMJl2XHfi3egu8Ti14VChCklnWe95sZvKrk9/3BYxwARAQAB\r\n" 80 | "tCtMZW8gWm92aWMgKEluYWltYXRoaSkgPGxlby56b3ZpY0BnbWFpbC5jb20+iQI4\r\n" 81 | "BBMBAgAiBQJPTQSEAhsDBgsJCAcDAgYVCAIJCgsEFgIDAQIeAQIXgAAKCRDlo9AP\r\n" 82 | "+vpofbYuD/9luGWbbw0ia5EfsDArk+iAs55HdmgjtVrcEqASR92bSbXxUylvM41T\r\n" 83 | "Gd4nrM7Ri9XVgUSj6ZMnvPJihk08dkjWtoz83JQFdyJ9u7vIqs0LU4awrbNQ8l7P\r\n" 84 | "M3fVKOme/vwQQ7kyIWkIYB0bl+CDRnldYGyBbV0lzh25/eVnhE8AsDltHJjhwe17\r\n" 85 | "GVQPQfk/4B9SY0bTuAojZCUpMtI4cSBaI4v+xojewFt9B53oxW/KrLOvCVYUE9m2\r\n" 86 | "TiJrtWcQjYqrlY9Ku203LzIZWbsFt9NEM6I26ewL3Iqn687fLgdkXZ2TuomJEcY+\r\n" 87 | "5UxPIZfdiXqNG/nFLSII3v9kWA/f6ysXn7NTFx594+5KUqwjPke9ZFxi7gmyuRtK\r\n" 88 | "KQyz1P+fRpkHqdP+OdNASDZ66CUaOqJrea6N+HpGIdBgRVfaYezl0wy9QfPe/PV7\r\n" 89 | "ewYlP/nEpXDNpnr4cOvvD52VeoW9oiZEt0UFZ5iWEVepZlJ9uNq1QKkKDGHjBA/n\r\n" 90 | "Mgd/Mc/Bg6sTfs6gtKfiX5MoPhZd/WDonAZyimJMY23Dw31TuIjmEmO1MuNNxj6c\r\n" 91 | "Q2qWCVsQED6GgkPSRMwZ4+6Dh8DsLrt5xQp68I204XnT+ppgkXY/f4ALseRlOXeQ\r\n" 92 | "9TeqeMcq7lO9DVULHLfXELw5/ijN08BBToZBIaBPKKoGhEdWBl9P3bkCDQRPTQSE\r\n" 93 | "ARAAt9MpaK5TzTOzO/IenaHpfu0EoI4ZQSiWD4ZujvyuMEscdPQ4wDRMVwh66FAW\r\n" 94 | "jeRE4O/m1q4rt/qDKqa0VCSGmap9gj7iLZ9+Fu5n3jyentzmoe22ATO7jOITGbW2\r\n" 95 | "+0D56U3jCRRoSsY8ZSqECBLhsKbc7WIBX8yVxvpHYaqTOwM2+CIqDda5vgKeNxzk\r\n" 96 | "cVDgUBnYj1nNpklGCs3494IVQ8aLVo5nOm8J0vY/n/YK5sAf6RlK+MEXCEyMVoiG\r\n" 97 | "V4wo4fGLJXkhky5yL9vW+vmkUslw7mbAFRIC2KLg0CxXaGychsScpDlpmHkcxmsl\r\n" 98 | "riGbEaKe0kMOM4KkXdopoGB66T0sEftL+hJmrAVe3H4iyldh/d5Hf1ez670m4ZZ6\r\n" 99 | "gNdRCv3WJ72mZv4pqFH94NUksHvPrmot0B23ne6y/MqxYLIweIjJkD1ePxqpffMq\r\n" 100 | "Ktkq9ooH7SB2GAMihCWiY/orSi6bt670Y9P3pzrwolErCWxieX8dg3H04z5nA7J3\r\n" 101 | "6mqxQXLQvY6lXZYANOEKmm1qyoDgeBJoJdYUFbHrb83xcxQUqp8zikKneQ0rJfVG\r\n" 102 | "dj38smSNAMqOeQQwZlmKFVwmIu4ozqszgZ2oqWS7q2NJgg64dnQlA60VMebQ0e8d\r\n" 103 | "MMqy41VJ1FF8PCT1GGMsL+H4vdoZ+/wF2bhMQISWqFSVa5EAEQEAAYkCHwQYAQIA\r\n" 104 | "CQUCT00EhAIbDAAKCRDlo9AP+vpofVp4D/9WqB4h9T5kGLBvuGUebjSqBuv6XfUd\r\n" 105 | "q8vrvrMbSiLTLj2Gk58FjXdTPKCAuTkTtiYjMIXR0cF30uGRccM/tOMSp0xQYVT6\r\n" 106 | "ueBhDZHaWaAEr2408j7/+tVg5CaLO/dVVfxpHIJ+8Bf1YmRRMpDm94i8X5j4rxPv\r\n" 107 | "GNaOa6CgqWGlXsqFUw19OqXI5pK+hBH/GEpVPawr8/JLauc24ovt76gLGXDHrmKV\r\n" 108 | "aeryKzy3TWikj3cq8Mdj2mKqNwkn1uu89j3xvxbq6gxX7lGX8pCLS2W6a7PYDaXf\r\n" 109 | "no1/C31//Shn26LD9YfzRhcA/B/uXtEST3eShM5uS2sm+oOpxpiRaBv477K2TLpn\r\n" 110 | "zh82VgwRTDkelpYJG8R8eBXwbBik+WSeIprZ8IrMfzZNs7xwn+z9isB0P3+VObWj\r\n" 111 | "tBYKdMoF1mu40O1I7hsWV9UpJjRw2WrI8WpZMQTInXcaDWomWRgVhQjVhenYf6u2\r\n" 112 | "nVoN3MM47hR7OR6KtcQ59lwlBeLcK9ImFuXjPK1GG9LtHzkKVOTI6p51S6Ug5MPu\r\n" 113 | "7BuJxpxwDiohhVizBk3oZWInpNiXomk7Q6XwQ65mFTB11bX+wn0JIWO7BUWxK+dH\r\n" 114 | "E+8YuCe53OAvNU0BFT8MAe/vB9kMl4N3p/3bJPuzmP4lnAGrLwzBZPkiQTNq8aj8\r\n" 115 | "5NsttvIOclBY5A==\r\n" 116 | "=Zqph\r\n" 117 | "-----END PGP PUBLIC KEY BLOCK-----\r\n">>, 118 | [{'RSAPublicKey', _, not_encrypted}] = gpg_key_decode(Key). 119 | 120 | -endif. 121 | -------------------------------------------------------------------------------- /src/compile_time.ex: -------------------------------------------------------------------------------- 1 | defmodule CompileTime do 2 | @doc""" 3 | Evaluate a function at compile time. 4 | 5 | ## Example 6 | iex> require CompileTime 7 | iex> CompileTime.eval(&NaiveDateTime.utc_now/0) 8 | %NaiveDateTime{} 9 | """ 10 | defmacro eval(f) do 11 | {fun, _} = Code.eval_quoted(f) 12 | val = fun.() 13 | 14 | quote do 15 | unquote(Macro.escape(val)) 16 | end 17 | end 18 | end 19 | -------------------------------------------------------------------------------- /src/decompiler.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------------ 2 | %%% @doc Module and function decompiler 3 | %%% 4 | %%% In order to use decompiler, make sure to include `syntax_tools' 5 | %%% application in dependencies. 6 | %%% 7 | %%% See also https://github.com/hrzndhrn/beam_file 8 | %%% 9 | %%% @author Serge Aleynikov 10 | %%% @end 11 | %%%------------------------------------------------------------------------ 12 | %%% Copyright (c) 2009 Serge Aleynikov 13 | %%% 14 | %%% Permission is hereby granted, free of charge, to any person 15 | %%% obtaining a copy of this software and associated documentation 16 | %%% files (the "Software"), to deal in the Software without restriction, 17 | %%% including without limitation the rights to use, copy, modify, merge, 18 | %%% publish, distribute, sublicense, and/or sell copies of the Software, 19 | %%% and to permit persons to whom the Software is furnished to do 20 | %%% so, subject to the following conditions: 21 | %%% 22 | %%% The above copyright notice and this permission notice shall be included 23 | %%% in all copies or substantial portions of the Software. 24 | %%% 25 | %%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 26 | %%% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 27 | %%% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 28 | %%% IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 29 | %%% CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 30 | %%% TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 31 | %%% SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 32 | %%%------------------------------------------------------------------------ 33 | -module(decompiler). 34 | -author('saleyn@gmail.com'). 35 | 36 | -export([run/1, run/2, fun_src/1, fun_src/2]). 37 | 38 | %% @doc Decompile a beam file 39 | -spec run(string()|binary()) -> ok | {error, any()}. 40 | run(BeamFName) -> 41 | run(BeamFName, []). 42 | 43 | %% @doc Decompile a beam file or module and optionally save it to disk 44 | -spec run(string()|binary()|atom(), [verbose | erl | ast]) -> ok | {error, any()}. 45 | run(Module, Options) when is_atom(Module) -> 46 | case code:which(Module) of 47 | BeamFName when is_list(BeamFName) -> 48 | run(BeamFName, Options); 49 | non_existing -> 50 | {error, not_found} 51 | end; 52 | run(BeamFName, Options) when is_list(BeamFName); is_binary(BeamFName) -> 53 | FName = if is_binary(BeamFName) -> binary_to_list(BeamFName); true -> BeamFName end, 54 | case get_abstract_code(FName) of 55 | {ok, Module, Basename, Forms} -> 56 | Ast = erl_syntax:form_list(tl(Forms)), 57 | save_file(lists:member(ast, Options), ast, Options, Basename, 58 | fun(Fd) -> io:fwrite(Fd, "~p.\n", [Ast]) end), 59 | Src = erl_prettypr:format(Ast), 60 | save_file(lists:member(erl, Options) orelse not 61 | lists:member(ast, Options), 62 | erl, Options, Basename, 63 | fun(Fd) -> 64 | case [I || I = {attribute,_,module,_} <- Forms] of 65 | [] -> io:fwrite(Fd, "-module(~w).\n", [Module]); 66 | _ -> ok 67 | end, 68 | io:fwrite(Fd, "~s\n", [Src]) 69 | end); 70 | {ok,{_,[{abstract_code,no_abstract_code}]}} -> 71 | print(verbose, Options, "Error: file ~s has no abstract code!\n", [BeamFName]), 72 | lists:member(verbose, Options) orelse throw(no_abstract_code), 73 | {error, no_abstract_code}; 74 | Error -> 75 | lists:member(verbose, Options) orelse throw(Error), 76 | Error 77 | end. 78 | 79 | %% @doc Decompile a function to its source text 80 | fun_src(Fun) when is_function(Fun) -> 81 | fun_src(Fun, []). 82 | 83 | %% @doc Decompile a function to its source text 84 | -spec fun_src(function(), Options :: [verbose | ast]) -> string(). 85 | fun_src(Fun, Options) when is_function(Fun), is_list(Options) -> 86 | {module, Mod} = erlang:fun_info(Fun, module), 87 | {name, Name} = erlang:fun_info(Fun, name), 88 | {ok, Module, Beam, Forms} = get_abstract_code(Mod), 89 | {F, Arity, Pos} = fun_name(Name), 90 | print(verbose, Options, "Module: ~w, Beam: ~s, Name: ~w (~w)\n", 91 | [Module, Beam, Name, F]), 92 | fun_src(Module, Name, F, Arity, Pos, Forms, Fun, Options). 93 | 94 | print(Opt, Options, Fmt, Args) -> 95 | case lists:member(Opt, Options) of 96 | true -> 97 | io:format(Fmt, Args); 98 | false -> 99 | ok 100 | end. 101 | 102 | save_file(false, _Type, _Options, _Basename, _Fun) -> 103 | false; 104 | save_file(true, erl, Options, Basename, Fun) -> 105 | ErlFName = Basename ++ ".erl", 106 | write(ErlFName, Options, Fun); 107 | 108 | save_file(true, ast, Options, Basename, Fun) -> 109 | FName = Basename ++ ".AST", 110 | write(FName, Options, Fun). 111 | 112 | write(Filename, Options, Fun) -> 113 | {ok, Fd} = file:open(Filename, [write]), 114 | Fun(Fd), 115 | file:close(Fd), 116 | print(verbose, Options, "File: ~s\n", [Filename]), 117 | {ok, Filename}. 118 | 119 | get_abstract_code(Module) when is_atom(Module) -> 120 | {module,_} = code:ensure_loaded(Module), 121 | Beam = code:which(Module), 122 | get_abstract_code(Beam); 123 | get_abstract_code(Beam) when is_list(Beam) -> 124 | Basename = filename:basename(Beam, ".beam"), 125 | case beam_lib:chunks(Beam, [abstract_code]) of 126 | {ok, {Module,[{abstract_code,{_,AC}}]}} -> 127 | {ok, Module, Basename, AC}; 128 | Other -> 129 | Other 130 | end. 131 | 132 | fun_src(erl_eval, _Name, expr, _Arity, _Pos, _Forms, Fun, Options) -> 133 | {env, [_, _, _, Abst | _]} = erlang:fun_info(Fun, env), 134 | Ast = erl_syntax:form_list(Abst), 135 | fun_src2(format, Ast, Options); 136 | fun_src(_Module, _Name, F, Arity, Pos, Forms, _Fun, Options) -> 137 | Clauses = [Cs || {function, _, Fun, A, Cs} <- Forms, Fun == F, A == Arity], 138 | Funs = funs(lists:concat(Clauses)), 139 | Ast = lists:nth(Pos, Funs), 140 | fun_src2(undefined, Ast, Options). 141 | 142 | fun_src2(Envelope, Ast, Options) -> 143 | print(ast, Options, "Ast: ~p\n", [Ast]), 144 | Text = erl_prettypr:format(Ast), 145 | case Envelope of 146 | format -> 147 | "fun " ++ Text ++ " end."; 148 | _ -> 149 | Text ++ "." 150 | end. 151 | 152 | fun_name(Name) -> 153 | [Fs, As, _, Rs] = string:tokens(atom_to_list(Name), "-/"), 154 | {list_to_atom(Fs), list_to_integer(As), list_to_integer(Rs)+1}. 155 | 156 | funs(L) -> 157 | lists:reverse(lists:foldl(fun 158 | ({'fun',_,_} = F, A) -> [F | A]; 159 | (T, A) when is_tuple(T) -> funs(lists:flatten(tuple_to_list(T))) ++ A; 160 | (_, A) -> A 161 | end, [], L)). 162 | -------------------------------------------------------------------------------- /src/env.erl: -------------------------------------------------------------------------------- 1 | %%%---------------------------------------------------------------------------- 2 | %%% @doc Environment utils 3 | %%% @author Serge Aleynikov 4 | %%% @copyright 2012 Serge Aleynikov 5 | %%% @end 6 | %%%---------------------------------------------------------------------------- 7 | %%% Created: 2012-09-21 8 | %%%---------------------------------------------------------------------------- 9 | -module(env). 10 | -author('saleyn@gmail.com'). 11 | 12 | %% API 13 | -export([subst_env_path/1, subst_env_path/2, 14 | replace_env_vars/1, replace_env_vars/2, 15 | get_env/3, home_dir/0, 16 | normalize_path/1]). 17 | 18 | -ifdef(TEST). 19 | -include_lib("eunit/include/eunit.hrl"). 20 | -endif. 21 | 22 | -deprecated([{subst_env_path,1,"use replace_env_vars/1 instead"}]). 23 | -deprecated([{subst_env_path,2,"use replace_env_vars/2 instead"}]). 24 | 25 | %%%---------------------------------------------------------------------------- 26 | %%% External API 27 | %%%---------------------------------------------------------------------------- 28 | 29 | -spec subst_env_path(list() | binary()) -> list() | binary(). 30 | subst_env_path(OsPath) -> 31 | replace_env_vars(OsPath, []). 32 | 33 | -spec subst_env_path(list() | binary(), [{atom() | string(), string()}]) -> 34 | list() | binary(). 35 | subst_env_path(OsPath, Bindings) when is_list(Bindings) -> 36 | replace_env_vars(OsPath, Bindings). 37 | 38 | %%------------------------------------------------------------------------ 39 | %% @doc Perform replacement of environment variable values in the OsPath. 40 | %% ``` 41 | %% Example: 42 | %% env:replace_env_vars("~/app") -> "/home/cuser/app" 43 | %% env:replace_env_vars("${HOME}/app") -> "/home/cuser/app" 44 | %% env:replace_env_vars("$USER/app") -> "cuser/app" 45 | %% ''' 46 | %% @see os:getenv/1 47 | %% @end 48 | %%------------------------------------------------------------------------ 49 | -spec replace_env_vars(list() | binary()) -> list() | binary(). 50 | replace_env_vars(OsPath) -> 51 | replace_env_vars(OsPath, []). 52 | 53 | 54 | %%------------------------------------------------------------------------ 55 | %% @doc Perform replacement of environment variable values in the OsPath. 56 | %% This function also allows to provide a list of `Bindings' that 57 | %% override the environment (they are checked before environment 58 | %% variables are looked up). 59 | %% ``` 60 | %% Example: 61 | %% env:replace_env_vars("~/", [{"HOME", "/home/cu"}]) -> "/home/cu/" 62 | %% env:replace_env_vars("~/", [{home, "/home/cu"}]) -> "/home/cu/" 63 | %% env:replace_env_vars("$A/", [{a, "/aaa"}]) -> "/aaa/" 64 | %% env:replace_env_vars("${A}/",[{a, "/aaa"}]) -> "/aaa/" 65 | %% ''' 66 | %% @see os:getenv/1 67 | %% @end 68 | %%------------------------------------------------------------------------ 69 | -spec replace_env_vars(list() | binary(), [{atom() | string(), string()}]) -> 70 | list() | binary(). 71 | replace_env_vars(OsPath, Bindings) when is_list(Bindings) -> 72 | element(2, env_subst(OsPath, Bindings)). 73 | 74 | %%----------------------------------------------------------------------------- 75 | %% @doc Get application configuration 76 | %% @end 77 | %%----------------------------------------------------------------------------- 78 | -spec get_env(atom(), atom(), any()) -> any(). 79 | get_env(App, Key, Default) -> 80 | case application:get_env(App, Key) of 81 | {ok, Val} -> 82 | Val; 83 | _ -> 84 | Default 85 | end. 86 | 87 | %%%---------------------------------------------------------------------------- 88 | %%% Internal functions 89 | %%%---------------------------------------------------------------------------- 90 | 91 | internal_var("RELEASES") -> {ok, get_rels_dir()}; 92 | internal_var("ROOTDIR") -> {ok, get_root_dir()}; 93 | internal_var("RELPATH") -> {ok, get_rel_path()}; % Releases/Version 94 | internal_var(_) -> undefined. 95 | 96 | env_var(OS, "$$", _) when OS==unix; OS==win -> 97 | "$"; 98 | env_var(OS, [$~] = Key, Bindings) when OS==unix; OS==win -> 99 | case get_var(OS, "HOME", Bindings) of 100 | {ok, Value} -> {Key, Value}; 101 | _ -> Key 102 | end; 103 | env_var(OS, [$~ | User] = Word, Bindings) when OS==unix; OS==win -> 104 | case get_var(OS, "HOME", Bindings) of 105 | {ok, Value} -> {[$~], filename:join(filename:dirname(Value), User)}; 106 | _ -> Word 107 | end; 108 | env_var(OS, [$$, ${ | Env] = Word, Bindings) when OS==unix; OS==win -> 109 | Key = string:strip(Env, right, $}), 110 | case get_var(OS, Key, Bindings) of 111 | {ok, Value} -> {Key, Value}; 112 | _ -> Word 113 | end; 114 | env_var(OS, [$$ | Key] = Word, Bindings) when OS==unix; OS==win -> 115 | case get_var(OS, Key, Bindings) of 116 | {ok, Value} -> {Key, Value}; 117 | _ -> Word 118 | end; 119 | env_var(win, "%%", _) -> 120 | "%"; 121 | env_var(win, [$% | Env] = Word, Bindings) -> 122 | Key = string:strip(Env, right, $%), 123 | case get_var(win, Key, Bindings) of 124 | {ok, Value} -> {Key, Value}; 125 | _ -> Word 126 | end; 127 | env_var(_, Other, _Bindings) -> 128 | Other. 129 | 130 | get_var(OS, Name, Bindings) -> 131 | case try_get_binding(Name, Bindings) of 132 | undefined when Name == "HOME" -> 133 | {ok, home_dir(OS)}; 134 | undefined -> 135 | case os:getenv(Name) of 136 | false -> internal_var(Name); 137 | Value -> {ok, Value} 138 | end; 139 | Value -> 140 | {ok, Value} 141 | end. 142 | 143 | try_get_binding(Name, Bindings) -> 144 | case proplists:get_value(Name, Bindings) of 145 | undefined when is_list(Name) -> 146 | try 147 | A = list_to_existing_atom(string:to_lower(Name)), 148 | try_get_binding(A, Bindings) 149 | catch _:_ -> 150 | undefined 151 | end; 152 | Value -> 153 | Value 154 | end. 155 | 156 | env_subst(Bin, Bindings) when is_binary(Bin) -> 157 | {VarList, NewText} = env_subst(binary_to_list(Bin), Bindings), 158 | {VarList, list_to_binary(NewText)}; 159 | env_subst(Text, Bindings) when is_list(Text) -> 160 | env_subst(Text, os:type(), Bindings). 161 | 162 | env_subst(Text, {unix, _}, Bindings) -> 163 | env_subst(Text, unix, 164 | "(?|(?:\\$\\$)|(?:~[^/$]*)|(?:\\${[A-Za-z][A-Za-z_0-9]*})|(?:\\$[A-Za-z][A-Za-z_0-9]*))", 165 | Bindings); 166 | env_subst(Text, {win32, _}, Bindings) -> 167 | env_subst(Text, win, "(?|(?:\\%\\%)|(?:%[A-Za-z][A-Za-z_0-9]*%)|(?:~[^/$]*)|(?:\\${[A-Za-z][A-Za-z_0-9]*})|(?:\\$[A-Za-z][A-Za-z_0-9]*))", Bindings). 168 | 169 | env_subst(Text, OsType, Pattern, Bindings) -> 170 | case re:run(Text, Pattern, [global,{capture, all}]) of 171 | {match, Matches} -> 172 | {Vars, TextList, Last} = 173 | lists:foldl(fun 174 | ([{Start, Length}], {Dict, List, Prev}) when Start >= 0 -> 175 | Pos = Start+1, 176 | Match = string:substr(Text, Pos, Length), 177 | case env_var(OsType, Match, Bindings) of 178 | {Key, Val} -> 179 | case orddict:is_key(Key, Dict) of 180 | true -> 181 | NewDict = Dict; 182 | false -> 183 | NewDict = orddict:append(Key, Val, Dict) 184 | end; 185 | Val -> 186 | NewDict = Dict 187 | end, 188 | NewList = [Val, string:substr(Text, Prev, Pos - Prev) | List], 189 | NewPrev = Pos + Length, 190 | {NewDict, NewList, NewPrev}; 191 | (_, Acc) -> Acc 192 | end, {orddict:new(), [], 1}, Matches), 193 | VarList = [{K, V} || {K, [V|_]} <- orddict:to_list(Vars)], 194 | NewText = lists:concat(lists:reverse([string:substr(Text, Last) | TextList])), 195 | {VarList, NewText}; 196 | nomatch -> 197 | {[], Text} 198 | end. 199 | 200 | get_rel_ver() -> 201 | % release and version 202 | try [T || T <- release_handler:which_releases(), element(4, T) =:= permanent] of 203 | [{Name, Vsn, _Apps, permanent} | _] -> 204 | {Name, Vsn}; 205 | _Other -> 206 | throw 207 | catch _:_ -> 208 | false 209 | end. 210 | 211 | get_root_dir() -> 212 | case os:getenv("ROOTDIR") of 213 | Str when is_list(Str) -> Str; 214 | _ -> "" 215 | end. 216 | 217 | get_rels_dir() -> 218 | case application:get_env(sasl, releases_dir) of 219 | {ok, Path} -> 220 | Path; 221 | _ -> 222 | filename:join(get_root_dir(), "releases") 223 | end. 224 | 225 | get_rel_path() -> 226 | % version 227 | {_, Ver} = get_rel_ver(), 228 | % current release dir 229 | filename:join(get_rels_dir(), Ver). 230 | 231 | home_dir() -> 232 | case os:type() of 233 | {win32,_} -> home_dir(win); 234 | {_,_} -> home_dir(linux) 235 | end. 236 | 237 | home_dir(win) -> 238 | normalize_path(os:getenv("USERPROFILE")); 239 | home_dir(_) -> 240 | os:getenv("HOME"). 241 | 242 | normalize_path(Path) -> 243 | case os:type() of 244 | {win32,_} -> 245 | F = fun Norm([$\\ | T]) -> [$/ | Norm(T)]; 246 | Norm([H | T]) -> [H | Norm(T)]; 247 | Norm([] ) -> [] 248 | end, 249 | F(Path); 250 | {_,_} -> 251 | Path 252 | end. 253 | 254 | 255 | %%%---------------------------------------------------------------------------- 256 | %%% Test Cases 257 | %%%---------------------------------------------------------------------------- 258 | 259 | -ifdef(EUNIT). 260 | 261 | run_test_() -> 262 | [ 263 | ?_assertEqual("/abc/$/efg", replace_env_vars("/abc/$$/efg")), 264 | ?_assertEqual(true, os:putenv("X", "x")), 265 | ?_assertEqual("/" ++ os:getenv("X") ++ "/dir", replace_env_vars("/$X/dir")), 266 | ?_assertEqual(os:getenv("X") ++ "/dir", replace_env_vars("${X}/dir")), 267 | ?_assertEqual(os:getenv("HOME") ++ "/dir", replace_env_vars("~/dir")), 268 | ?_assertEqual("/aaa/dir", replace_env_vars("/$X/dir", [{"X", "aaa"}])), 269 | ?_assertEqual("/aaa/dir", replace_env_vars("/$X/dir", [{x, "aaa"}])), 270 | ?_assertEqual("/xxx/dir", replace_env_vars("$HOME/dir", [{"HOME", "/xxx"}])), 271 | ?_assertEqual("/xxx/dir", replace_env_vars("~/dir", [{"HOME", "/xxx"}])), 272 | ?_assertEqual("/xxx/dir", replace_env_vars("~/dir", [{home, "/xxx"}])) 273 | ]. 274 | 275 | -endif. 276 | -------------------------------------------------------------------------------- /src/erlang_scan.xrl: -------------------------------------------------------------------------------- 1 | %%% File : erlang_scan.xrl 2 | %%% Author : Robert Virding 3 | %%% Purpose : Tkoen definitions for Erlang. 4 | 5 | Definitions. 6 | O = [0-7] 7 | D = [0-9] 8 | H = [0-9a-fA-F] 9 | U = [A-Z] 10 | L = [a-z] 11 | A = ({U}|{L}|{D}|_|@) 12 | WS = ([\000-\s]|%.*) 13 | 14 | Rules. 15 | {D}+\.{D}+((E|e)(\+|\-)?{D}+)? : 16 | {token,{float,TokenLine,list_to_float(TokenChars)}}. 17 | {D}+#{H}+ : base(TokenLine, TokenChars). 18 | {D}+ : {token,{integer,TokenLine,list_to_integer(TokenChars)}}. 19 | {L}{A}* : Atom = list_to_atom(TokenChars), 20 | {token,case reserved_word(Atom) of 21 | true -> {Atom,TokenLine}; 22 | false -> {atom,TokenLine,Atom} 23 | end}. 24 | '(\\\^.|\\.|[^'])*' : 25 | %% Strip quotes. 26 | S = lists:sublist(TokenChars, 2, TokenLen - 2), 27 | case catch list_to_atom(string_gen(S)) of 28 | {'EXIT',_} -> {error,"illegal atom " ++ TokenChars}; 29 | Atom -> {token,{atom,TokenLine,Atom}} 30 | end. 31 | ({U}|_){A}* : {token,{var,TokenLine,list_to_atom(TokenChars)}}. 32 | "(\\\^.|\\.|[^"])*" : 33 | %% Strip quotes. 34 | S = lists:sublist(TokenChars, 2, TokenLen - 2), 35 | {token,{string,TokenLine,string_gen(S)}}. 36 | \$(\\{O}{O}{O}|\\\^.|\\.|.) : 37 | {token,{integer,TokenLine,cc_convert(TokenChars)}}. 38 | -> : {token,{'->',TokenLine}}. 39 | :- : {token,{':-',TokenLine}}. 40 | =/= : {token,{'=/=',TokenLine}}. 41 | == : {token,{'==',TokenLine}}. 42 | =:= : {token,{'=:=',TokenLine}}. 43 | /= : {token,{'/=',TokenLine}}. 44 | >= : {token,{'>=',TokenLine}}. 45 | =< : {token,{'=<',TokenLine}}. 46 | <= : {token,{'<=',TokenLine}}. 47 | \+\+ : {token,{'++',TokenLine}}. 48 | -- : {token,{'--',TokenLine}}. 49 | []()[}{|!?/;:,.*+#<>=-] : 50 | {token,{list_to_atom(TokenChars),TokenLine}}. 51 | \.{WS} : {end_token,{dot,TokenLine}}. 52 | {WS}+ : skip_token. 53 | 54 | Erlang code. 55 | 56 | -export([reserved_word/1]). 57 | 58 | reserved_word('after') -> true; 59 | reserved_word('begin') -> true; 60 | reserved_word('case') -> true; 61 | reserved_word('catch') -> true; 62 | reserved_word('end') -> true; 63 | reserved_word('fun') -> true; 64 | reserved_word('if') -> true; 65 | reserved_word('let') -> true; 66 | reserved_word('of') -> true; 67 | reserved_word('query') -> true; 68 | reserved_word('receive') -> true; 69 | reserved_word('when') -> true; 70 | reserved_word('bnot') -> true; 71 | reserved_word('not') -> true; 72 | reserved_word('div') -> true; 73 | reserved_word('rem') -> true; 74 | reserved_word('band') -> true; 75 | reserved_word('and') -> true; 76 | reserved_word('bor') -> true; 77 | reserved_word('bxor') -> true; 78 | reserved_word('bsl') -> true; 79 | reserved_word('bsr') -> true; 80 | reserved_word('or') -> true; 81 | reserved_word('xor') -> true; 82 | reserved_word(_) -> false. 83 | 84 | base(L, Cs) -> 85 | H = string:chr(Cs, $#), 86 | case list_to_integer(string:substr(Cs, 1, H-1)) of 87 | B when B > 16 -> {error,"illegal base"}; 88 | B -> 89 | case base(string:substr(Cs, H+1), B, 0) of 90 | error -> {error,"illegal based number"}; 91 | N -> {token,{integer,L,N}} 92 | end 93 | end. 94 | 95 | base([C|Cs], Base, SoFar) when C >= $0, C =< $9, C < Base + $0 -> 96 | Next = SoFar * Base + (C - $0), 97 | base(Cs, Base, Next); 98 | base([C|Cs], Base, SoFar) when C >= $a, C =< $f, C < Base + $a - 10 -> 99 | Next = SoFar * Base + (C - $a + 10), 100 | base(Cs, Base, Next); 101 | base([C|Cs], Base, SoFar) when C >= $A, C =< $F, C < Base + $A - 10 -> 102 | Next = SoFar * Base + (C - $A + 10), 103 | base(Cs, Base, Next); 104 | base([_|_], _Base, _SoFar) -> error; 105 | base([], _Base, N) -> N. 106 | 107 | cc_convert([$$,$\\|Cs]) -> 108 | hd(string_escape(Cs)); 109 | cc_convert([$$,C]) -> C. 110 | 111 | string_gen([$\\|Cs]) -> 112 | string_escape(Cs); 113 | string_gen([C|Cs]) -> 114 | [C|string_gen(Cs)]; 115 | string_gen([]) -> []. 116 | 117 | string_escape([O1,O2,O3|S]) when 118 | O1 >= $0, O1 =< $7, O2 >= $0, O2 =< $7, O3 >= $0, O3 =< $7 -> 119 | [(O1*8 + O2)*8 + O3 - 73*$0|string_gen(S)]; 120 | string_escape([$^,C|Cs]) -> 121 | [C band 31|string_gen(Cs)]; 122 | string_escape([C|Cs]) when C >= $\000, C =< $\s -> 123 | string_gen(Cs); 124 | string_escape([C|Cs]) -> 125 | [escape_char(C)|string_gen(Cs)]. 126 | 127 | escape_char($n) -> $\n; %\n = LF 128 | escape_char($r) -> $\r; %\r = CR 129 | escape_char($t) -> $\t; %\t = TAB 130 | escape_char($v) -> $\v; %\v = VT 131 | escape_char($b) -> $\b; %\b = BS 132 | escape_char($f) -> $\f; %\f = FF 133 | escape_char($e) -> $\e; %\e = ESC 134 | escape_char($s) -> $\s; %\s = SPC 135 | escape_char($d) -> $\d; %\d = DEL 136 | escape_char(C) -> C. 137 | -------------------------------------------------------------------------------- /src/gin.erl: -------------------------------------------------------------------------------- 1 | %% @doc Guard in 2 | %% @author Michael Uvarov (freeakk@gmail.com) 3 | %% Source: https://github.com/mad-cocktail/gin 4 | %% License: MIT 5 | 6 | -module(gin). 7 | -author('freeakk@gmail.com'). 8 | 9 | -export([parse_transform/2]). 10 | 11 | parse_transform(Forms, _Options) -> 12 | F1 = local_function(numeric_in, 2, in_transform('==')), 13 | F2 = local_function(in, 2, in_transform('=:=')), 14 | F3 = local_function(beetween, 3, fun beetween_transform/1), 15 | F = foldl_functions([F1, F2, F3, fun erl_syntax:revert/1]), 16 | X = [erl_syntax_lib:map(F, Tree) || Tree <- Forms], 17 | % io:format(user, "Before:\t~p\n\nAfter:\t~p\n", [Forms, X]), 18 | X. 19 | 20 | 21 | %% ================================================================== 22 | %% In 23 | %% ================================================================== 24 | 25 | %% It is curry (from Haskell) for `in_transform/2'. 26 | in_transform(Op) -> 27 | fun(Node) -> 28 | in_transform(Op, Node) 29 | end. 30 | 31 | 32 | %% @doc Replace `in(X, List)' with `(X =:= E1) andalso (X =:= E2)' 33 | %% when `List' is `[E1, E2]' and `Op' is `=:='. 34 | %% 35 | %% The caller checks, that the function name is valid. 36 | %% `in' can be any function, for example, `in2' is valid too. 37 | -spec in_transform(Op, Node) -> Node when 38 | Op :: '==' | '=:=', 39 | Node :: erl_syntax_lib:syntaxTree(). 40 | 41 | in_transform(Op, Node) -> 42 | Pos = erl_syntax:get_pos(Node), 43 | %% Call it fore all new nodes. 44 | New = fun(NewNode) -> erl_syntax:set_pos(NewNode, Pos) end, 45 | %% Extract arguments of the `in' function. 46 | [SubjectForm, ListForm] = erl_syntax:application_arguments(Node), 47 | Elems = 48 | case erl_syntax:type(ListForm) of 49 | string -> 50 | Str = erl_syntax:string_value(ListForm), 51 | [erl_syntax:char(C) || C <- Str]; 52 | list -> 53 | %% Extract the list of the valid values. 54 | erl_syntax:list_elements(ListForm) 55 | end, 56 | case Elems of 57 | [] -> 58 | %% Always `false'. 59 | New(erl_syntax:atom(false)); 60 | 61 | _ -> 62 | EqOp = New(erl_syntax:operator(Op)), 63 | OrOp = New(erl_syntax:operator('orelse')), 64 | %% `X' is `Subject =:= Xs'. 65 | [X|Xs] = [New(erl_syntax:infix_expr(E, EqOp, SubjectForm)) || E <- Elems], 66 | F = fun(Right, Left) -> New(erl_syntax:infix_expr(Left, OrOp, Right)) end, 67 | GuardAST = New(erl_syntax:parentheses(lists:foldl(F, X, Xs))), 68 | erl_syntax:revert(GuardAST) 69 | end. 70 | 71 | 72 | %% ================================================================== 73 | %% Beetween 74 | %% ================================================================== 75 | 76 | %% @doc Transforms `beetween(Subject, Start, To)'. 77 | %% Subject is a term, but usually it is a number. 78 | %% `From' and `To' can be wrapped with the `open(_)' call. 79 | %% It meand, that this value is not inluded in the interval. 80 | %% 81 | %% `beetween(X, F, T)' is replaced with `((X =< F) andalso (X >= T))'. 82 | %% `beetween(X, open(F), T)' is replaced with `((X < F) andalso (X >= T))'. 83 | beetween_transform(Node) -> 84 | Pos = erl_syntax:get_pos(Node), 85 | %% Call it fore all new nodes. 86 | New = fun(NewNode) -> erl_syntax:set_pos(NewNode, Pos) end, 87 | %% Extract arguments of the `in' function. 88 | [SubjectForm, FromForm, ToForm] = 89 | erl_syntax:application_arguments(Node), 90 | GtEqOp = New(erl_syntax:operator(greater(is_open(FromForm)))), 91 | LoEqOp = New(erl_syntax:operator(less(is_open(ToForm)))), 92 | AndOp = New(erl_syntax:operator('andalso')), 93 | Exp1 = New(erl_syntax:infix_expr(SubjectForm, GtEqOp, clean_open(FromForm))), 94 | Exp2 = New(erl_syntax:infix_expr(SubjectForm, LoEqOp, clean_open(ToForm))), 95 | Exp3 = New(erl_syntax:infix_expr(Exp1, AndOp, Exp2)), 96 | GuardAST = New(erl_syntax:parentheses(Exp3)), 97 | erl_syntax:revert(GuardAST). 98 | 99 | 100 | %% @doc Returns an operator name. 101 | -spec less(IsExcluded) -> Op when 102 | IsExcluded :: boolean(), 103 | Op :: atom(). 104 | 105 | less(true) -> '<'; 106 | less(false) -> '=<'. 107 | 108 | 109 | -spec greater(IsExcluded) -> Op when 110 | IsExcluded :: boolean(), 111 | Op :: atom(). 112 | 113 | greater(true) -> '>'; 114 | greater(false) -> '>='. 115 | 116 | %% @doc Return true, if `Node' is wrapped by `open(_)'. 117 | is_open(Node) -> 118 | is_local_function(open, 1, Node). 119 | 120 | 121 | %% @doc Convert the call of `open(Body)' to `Body'. 122 | clean_open(Node) -> 123 | case is_open(Node) of 124 | true -> hd(erl_syntax:application_arguments(Node)); 125 | false -> Node 126 | end. 127 | 128 | 129 | foldl_functions(Fs) -> 130 | fun(Node) -> 131 | Apply = fun(F, N) -> F(N) end, 132 | lists:foldl(Apply, Node, Fs) 133 | end. 134 | 135 | 136 | local_function(FunName, FunArity, TransFun) -> 137 | fun(Node) -> 138 | IsFun = is_local_function(FunName, FunArity, Node), 139 | if IsFun -> TransFun(Node); 140 | true -> Node 141 | end 142 | end. 143 | 144 | %% @doc Return `true', `Node' is a function call of the `FunName/FunArity' function. 145 | is_local_function(FunName, FunArity, Node) -> 146 | erl_syntax:type(Node) =:= application 147 | andalso always(Op = erl_syntax:application_operator(Node)) 148 | andalso erl_syntax:type(Op) =:= atom 149 | andalso erl_syntax:atom_value(Op) =:= FunName 150 | andalso application_arity(Node) =:= FunArity. 151 | 152 | always(_) -> true. 153 | 154 | 155 | %% @doc Return arity of the called function inside `Node'. 156 | application_arity(Node) -> 157 | length(erl_syntax:application_arguments(Node)). 158 | -------------------------------------------------------------------------------- /src/hex.erl: -------------------------------------------------------------------------------- 1 | %%% vim:ts=4:sw=4:et 2 | %%%----------------------------------------------------------------------------- 3 | %%% @doc Hexadecimal conversion functions 4 | %%% @author Serge Aleynikov 5 | %%% @end 6 | %%%----------------------------------------------------------------------------- 7 | %%% Date: 2015-12-10 8 | %%%----------------------------------------------------------------------------- 9 | %%% Copyright (c) 2015 Serge Aleynikov 10 | %%% 11 | %%% Permission is hereby granted, free of charge, to any person 12 | %%% obtaining a copy of this software and associated documentation 13 | %%% files (the "Software"), to deal in the Software without restriction, 14 | %%% including without limitation the rights to use, copy, modify, merge, 15 | %%% publish, distribute, sublicense, and/or sell copies of the Software, 16 | %%% and to permit persons to whom the Software is furnished to do 17 | %%% so, subject to the following conditions: 18 | %%% 19 | %%% The above copyright notice and this permission notice shall be included 20 | %%% in all copies or substantial portions of the Software. 21 | %%% 22 | %%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 23 | %%% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 24 | %%% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 25 | %%% IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 26 | %%% CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 27 | %%% TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 28 | %%% SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 29 | %%%----------------------------------------------------------------------------- 30 | -module(hex). 31 | -author('saleyn@gmail.com'). 32 | 33 | -export([to_hex/1, to_bin/1, to_int/1]). 34 | -export([hex/1, dehex/1]). 35 | 36 | -ifdef(TEST). 37 | -include_lib("eunit/include/eunit.hrl"). 38 | -endif. 39 | 40 | %%%----------------------------------------------------------------------------- 41 | %%% External API 42 | %%%----------------------------------------------------------------------------- 43 | 44 | %% @doc Convert an iolist to a hex string. 45 | -spec to_hex(integer()|iolist()) -> binary(). 46 | to_hex(0) -> <<"0">>; 47 | to_hex(I) when is_integer(I), I > 0 -> to_hex_int(I, []); 48 | to_hex(L) when is_list(L) -> to_hex_bin(iolist_to_binary(L)); 49 | to_hex(B) when is_binary(B) -> to_hex_bin(B). 50 | 51 | %% @doc Convert a hex string to binary. 52 | -spec to_bin(string()) -> binary(). 53 | to_bin(Bin) when is_binary(Bin) -> 54 | << <<((dehex(A) bsl 4) bor dehex(B))>> || <> <= Bin >>; 55 | to_bin(L) when is_list(L) -> 56 | iolist_to_binary(to_bin2(L)). 57 | 58 | %% @doc Convert a hex string/binary to integer. 59 | -spec to_int(string()|binary()) -> integer(). 60 | to_int(S) when is_list(S) -> erlang:list_to_integer (S, 16); 61 | to_int(B) when is_binary(B) -> erlang:binary_to_integer(B, 16). 62 | 63 | %% @doc Convert a hex digit in range [$0..$9,$a..$f,$A..$F] to integer. 64 | -spec dehex(char()) -> integer(). 65 | dehex(C) when C >= $0, C =< $9 -> C - $0; 66 | dehex(C) when C >= $a, C =< $f -> C - ($a - 10); 67 | dehex(C) when C >= $A, C =< $F -> C - ($A - 10). 68 | 69 | %% @doc Convert an integer to a hex digit in range [0..15]. 70 | -spec hex(integer()) -> char(). 71 | hex(C) when C >= 0, C =< 9 -> C + $0; 72 | hex(C) when C =< 15 -> C + ($a - 10). 73 | 74 | %%%----------------------------------------------------------------------------- 75 | %%% Internal functions 76 | %%%----------------------------------------------------------------------------- 77 | 78 | to_bin2([A,B | T]) -> [((dehex(A) bsl 4) bor dehex(B)) | to_bin2(T)]; 79 | to_bin2([]) -> []. 80 | 81 | to_hex_bin(Bin) -> << <<(hex(A)), (hex(B))>> || <> <= Bin >>. 82 | 83 | to_hex_int(0, Acc) -> list_to_binary(Acc); 84 | to_hex_int(I, Acc) -> to_hex_int(I bsr 4, [hex(I band 15) | Acc]). 85 | 86 | %%%----------------------------------------------------------------------------- 87 | %%% Tests 88 | %%%----------------------------------------------------------------------------- 89 | 90 | -ifdef(EUNIT). 91 | 92 | all_test() -> 93 | <<"0">> = to_hex(0), 94 | <<"912ec803b2ce49e4a541068d495ab570">> = 95 | to_hex([145,46,200,3,178,206,73,228,165,65,6,141,73,90,181,112]), 96 | <<"fffefdfcfbfa1009080701">> = to_hex(16#fffefdfcfbfa1009080701), 97 | 98 | <<>> = to_bin(<<"0">>), 99 | <<0>> = to_bin("00"), 100 | <<0>> = to_bin(<<"00">>), 101 | <<255,254,253,252,251,250,16,9,8,7,1>> = to_bin(<<"fffefdfcfbfa1009080701">>), 102 | <<255,254,253,252,251,250,16,9,8,7,1>> = to_bin(<<"FFFEFDFCFBFA1009080701">>), 103 | 104 | 0 = to_int("0"), 105 | 0 = to_int(<<"0">>), 106 | 16#fffefdfcfbfa1009080701 = to_int("fffefdfcfbfa1009080701"), 107 | 16#fffefdfcfbfa1009080701 = to_int(<<"fffefdfcfbfa1009080701">>), 108 | ok. 109 | 110 | -endif. 111 | -------------------------------------------------------------------------------- /src/io_lib_pretty_limited.erl: -------------------------------------------------------------------------------- 1 | %% This file is part of erlyvideo open-source project: 2 | %% http://github.com/erlyvideo/erlyvideo/blob/master/apps/erlyvideo/src/core/io_lib_pretty_limited.erl 3 | -module(io_lib_pretty_limited). 4 | -author('Max Lapshin '). 5 | 6 | 7 | 8 | -export([print/2]). 9 | 10 | print(Term, Limit) -> 11 | print_term(<<>>, Term, Limit). 12 | 13 | print_term(_Out, _, Limit) when Limit < 0 -> 14 | <<"..">>; 15 | 16 | print_term(Out, Bin, Limit) when is_binary(Bin), size(Bin) >= Limit -> 17 | <>">>; 18 | 19 | print_term(Out, Bin, _Limit) when is_binary(Bin) -> 20 | <>; 21 | 22 | print_term(Out, Term, _Limit) when 23 | is_atom(Term); is_reference(Term); is_port(Term); is_function(Term); is_number(Term); is_pid(Term) -> 24 | <>; 25 | 26 | print_term(Out, Atom, _Limit) when is_atom(Atom) -> 27 | <>; 28 | 29 | print_term(Out, Term, Limit) when is_list(Term) -> 30 | case io_lib:printable_list(Term) of 31 | true -> print_printable_list(Out, Term, Limit); 32 | false -> print_list(<>, Term, <<"]">>, Limit) 33 | end; 34 | 35 | print_term(Out, Term, Limit) when is_tuple(Term) -> 36 | print_list(<>, tuple_to_list(Term), <<"}">>, Limit). 37 | 38 | 39 | print_printable_list(Out, String, Limit) when length(String) > Limit - 4 -> 40 | print_printable_list(Out, lists:sublist(String, Limit - 4), Limit); 41 | 42 | print_printable_list(Out, String, _) -> 43 | append_characters(<>, String). 44 | 45 | append_characters(Out, []) -> <>; 46 | append_characters(Out, [$"|String]) -> append_characters(<>, String); 47 | append_characters(Out, [C|String]) -> append_characters(<>, String). 48 | 49 | 50 | 51 | print_list(Out, _, End, Limit) when size(Out) > Limit -> 52 | <>; 53 | print_list(Out, [], End, _Limit) -> 54 | <>; 55 | print_list(Out, [Term], End, Limit) -> 56 | <>, Term, Limit - size(Out)))/binary, End/binary>>; 57 | print_list(Out, [Term|List], End, Limit) -> 58 | print_list(<>, Term, Limit - size(Out)))/binary, ",">>, List, End, Limit). 59 | 60 | 61 | -include_lib("eunit/include/eunit.hrl"). 62 | 63 | 64 | error_formatter_test() -> 65 | ?assertEqual(<<"{a,\"a\\\"a\",5,<<\"z\">>}">>, print({a,"a\"a", 5, <<"z">>}, 40)). 66 | 67 | -------------------------------------------------------------------------------- /src/listx.erl: -------------------------------------------------------------------------------- 1 | %%%----------------------------------------------------------------------------- 2 | %%% @doc Miscelaneous list functions 3 | %%% @author Serge Aleynikov 4 | %%% @end 5 | %%%----------------------------------------------------------------------------- 6 | %%% Copyright (c) 2015 Serge Aleynikov 7 | %%% 8 | %%% Permission is hereby granted, free of charge, to any person 9 | %%% obtaining a copy of this software and associated documentation 10 | %%% files (the "Software"), to deal in the Software without restriction, 11 | %%% including without limitation the rights to use, copy, modify, merge, 12 | %%% publish, distribute, sublicense, and/or sell copies of the Software, 13 | %%% and to permit persons to whom the Software is furnished to do 14 | %%% so, subject to the following conditions: 15 | %%% 16 | %%% The above copyright notice and this permission notice shall be included 17 | %%% in all copies or substantial portions of the Software. 18 | %%% 19 | %%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 20 | %%% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 21 | %%% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 22 | %%% IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 23 | %%% CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 24 | %%% TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 25 | %%% SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 26 | %%%----------------------------------------------------------------------------- 27 | -module(listx). 28 | 29 | -export([group/2, copy_tuple_except/5, sum/1, sum/2, zip_record/2]). 30 | 31 | -ifdef(TEST). 32 | -include_lib("eunit/include/eunit.hrl"). 33 | -endif. 34 | 35 | %%%----------------------------------------------------------------------------- 36 | %%% API 37 | %%%----------------------------------------------------------------------------- 38 | 39 | %% @doc Group elements in the `List' by element at position `Pos'. 40 | -spec group(Pos::integer(), List::[tuple()]) -> [{any(), tuple()}]. 41 | group(Pos, List) when is_integer(Pos), is_list(List) -> 42 | lists:foldl(fun(T, A) when is_tuple(T), tuple_size(T) >= Pos -> 43 | TT0 = erlang:make_tuple(tuple_size(T)-1, undefined), 44 | TT = copy_tuple_except(Pos, 1, tuple_size(T), T, TT0), 45 | Key = element(Pos, T), 46 | Old = maps:get(Key, A, []), 47 | A#{Key => [TT | Old]} 48 | end, #{}, List). 49 | 50 | %% @doc Add every positional element of each tuple in the list. 51 | %% E.g. `sum([{1,2}, {3,4}, {5,6}]) -> {9,12}.' 52 | sum(ListOfTuples = [H|_]) when is_tuple(H) -> 53 | suml(ListOfTuples, erlang:make_tuple(tuple_size(H), 0)). 54 | 55 | %% @doc Add every positional element of two tuples. 56 | %% E.g. `sum({1,2}, {3,4}) -> {3,6}.' 57 | sum(Tuple1, Tuple2) when tuple_size(Tuple1) =:= tuple_size(Tuple2) -> 58 | sum(1, tuple_size(Tuple1)+1, Tuple1, Tuple2). 59 | 60 | %%%----------------------------------------------------------------------------- 61 | %%% Internal functions 62 | %%%----------------------------------------------------------------------------- 63 | 64 | %% @doc Copy every element of tuple TS to tuple TT ignoring the item at 65 | %% Ignore position 66 | copy_tuple_except(_Ignore, I, N,_TS, TT) when I > N -> TT; 67 | copy_tuple_except(I, I, N, TS, TT) -> copy_tuple_except(I, I+1, N, TS, TT); 68 | copy_tuple_except(Ignore, I, N, TS, TT) when Ignore > I -> 69 | copy_tuple_except(Ignore, I+1, N, TS, setelement(I, TT, element(I, TS))); 70 | copy_tuple_except(Ignore, I, N, TS, TT) -> % Ignore < I 71 | copy_tuple_except(Ignore, I+1, N, TS, setelement(I-1, TT, element(I, TS))). 72 | 73 | suml([H|T], Acc) when tuple_size(H) =:= tuple_size(Acc) -> 74 | suml(T, sum(1,tuple_size(Acc)+1,H,Acc)); 75 | suml([], Acc) -> 76 | Acc. 77 | 78 | sum(N,N,_,Acc) -> Acc; 79 | sum(I,N,H,Acc) -> sum(I+1,N,H,setelement(I, Acc, element(I, H) + element(I, Acc))). 80 | 81 | %% @doc Convert a record/tuple to a list of `{Name,Value}' pairs, where `Name' 82 | %% is a field name taken from the `Fields' list. 83 | -spec zip_record(list(), tuple()) -> list(). 84 | zip_record(Fields, State) when is_list(Fields), tuple_size(State) =:= length(Fields)+1 -> 85 | Vals = tl(tuple_to_list(State)), 86 | lists:zip(Fields, Vals). 87 | 88 | %%%----------------------------------------------------------------------------- 89 | %%% Unit Tests 90 | %%%----------------------------------------------------------------------------- 91 | 92 | -ifdef(EUNIT). 93 | 94 | group_test() -> 95 | ?assertEqual( 96 | #{a => [{11,13},{10,12}],b => [{15,16},{30,60}],c => [{10,15}]}, 97 | group(1, [{a, 10, 12}, {a, 11, 13}, {b, 30, 60}, {b, 15, 16}, {c, 10, 15}])), 98 | 99 | ?assertEqual( 100 | #{a => [{11,13},{10,12}],b => [{15,16},{30,60}],c => [{15}]}, 101 | group(1, [{a, 10, 12}, {a, 11, 13}, {b, 30, 60}, {b, 15, 16}, {c, 15}])), 102 | 103 | ?assertEqual( 104 | #{a => [{11,13},{10,12}],b => [{15,16},{30,60}],c => [{}]}, 105 | group(1, [{a, 10, 12}, {a, 11, 13}, {b, 30, 60}, {b, 15, 16}, {c}])). 106 | 107 | sum_test() -> 108 | ?assertEqual({4,6}, sum({1,2}, {3,4})), 109 | ?assertEqual({9,12}, sum([{1,2}, {3,4}, {5,6}])), 110 | ?assertEqual({6}, sum([{1}, {2}, {3}])), 111 | ?assertEqual({9,12,12}, sum([{1,2,3}, {3,4,4}, {5,6,5}])). 112 | 113 | -endif. 114 | -------------------------------------------------------------------------------- /src/osx.erl: -------------------------------------------------------------------------------- 1 | %%% vim:ts=4:sw=4:et 2 | %%%----------------------------------------------------------------------------- 3 | %%% @doc OS supporting commands 4 | %%% @author Serge Aleynikov 5 | %%% @end 6 | %%%----------------------------------------------------------------------------- 7 | %%% Date: 2015-12-10 8 | %%%----------------------------------------------------------------------------- 9 | %%% Copyright (c) 2015 Serge Aleynikov 10 | %%% 11 | %%% Permission is hereby granted, free of charge, to any person 12 | %%% obtaining a copy of this software and associated documentation 13 | %%% files (the "Software"), to deal in the Software without restriction, 14 | %%% including without limitation the rights to use, copy, modify, merge, 15 | %%% publish, distribute, sublicense, and/or sell copies of the Software, 16 | %%% and to permit persons to whom the Software is furnished to do 17 | %%% so, subject to the following conditions: 18 | %%% 19 | %%% The above copyright notice and this permission notice shall be included 20 | %%% in all copies or substantial portions of the Software. 21 | %%% 22 | %%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 23 | %%% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 24 | %%% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 25 | %%% IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 26 | %%% CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 27 | %%% TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 28 | %%% SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 29 | %%%----------------------------------------------------------------------------- 30 | -module(osx). 31 | -author('saleyn@gmail.com'). 32 | 33 | -export([command/1, command/2, command/3, status/1]). 34 | -export([realpath/1, normalpath/1]). 35 | 36 | -ifdef(TEST). 37 | -include_lib("eunit/include/eunit.hrl"). 38 | -endif. 39 | 40 | %%%----------------------------------------------------------------------------- 41 | %%% External API 42 | %%%----------------------------------------------------------------------------- 43 | 44 | -spec command(string()) -> {integer(), list()}. 45 | command(Cmd) -> 46 | command(Cmd, [], undefined). 47 | 48 | -spec command(string(), list()|undefined|fun((list(),any()) -> any())) -> 49 | {integer(), any()}. 50 | command(Cmd, Fun) when is_function(Fun, 2) -> 51 | command(Cmd, [], Fun); 52 | command(Cmd, Opt) when is_list(Opt) -> 53 | command(Cmd, Opt, undefined). 54 | 55 | -spec command(string(), list(), undefined|fun((list(),any()) -> any())) -> 56 | {integer(), any()}. 57 | command(Cmd, Opt, Fun) when is_list(Opt) -> 58 | command(Cmd, Opt, Fun, 600000). 59 | 60 | -spec command(string(), list(), undefined|fun((list(),any()) -> any()), integer()) -> 61 | {integer(), any()}. 62 | command(Cmd, Opt, Fun, Timeout) when is_list(Opt) 63 | , (Fun=:=undefined orelse is_function(Fun, 2)) 64 | , (is_integer(Timeout) orelse Timeout==infinity) -> 65 | Opts = Opt ++ [stream, exit_status, use_stdio, in, hide, eof], 66 | P = open_port({spawn, Cmd}, Opts), 67 | Ref = erlang:monitor(port, P), 68 | Res = get_data(P, Fun, [], Ref, Timeout), 69 | _ = demonitor(Ref, [flush]), 70 | Res. 71 | 72 | -spec status(integer()) -> 73 | {status, ExitStatus :: integer()} | 74 | {signal, Singnal :: integer(), Core :: boolean()}. 75 | status(Status) when is_integer(Status) -> 76 | TermSignal = Status band 16#7F, 77 | IfSignaled = ((TermSignal + 1) bsr 1) > 0, 78 | ExitStatus = (Status band 16#FF00) bsr 8, 79 | case IfSignaled of 80 | true -> 81 | CoreDump = (Status band 16#80) =:= 16#80, 82 | {signal, TermSignal, CoreDump}; 83 | false -> 84 | {status, ExitStatus} 85 | end. 86 | 87 | %%%----------------------------------------------------------------------------- 88 | %%% Internal functions 89 | %%%----------------------------------------------------------------------------- 90 | get_data(P, Fun, D, Ref, Timeout) -> 91 | receive 92 | {P, {data, {eol, Line}}} when Fun =:= undefined -> 93 | get_data(P, Fun, [Line|D], Ref, Timeout); 94 | {P, {data, {eol, Line}}} when is_function(Fun, 2) -> 95 | get_data(P, Fun, Fun(eol, {Line, D}), Ref, Timeout); 96 | {P, {data, {noeol, Line}}} when Fun =:= undefined -> 97 | get_data(P, Fun, [Line|D], Ref, Timeout); 98 | {P, {data, {noeol, Line}}} when is_function(Fun, 2) -> 99 | get_data(P, Fun, Fun(noeol, {Line, D}), Ref, Timeout); 100 | {P, {data, D1}} when Fun =:= undefined -> 101 | get_data(P, Fun, [D1|D], Ref, Timeout); 102 | {P, {data, D1}} when is_function(Fun, 2) -> 103 | get_data(P, Fun, Fun(data, {D1, D}), Ref, Timeout); 104 | {P, eof} -> 105 | catch port_close(P), 106 | flush_until_down(P, Ref), 107 | receive 108 | {P, {exit_status, 0}} when is_function(Fun, 2) -> 109 | {ok, Fun(eof, D)}; 110 | {P, {exit_status, N}} when is_function(Fun, 2) -> 111 | {error, {N, Fun(eof, D)}}; 112 | {P, {exit_status, 0}} -> 113 | {ok, lists:reverse(D)}; 114 | {P, {exit_status, N}} -> 115 | {error, {N, lists:reverse(D)}} 116 | after 5000 -> 117 | if is_function(Fun, 2) -> 118 | throw({no_exit_status, Fun(eof, D)}); 119 | true -> 120 | throw({no_exit_status, timeout_waiting_for_output}) 121 | end 122 | end; 123 | {'DOWN', Ref, _, _, Reason} -> 124 | flush_exit(P), 125 | exit({error, Reason, lists:flatten(lists:reverse(D))}) 126 | after Timeout -> 127 | exit(timeout) 128 | end. 129 | 130 | %% @doc 131 | %% Return a canonicalized pathname, having resolved symlinks to their 132 | %% destination. Modelled on realpath(3). 133 | %% @end 134 | %% Derived from https://github.com/mk270/realpath 135 | %% Copyright 2020 Martin Keegan 136 | -spec realpath(string()) -> string(). 137 | realpath(Path) when is_list(Path) -> 138 | check_canonical(Path, 20); 139 | realpath(Path) when is_binary(Path) -> 140 | list_to_binary(realpath(binary_to_list(Path))). 141 | 142 | check_canonical(S, TTL) -> 143 | Fragments = make_fragments(S), 144 | check_fragments(Fragments, [], TTL). 145 | 146 | check_fragments(_, _, 0) -> 147 | throw(loop_detected); 148 | check_fragments([], AlreadyChecked, _) -> 149 | AlreadyChecked; 150 | check_fragments([Head|Tail], AlreadyChecked, TTL) -> 151 | case is_symlink(AlreadyChecked, Head) of 152 | false -> 153 | check_fragments(Tail, filename:join(AlreadyChecked, Head), TTL); 154 | {true, Referent} -> 155 | TailJoined = join_non_null(Tail), 156 | AllJoined = filename:join(Referent, TailJoined), 157 | check_canonical(AllJoined, TTL - 1) 158 | end. 159 | 160 | is_symlink(Dirname, Basename) -> 161 | Path = filename:join(Dirname, Basename), 162 | case file:read_link(Path) of 163 | {ok, Name} -> 164 | case Name of 165 | % absolute link 166 | [$/|_] -> {true, Name}; 167 | 168 | % relative link 169 | _ -> 170 | {true, filename:join(Dirname, Name)} 171 | end; 172 | _ -> 173 | false 174 | end. 175 | 176 | make_fragments(S) -> 177 | filename:split(S). 178 | 179 | join_non_null([]) -> ""; 180 | join_non_null(SS) -> filename:join(SS). 181 | 182 | %% @doc 183 | %% Return a path where the use of ".." to indicate parent directory has 184 | %% been resolved. Currently does not accept relative paths. 185 | %% @end 186 | %% Derived from https://github.com/mk270/realpath 187 | %% Copyright 2020 Martin Keegan 188 | -spec normalpath(list()) -> string(). 189 | normalpath(S=[$/|_]) when is_list(S)-> 190 | normalpath2(S); 191 | normalpath(S) when is_list(S) -> 192 | normalpath2(filename:absname(S)); 193 | normalpath(B) when is_binary(B) -> 194 | list_to_binary(normalpath(binary_to_list(B))). 195 | 196 | normalpath2(S) when is_list(S) -> 197 | Parts = filename:split(S), 198 | filename:join(lists:reverse(normalize(Parts, []))). 199 | 200 | normalize([], Path) -> 201 | Path; 202 | normalize([".."|T], Path) -> 203 | {_H, Rest} = pop(Path), 204 | normalize(T, Rest); 205 | normalize([H|T], Path) -> 206 | Rest = push(H, Path), 207 | normalize(T, Rest). 208 | 209 | pop([]) -> {"/", []}; 210 | pop(["/"]) -> {"/", ["/"]}; 211 | pop([H|T]) -> {H,T}. 212 | push(H,T) -> [H|T]. 213 | 214 | flush_until_down(Port, MonRef) -> 215 | receive 216 | {Port, {data, _Bytes}} -> 217 | flush_until_down(Port, MonRef); 218 | {'DOWN', MonRef, _, _, _} -> 219 | flush_exit(Port) 220 | end. 221 | 222 | %% The exit signal is always delivered before 223 | %% the down signal, so try to clean up the mailbox. 224 | flush_exit(Port) -> 225 | receive {'EXIT', Port, _} -> ok 226 | after 0 -> ok 227 | end. 228 | 229 | %%%----------------------------------------------------------------------------- 230 | %%% Tests 231 | %%%----------------------------------------------------------------------------- 232 | 233 | -ifdef(EUNIT). 234 | 235 | command_test() -> 236 | {ok, ["ok\n"]} = osx:command("echo ok"), 237 | {error, {1, ""}} = osx:command("false"), 238 | {ok, ok} = osx:command("echo ok", fun(data, {"ok\n", []}) -> []; (eof, []) -> ok end), 239 | {ok,["a","b","c"]} = osx:command("echo -en 'a\nb\nc\n'", [{line, 80}]), 240 | %{error, {143,[]}} = osx:command("kill $$"), 241 | {signal,15,true} = status(143), 242 | {status,0} = status(0), 243 | ok. 244 | 245 | make_fragments_test_data() -> 246 | [{"/usr/local/bin", ["/", "usr", "local", "bin"]}, 247 | {"usr/local/bin/bash", ["usr", "local", "bin", "bash"]}, 248 | {"/usr/local/bin/", ["/", "usr", "local", "bin"]}]. 249 | 250 | make_fragments_test_() -> 251 | [ ?_assertEqual(Expected, make_fragments(Observed)) 252 | || {Observed, Expected} <- make_fragments_test_data() ]. 253 | 254 | -endif. 255 | -------------------------------------------------------------------------------- /src/pcap.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------------ 2 | %%% @doc PCAP file reader/writer. 3 | %%% @author Serge Aleynikov 4 | %%% @end 5 | %%%------------------------------------------------------------------------ 6 | %%% Copyright (c) 2010 Serge Aleynikov 7 | %%% 8 | %%% Permission is hereby granted, free of charge, to any person 9 | %%% obtaining a copy of this software and associated documentation 10 | %%% files (the "Software"), to deal in the Software without restriction, 11 | %%% including without limitation the rights to use, copy, modify, merge, 12 | %%% publish, distribute, sublicense, and/or sell copies of the Software, 13 | %%% and to permit persons to whom the Software is furnished to do 14 | %%% so, subject to the following conditions: 15 | %%% 16 | %%% The above copyright notice and this permission notice shall be included 17 | %%% in all copies or substantial portions of the Software. 18 | %%% 19 | %%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 20 | %%% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 21 | %%% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 22 | %%% IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 23 | %%% CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 24 | %%% TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 25 | %%% SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 26 | %%%------------------------------------------------------------------------ 27 | -module(pcap). 28 | 29 | -export([ 30 | write/2, replay/1, replay/2, replay/5 31 | , replay_range/3, replay_range/4 32 | ]). 33 | 34 | write_header(File) -> 35 | file:write(File, 36 | <<16#a1b2c3d4:32/native, 2:16/native, 4:16/native, 0:32/native, 37 | 0:32/native, 65535:32/native, 1:32/native>>). 38 | 39 | write_packet_header(File, Len) -> 40 | LenEx = Len + 42, 41 | file:write(File, <<0:32, 0:32, LenEx:32/native, LenEx:32/native>>). 42 | 43 | write_udp_frame(File) -> 44 | % Eth frame 45 | file:write(File, list_to_binary(lists:duplicate(14,0))), 46 | % IP frame (IPPROTO_UDP = 17) 47 | IP = <<0,0,0,0,0,0,0,0,0,17,0,0,0,0,0,0,0,0,0,0>>, 48 | file:write(File, IP), 49 | % UDP frame 50 | file:write(File, list_to_binary(lists:duplicate(8,0))). 51 | 52 | write(Filename, Packet) when is_list(Filename), is_binary(Packet) -> 53 | {ok, File} = file:open(Filename, [write, raw, binary]), 54 | ok = write_header(File), 55 | ok = write_packet_header(File, size(Packet)), 56 | ok = write_udp_frame(File), 57 | ok = file:write(File, Packet), 58 | file:close(File). 59 | 60 | replay_range(Filename, FromN, ToN) 61 | when is_list(Filename), is_integer(FromN) -> 62 | replay_range(Filename, undefined, FromN, ToN). 63 | 64 | replay_range(Filename, Address, FromN, ToN) 65 | when is_list(Filename), is_integer(FromN) -> 66 | replay(Filename, Address, undefined, FromN, ToN). 67 | 68 | replay(Filename) when is_list(Filename) -> 69 | replay(Filename, undefined). 70 | replay(Filename, Address) when is_list(Filename), is_list(Address) -> 71 | replay(Filename, Address, undefined, 0, undefined). 72 | replay(Filename, Address, Port, FromN, ToN) 73 | when is_list(Filename), is_list(Address) 74 | , is_integer(FromN), FromN < ToN 75 | -> 76 | {ok, File} = file:open(Filename, [read, raw, binary]), 77 | Endian = 78 | case file:read(File, 24) of 79 | {ok, <>} when I =:= 16#a1b2c3d4 -> 80 | big; 81 | {ok, <>} when I =:= 16#d4c3b2a1 -> 82 | little; 83 | {error, Why} -> 84 | throw(file:format_error(Why)) 85 | end, 86 | {ok, S} = gen_udp:open(0, [binary, {sndbuf, 1024*1024*16}]), 87 | replay_loop(Endian, File, S, parse_address(Address), Port, FromN, ToN). 88 | 89 | parse_address(undefined) -> 90 | undefined; 91 | parse_address(A = {_,_,_,_}) -> 92 | A; 93 | parse_address(A) when is_list(A) -> 94 | {ok, T} = inet_parse:address(A), 95 | T. 96 | 97 | replay_loop(_Endian, _File, _Sock, _Addr, _Port, N, N) -> 98 | ok; 99 | replay_loop(Endian, File, Sock, Addr, Port, I, N) -> 100 | case {read_packet(File, Endian), Addr, Port} of 101 | {eof, _, _} -> 102 | ok; 103 | {{Packet, DAddr, DPort}, undefined, undefined} when is_binary(Packet) -> 104 | gen_udp:send(Sock, DAddr, DPort, Packet), 105 | replay_loop(Endian, File, Sock, DAddr, DPort, I+1, N); 106 | {{Packet, _DAddr, DPort}, _, undefined} when is_binary(Packet) -> 107 | gen_udp:send(Sock, Addr, DPort, Packet), 108 | replay_loop(Endian, File, Sock, Addr, Port, I+1, N); 109 | {{Packet, _DAddr, _DPort}, _, _} when is_binary(Packet) -> 110 | gen_udp:send(Sock, Addr, Port, Packet), 111 | replay_loop(Endian, File, Sock, Addr, Port, I+1, N) 112 | end. 113 | 114 | read_packet(File, Endian) -> 115 | case file:read(File, 16+42) of 116 | {ok, <<_:32, _:32, Len:32/little, _:32, _Eth:14/binary, _Ip:12/binary, 117 | _SrcIp:32, DstIp:4/binary, _SrcPort:16, DstPort:16, _:4/binary>>} when Endian =:= little -> 118 | {ok, Packet} = file:read(File, Len-42), 119 | {Packet, decode_ip(DstIp), DstPort}; 120 | {ok, <<_:32, _:32, Len:32/little, _:32, _Eth:14/binary, _Ip:12/binary, 121 | _SrcIp:32, DstIp:4/binary, _SrcPort:16, DstPort:16, _:4/binary>>} when Endian =:= big -> 122 | {ok, Packet} = file:read(File, Len-42), 123 | {Packet, decode_ip(DstIp), DstPort}; 124 | _Other -> 125 | eof 126 | end. 127 | 128 | decode_ip(<>) -> {I1, I2, I3, I4}. 129 | -------------------------------------------------------------------------------- /src/pmap.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------------ 2 | %%% File: $Id$ 3 | %%%------------------------------------------------------------------------ 4 | %%% @doc Parallel map and multicall. 5 | %%% 6 | %%% @author Serge Aleynikov (multicall) 7 | %%% Luke Gorries (http://lukego.livejournal.com) (pmap) 8 | %%% @version $Rev$ 9 | %%% $Date: 2008/07/02 03:29:58 $ 10 | %%% @end 11 | %%% 12 | %%%------------------------------------------------------------------------ 13 | %%% Created: 2008/02/11 10:07:15 14 | %%%------------------------------------------------------------------------ 15 | -module(pmap). 16 | -author('saleyn@gmail.com'). 17 | -id ("$Id$"). 18 | 19 | -export([pmap/2, pmap/3, multicall/2, reply/2]). 20 | 21 | -ifdef(DEBUG). 22 | -export([test/0, test1/0, test2/0, test3/0]). 23 | -endif. 24 | 25 | %%------------------------------------------------------------------------- 26 | %% @doc Evaluate the `MultiArgs' list by calling `F' on each argument in 27 | %% the list concurrently. 28 | %% @see pmap/3 29 | %% @end 30 | %%------------------------------------------------------------------------- 31 | -spec pmap(fun(() -> term()), [Args::term()]) -> [Reply::term()]. 32 | pmap(F, List) -> 33 | pmap(F, List, infinity). 34 | 35 | %%------------------------------------------------------------------------- 36 | %% @doc Evaluate the `MultiArgs' list by calling `F' on each argument in 37 | %% the list concurrently. Same as pmap/2 but has a `Timeout' option. 38 | %% @end 39 | %%------------------------------------------------------------------------- 40 | -spec pmap(fun((term()) -> term()), Args::[term()], integer()|infinity) -> [Reply::term()]. 41 | pmap(F, List, Timeout) -> 42 | Ref = make_ref(), 43 | [wait_result(Ref, Worker, Timeout) || Worker <- [spawn_worker(self(),Ref,F,E) || E <- List]]. 44 | 45 | spawn_worker(Parent, Ref, F, E) -> 46 | erlang:spawn_monitor(fun() -> reply({Parent, Ref}, F(E)) end). 47 | 48 | wait_result(Ref, {Pid,MonRef}, Timeout) -> 49 | receive 50 | {'DOWN', MonRef, _, _, normal} -> 51 | receive 52 | {{Pid, Ref}, Result} -> 53 | Result 54 | after Timeout -> 55 | {error, timeout} 56 | end; 57 | {'DOWN', MonRef, _, _, Reason} -> 58 | {error, Reason} 59 | end. 60 | 61 | %%------------------------------------------------------------------------- 62 | %% @doc Send messages to pids and wait for replies. 63 | %% Each Pid would get a message in the form: 64 | %% `{{FromPid, Ref}, Msg}' and would have to reply with: 65 | %% `FromPid ! {{self(), Ref}, Reply}'. The function aggregates all 66 | %% replies into `Success' and `Error' lists. The error list is in the 67 | %% form: `{Pid, ErrorReason}'. 68 | %% @end 69 | %%------------------------------------------------------------------------- 70 | -spec multicall([{pid(), term()}], Timeout::timeout()) -> {[OkReply::term()], [ErrorReply::term()]}. 71 | multicall([], _Timeout) -> 72 | {[], []}; 73 | multicall(PidMsgs, Timeout) when is_list(PidMsgs) -> 74 | Ref = make_ref(), 75 | Fun = fun(_) -> 76 | {Refs, Errors, Monitors} = lists:foldl( 77 | fun({Pid, Msg}, {Refs, Err, Mons}) -> 78 | case node(Pid) =/= node() orelse erlang:is_process_alive(Pid) of 79 | true -> 80 | reply({Pid, Ref}, Msg), 81 | MonRef = erlang:monitor(process, Pid), 82 | {gb_sets:add({Pid, Ref}, Refs), Err, [{MonRef, Pid} | Mons]}; 83 | false -> 84 | {Refs, [{Pid, {error, no_process}} | Err], Mons} 85 | end 86 | end, 87 | {gb_sets:empty(), [], []}, 88 | PidMsgs), 89 | 90 | gather_results(Refs, [], Errors, Monitors, Timeout) 91 | end, 92 | lists:foldl( 93 | fun({Ok, Err}, {AccOk, AccErr}) -> 94 | {Ok ++ AccOk, Err ++ AccErr}; 95 | (Other, _Acc) -> 96 | erlang:error({?MODULE, unexpected_result, Other}) 97 | end, 98 | {[], []}, 99 | pmap(Fun, [[]], Timeout) 100 | ). 101 | 102 | gather_results({0,nil}, Replies, Errors, _Monitors, _Timeout) -> 103 | {lists:reverse(Replies), Errors}; 104 | gather_results(Set, Replies, Errors, Monitors, Timeout) -> 105 | receive 106 | {{Pid, Ref}, Result} -> 107 | try 108 | NewSet = gb_sets:delete({Pid, Ref}, Set), 109 | gather_results(NewSet, [{Pid, Result} | Replies], Errors, Monitors, Timeout) 110 | catch _:_ -> 111 | gather_results(Set, Replies, Errors, Monitors, Timeout) 112 | end; 113 | {'DOWN', _MonRef, _, _, normal} -> 114 | % Ideally we'd have to remove the _MonRef from the Monitors list, 115 | % but since the multicall/2 call is executed in its own process (via pmap call) 116 | % at the end of this multicall all monitors are cleaned up as the process dies. 117 | gather_results(Set, Replies, Errors, Monitors, Timeout); 118 | {'DOWN', MonRef, _, _, Reason} -> 119 | case lists:keytake(MonRef, 1, Monitors) of 120 | {value, {_, Pid}, NewMonitors} -> 121 | NewSet = gb_sets:filter(fun({P, _}) -> P =/= Pid end, Set), 122 | gather_results(NewSet, Replies, 123 | [{Pid, {error, {process_disconnected, Reason}}} | Errors], 124 | NewMonitors, Timeout); 125 | false -> 126 | gather_results(Set, Replies, Errors, Monitors, Timeout) 127 | end 128 | after Timeout -> 129 | {Replies, gb_sets:fold(fun({Pid, _}, Acc) -> [{Pid, {error, timeout}} | Acc] end, [], Set) ++ Errors} 130 | end. 131 | 132 | %%------------------------------------------------------------------------- 133 | %% @doc Send a reply back to sender. 134 | %% @end 135 | %%------------------------------------------------------------------------- 136 | -spec reply({pid(), reference()}, Reply::term()) -> ok. 137 | reply({FromPid, Ref}, Msg) -> 138 | catch FromPid ! {{self(), Ref}, Msg}, 139 | ok. 140 | 141 | %%%------------------------------------------------------------------------ 142 | %%% TEST CASES 143 | %%%------------------------------------------------------------------------ 144 | 145 | -ifdef(DEBUG). 146 | test() -> 147 | Expected = lists:seq(1, 20), 148 | F = fun() -> receive {{_Pid, _Ref} = From, Msg} -> pmap:reply(From, Msg) end end, 149 | Msgs = [{spawn(F), I} || I <- Expected], 150 | {Oks, []} = pmap:multicall(Msgs, 10000), 151 | Expected = lists:sort([I || {_Pid, I} <- Oks]). 152 | 153 | test1() -> 154 | F = fun() -> 155 | receive 156 | {_From, {_I, X}} when X == 3 -> 157 | timer:sleep(1000), 158 | exit(killed); 159 | {{From, Ref}, {I, _X}} -> 160 | From ! {{self(), Ref}, I}, 161 | timer:sleep(2000) 162 | end 163 | end, 164 | {A,B,C}=now(), random:seed(A,B,C), 165 | Msgs = [{spawn(F), {I, random:uniform(3)}} || I <- lists:seq(1, 20)], 166 | pmap:multicall(Msgs, 10000). 167 | 168 | test2() -> 169 | [1,4,9,16,25] = pmap:pmap(fun(I) -> I*I end, [I || I <- lists:seq(1,5)]). 170 | 171 | test3() -> 172 | F = fun() -> receive {{From, Ref}, Msg} -> timer:sleep(2000), From ! {{self(), Ref}, Msg}, timer:sleep(1000) end end, 173 | Msgs = [{spawn(F), I} || I <- lists:seq(1, 5)], 174 | multicall(Msgs, 1000). 175 | 176 | -endif. 177 | -------------------------------------------------------------------------------- /src/prof.erl: -------------------------------------------------------------------------------- 1 | %%% vim:ts=4:sw=4:et 2 | %%%---------------------------------------------------------------------------- 3 | %%% @doc Profiling functions 4 | %%% @author Serge Aleynikov 5 | %%% @copyright 2015 Serge Aleynikov 6 | %%% @end 7 | %%%---------------------------------------------------------------------------- 8 | %%% Created: 2015-05-13 9 | %%%---------------------------------------------------------------------------- 10 | -module(prof). 11 | -author('saleyn@gmail.com'). 12 | 13 | %% API 14 | -export([start/1, stop/0]). 15 | -export([apply/2, apply/3]). 16 | 17 | %%%---------------------------------------------------------------------------- 18 | %%% External API 19 | %%%---------------------------------------------------------------------------- 20 | 21 | %%----------------------------------------------------------------------------- 22 | %% @doc Begin profiling a list of pids 23 | %% @end 24 | %%----------------------------------------------------------------------------- 25 | -spec start([pid() | atom()]) -> ok. 26 | start(Pids) when is_list(Pids) -> 27 | fprof:trace([start, {procs, Pids}]). 28 | 29 | %%----------------------------------------------------------------------------- 30 | %% @doc Finish profiling a list of pids and save results to a file called 31 | %% `"fprof.analysis"'. 32 | %% @end 33 | %%----------------------------------------------------------------------------- 34 | -spec stop() -> ok. 35 | stop() -> 36 | fprof:trace([stop]), 37 | fprof:profile(), 38 | fprot:analyse([totals, {dest, "fprof.analysis"}]), 39 | fprof:stop(). 40 | 41 | %%----------------------------------------------------------------------------- 42 | %% @doc Run a function analysis and save it to `"fprof-apply.analysis"'. 43 | %% @end 44 | %%----------------------------------------------------------------------------- 45 | apply(Fun, Args) when is_list(Args) -> 46 | fprof:apply(Fun, Args), 47 | fprop:profile(), 48 | fprof:analyse([{dest, "fprof-apply.analysis"}]), 49 | fprof:stop(). 50 | 51 | %%----------------------------------------------------------------------------- 52 | %% @doc Run a function analysis and save it to `"fprof-apply.analysis"'. 53 | %% @end 54 | %%----------------------------------------------------------------------------- 55 | apply(M, F, Args) when is_atom(M), is_atom(F), is_list(Args) -> 56 | fprof:apply(M, F, Args), 57 | fprop:profile(), 58 | fprof:analyse([{dest, "fprof-apply.analysis"}]), 59 | fprof:stop(). 60 | 61 | %%%---------------------------------------------------------------------------- 62 | %%% Internal functions 63 | %%%---------------------------------------------------------------------------- 64 | -------------------------------------------------------------------------------- /src/restrict_remsh_mod.erl: -------------------------------------------------------------------------------- 1 | %% @doc Sample restricted remote shell module disabling `c:q/0' and 2 | %% `init:stop/{0,1}' commands. The shell introduces a replacement command 3 | %% to stop remote node: `remote_node_stop/1' equivalent to `init:stop/1'. 4 | %% 5 | %% To activate restricted shell, run the server node like this: 6 | %% `erl -sname node@host +Bi -shell restricted_shell restrict_remsh_mod' 7 | %% 8 | %% Then you can connect to it with: 9 | %% `erl -sname a@myhost -remsh node@host' 10 | %% 11 | %% See: [http://www.erlang.org/doc/man/shell.html#start_restricted-1] 12 | -module(restrict_remsh_mod). 13 | -author('saleyn@gmail.com'). 14 | 15 | %% Restricted shell callbacks 16 | -export([local_allowed/3, non_local_allowed/3]). 17 | 18 | %% Internal API 19 | -export([remote_node_stop/1]). 20 | 21 | %% @private 22 | -spec local_allowed(Func::atom(), Args::list(), State::term()) -> 23 | {boolean(), NewState::term()}. 24 | local_allowed(q, _Args, State) -> {false, State}; 25 | local_allowed(halt, _Args, State) -> {false, State}; 26 | local_allowed(_Cmd, _Args, State) -> {true, State}. 27 | 28 | %% @private 29 | -type funspec() :: {Mod::atom(), Fun::atom()}. 30 | -spec non_local_allowed(FunSpec::funspec(), Args::list(), State::term()) -> 31 | {true,NewState::term()} | {false,NewState::term()} | 32 | {{redirect, NewFuncSpec::funspec(), NewArgs::list()}, NewState::term()}. 33 | non_local_allowed({erlang, halt}, _Args, State) -> {false, State}; 34 | non_local_allowed({init, stop}, _Args, State) -> {false, State}; 35 | non_local_allowed({remote, stop}, [A], State) -> {{redirect, {?MODULE, remote_node_stop}, [A]}, State}; 36 | non_local_allowed({_M, _F}, _Args, State) -> {true, State}. 37 | 38 | %% @doc Replaces `init:stop/1' with `remote_node_stop/1' to avoid accidental 39 | %% exit of remote shell. 40 | -spec remote_node_stop(Status::integer()) -> ok. 41 | remote_node_stop(Status) -> 42 | init:stop(Status). 43 | -------------------------------------------------------------------------------- /src/smtp.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------------ 2 | %%% @doc SMTP mail client. This module can sent emails to one or more 3 | %%% recipients, using primary/backup SMTP servers. Messages can 4 | %%% contain attachments. 5 | %%% 6 | %%% ``` 7 | %%% Example: 8 | %%% % Send a message to two recipients with a file attachment using 9 | %%% % SSL protocol at mail server "mail.bevemyr.com": 10 | %%% smtp:send(ssl, "Alex ", 11 | %%% ["katrin@bevemyr.com","jb@bevemyr.com"], 12 | %%% "Test Subject", "My Message", 13 | %%% [{server, "mail.bevemyr.com"}, 14 | %%% {username, "alex"}, {password, "secret"}, 15 | %%% {attachments, ["file1.txt"]}]). 16 | %%% 17 | %%% % Send a message to a recipient with a file attachment given custom 18 | %%% % MIME type using localhost mail server 19 | %%% smtp:send(tcp, "jb@bevemyr.com", 20 | %%% ["katrin@bevemyr.com"], "Test Subject", "My Message", 21 | %%% [{server, "mail.bevemyr.com"}, 22 | %%% {username, "alex"}, {password, "secret"}, 23 | %%% {attachments, [{"file1.bin","application/custom_MIME"}]}]). 24 | %%% 25 | %%% % Send a message to two recipients with an attachment given as list 26 | %%% smtp:send(tcp, "jb@bevemyr.com", 27 | %%% ["katrin@bevemyr.com","jb@bevemyr.com"], 28 | %%% "Test Subject", "My Message", 29 | %%% [{"file1.txt","text/plain","Attachment past as list"}]). 30 | %%% ''' 31 | %%% 32 | %%% @author Johan Bevemyr, Serge Aleynikov 33 | %%% @end 34 | %%%------------------------------------------------------------------------ 35 | %%% Created 02/24/2004 Johan Bevemyr 36 | %%%------------------------------------------------------------------------ 37 | -module(smtp). 38 | -author('jb@son.bevemyr.com'). 39 | -author('saleyn@gmail.com'). 40 | 41 | -export([send/5, send/6, domain/0]). 42 | 43 | -include_lib("kernel/include/inet.hrl"). 44 | 45 | -type proto() :: tcp | ssl. 46 | %% Protocol type. 47 | 48 | -type smtp_options() :: [ 49 | {server, Server::string()} 50 | | {relay, Relay::string()} 51 | | {port, Port::integer()} 52 | | {auth, Auth :: always | never} 53 | | {username, Username::string()} 54 | | {password, Password::string()} 55 | | {tls, Tls :: always | if_available} 56 | | {domain, Domain::string()} 57 | | {timeout, Millisec::integer()} 58 | | {verbose, debug} 59 | | {ssl, SSLOpts::list()} 60 | | {attachments, [ 61 | Filename::string() | 62 | {Filename::string(), ContentType::string()} | 63 | {Filename::string(), ContentType::string(), Data::list()}]}]. 64 | %% SNMP Options 65 | %%
    66 | %%
  • Server - server to connect to (no MX lookup)
    • 67 | %%
  • Relay - domain to do MX lookup of list of servers
    • 68 | %%
  • Port - optional port number (ssl def: 465; tcp def: 25)
    • 69 | %%
  • Auth - controls mandatory / optional authentication
    • 70 | %%
  • Tls - controls enabling of TLS protocol
    • 71 | %%
  • Domain - name of the domain to include in the HELO handshake
    • 72 | %%
  • Timeout - timeout to use (default 10000)
    • 73 | %%
  • Verbose - controls debugging printout
    • 74 | %%
  • Attachments - list of files to attach
    • 75 | %%
  • SSLOpts - additional SSL options if using SSL protocol
    • 76 | %%
77 | 78 | %%------------------------------------------------------------------------- 79 | %% @doc Send a message to a list of `To' receipients using `localhost'. 80 | %% Error is thrown if unable to send a message. 81 | %% Use inet:format_error/1 to decode the Reason if it is an atom. 82 | %% @end 83 | %%------------------------------------------------------------------------- 84 | -spec send(Proto :: proto(), From :: string() | binary(), 85 | To :: string() | binary(), Subj :: string() | binary(), 86 | Msg :: string() | binary()) -> ok. 87 | send(Proto, From, To, Subject, Message) -> 88 | send(Proto, From, To, Subject, Message, []). 89 | 90 | %%------------------------------------------------------------------------- 91 | %% @doc Send a message to a list of recipients by connecting to an SMTP 92 | %% server Server. The message can contain attachments in the 93 | %% Attachments list. See examples on the top of this page. 94 | %% Error is thrown if unable to send a message. 95 | %% @end 96 | %%------------------------------------------------------------------------- 97 | -spec send(Proto :: proto(), From :: string() | binary(), 98 | To :: string() | binary(), Subj :: string() | binary(), 99 | Msg :: string() | binary(), Opts :: smtp_options()) -> ok. 100 | send(Proto, From, To, Subj, Msg, Opts) 101 | when Proto =:= tcp; Proto =:= ssl -> 102 | Module = proto_module(Proto), 103 | case proplists:get_value(server, Opts) of 104 | undefined -> 105 | case proplists:get_value(relay, Opts) of 106 | undefined -> 107 | try_send(Module, From, To, Subj, Msg, "localhost", Opts); 108 | Domain -> 109 | Servers = mxlookup(Domain), 110 | send_mail(Module, Servers, {From, To, Subj, Msg}, 111 | no_servers_provided, Opts) 112 | end; 113 | [I | _] = Server when is_integer(I) -> 114 | try_send(Module, From, To, Subj, Msg, Server, Opts); 115 | Servers when is_list(Servers) -> 116 | send_mail(Module, Servers, {From, To, Subj, Msg}, 117 | no_servers_provided, Opts) 118 | end. 119 | 120 | 121 | %%------------------------------------------------------------------------- 122 | %% @doc Get domain that this host belongs to. 123 | %% @end 124 | %%------------------------------------------------------------------------- 125 | -spec domain() -> binary(). 126 | domain() -> 127 | case lists:keyfind(domain, 1, inet:get_rc()) of 128 | {domain, D} when is_binary(D) -> D; 129 | {domain, D} when is_list(D) -> list_to_binary(D); 130 | false -> 131 | {ok, Hostname} = inet:gethostname(), 132 | {ok, #hostent{h_name = FQDN}} = inet:gethostbyname(Hostname), 133 | list_to_binary(FQDN) 134 | end. 135 | 136 | %%%------------------------------------------------------------------------ 137 | %%% Internal functions 138 | %%%------------------------------------------------------------------------ 139 | 140 | proto_module(tcp) -> gen_tcp; 141 | proto_module(ssl) -> ssl. 142 | 143 | mxlookup(Domain) -> 144 | case whereis(inet_db) of 145 | P when is_pid(P) -> ok; 146 | _ -> inet_db:start() 147 | end, 148 | case lists:keyfind(nameserver, 1, inet_db:get_rc()) of 149 | false -> 150 | % we got no nameservers configured, suck in resolv.conf 151 | inet_config:do_load_resolv(os:type(), longnames); 152 | _ -> 153 | ok 154 | end, 155 | case inet_res:lookup(Domain, in, mx) of 156 | [] -> []; 157 | L -> [H || {_, H} <- lists:sort(L)] 158 | end. 159 | 160 | try_send(Module, From, To, Subj, Msg, Server, Opts) -> 161 | Verbose = proplists:get_value(verbose, Opts), 162 | Attachments = proplists:get_value(attachments, Opts, []), 163 | Port = smtp_init(Module, Server, From, To, Verbose, Opts), 164 | Boundary=boundary_bin(Attachments), 165 | smtp_send_headers(Module, Port, From, To, Subj, Boundary), 166 | smtp_send_message(Module, Port, Msg, Boundary), 167 | smtp_send_attachments(Module, Port, Attachments, Boundary), 168 | smtp_close(Module, Port). 169 | 170 | send_mail(_Mod, [], _What, LastReason, _Options) -> 171 | throw(LastReason); 172 | send_mail(Mod, [S | Rest], {From, To, Subj, Msg} = What, _LastReason, Options) -> 173 | try 174 | ok = try_send(Mod, From, To, Subj, Msg, S, Options) 175 | catch 176 | _:Reason when is_atom(Reason) -> 177 | % This is likely a connection error 178 | send_mail(Mod, Rest, What, Reason, Options); 179 | C:R:Stack -> 180 | % This is the case when a server couldn't send the message due to 181 | % other than networking reasons. Don't retry. 182 | erlang:raise(C,R,Stack) 183 | end. 184 | 185 | smtp_send_headers(Mod, Port, From, To, Subject, Boundary) -> 186 | CommonHeaders = [mail_headers(<<"To: ">>, [list_to_binary(T) || T <- To]), 187 | mail_header (<<"From: ">>, list_to_binary(From)), 188 | mail_header (<<"Subject: ">>, list_to_binary(Subject))], 189 | Headers = 190 | case Boundary of 191 | undefined -> 192 | [mail_header(<<"Content-Type: ">>, <<"text/plain">>), 193 | mail_header(<<"Content-Transfer-Encoding: ">>, <<"8bit">>)]; 194 | _ -> 195 | [mail_header(<<"Mime-Version: ">>, <<"1.0">>), 196 | mail_header(<<"Content-Type: ">>, [<<"Multipart/Mixed; boundary=\"">>, 197 | Boundary, <<"\"">>]), 198 | mail_header(<<"Content-Transfer-Encoding: ">>, <<"8bit">>)] 199 | end, 200 | Mod:send(Port, [CommonHeaders, Headers, <<"\r\n">>]). 201 | 202 | smtp_send_message(Mod, Port, Data, Boundary) -> 203 | case Boundary of 204 | undefined -> 205 | ok; 206 | _ -> 207 | Mod:send(Port, 208 | [<<"--">>,Boundary,<<"\r\n">>, 209 | mail_header(<<"Content-Type: ">>, <<"Text/Plain; charset=us-ascii">>), 210 | mail_header(<<"Content-Transfer-Encoding: ">>, <<"8bit">>), 211 | <<"\r\n">>]) 212 | end, 213 | {_LastNL, Escaped} = dot_escape(Data, true), 214 | Mod:send(Port, Escaped). 215 | 216 | smtp_send_attachments(Mod, Port, [], _Boundary) -> 217 | Mod:send(Port, <<"\r\n.\r\n">>); 218 | smtp_send_attachments(Mod, Port, Attachments, Boundary) -> 219 | send_attachments(Mod, Port, Boundary, Attachments), 220 | Mod:send(Port, <<"\r\n.\r\n">>). 221 | 222 | send_attachments(Mod, Port, Boundary, []) -> 223 | Mod:send(Port, <<"\r\n--",(list_to_binary(Boundary))/binary,"--\r\n">>); 224 | 225 | send_attachments(Mod, Port, Boundary, [{FileName,ContentType}|Rest]) -> 226 | Data = 227 | case file:read_file(FileName) of 228 | {ok, Bin} -> 229 | binary_to_list(Bin); 230 | {error, Reason} -> 231 | throw(lists:flatten( 232 | io_lib:format("File ~s: ~s", [FileName, file:format_error(Reason)]))) 233 | end, 234 | send_attachment(Mod, Port, Boundary, FileName, ContentType, Data), 235 | send_attachments(Mod, Port, Boundary, Rest); 236 | 237 | send_attachments(Mod, Port, Boundary, [{FileName,ContentType,Data}|Rest]) -> 238 | send_attachment(Mod, Port, Boundary, FileName, ContentType, Data), 239 | send_attachments(Mod, Port, Boundary, Rest); 240 | 241 | send_attachments(Mod, Port, Boundary, [FileName | Rest]) -> 242 | send_attachments(Mod, Port, Boundary, [{FileName, undefined} | Rest]). 243 | 244 | send_attachment(Mod, Port, Boundary, FileName, ContentType, Data) -> 245 | File = filename:basename(FileName,""), 246 | CT = case {ContentType, io_lib:printable_list(Data)} of 247 | {undefined, true} -> "plain/text"; 248 | {undefined, false} -> "application/octet-stream; name=\"" ++ File ++"\""; 249 | {_, _} -> ContentType 250 | end, 251 | Mod:send(Port, 252 | [<<"\r\n--">>,Boundary,<<"\r\n">>, 253 | mail_header(<<"Content-Type: ">>, CT), 254 | mail_header(<<"Content-Transfer-Encoding: ">>, <<"base64">>), 255 | mail_header(<<"Content-Disposition: ">>, 256 | [<<"attachment; filename=\"">>, list_to_binary(File), <<"\"">>]), 257 | <<"\r\n">> 258 | ]), 259 | B64 = sting2base64(Data), 260 | Mod:send(Port, B64). 261 | 262 | def_port_and_opts(gen_tcp, _Opts) -> 263 | {25, [{active, false}, {reuseaddr,true}, {packet, line}, binary]}; 264 | def_port_and_opts(ssl, Opts) -> 265 | SSLOpts = proplists:get_value(ssl, Opts, []), 266 | {465, SSLOpts ++ [{active, false}, {depth, 3}, {packet, line}, {ssl_imp, new}, binary]}. 267 | 268 | connect(gen_tcp, Server, _Verbose, _Options) when is_port(Server) -> 269 | Server; 270 | connect(Mod, Server, Verbose, Options) -> 271 | {DefPort, SockOpts} = def_port_and_opts(Mod, Options), 272 | Timeout = proplists:get_value(timeout, Options, 10000), 273 | % For ssl make sure applications crypto, public_key and ssl are started 274 | if is_port(Server) -> 275 | case Mod:connect(Server, SockOpts, Timeout) of 276 | {ok, Sock} -> Sock; 277 | {error, Why} -> throw(Why) 278 | end; 279 | true -> 280 | Port = proplists:get_value(port, Options, DefPort), 281 | print(Verbose, "Connecting to: ~w://~s:~w\n", [Mod, Server, Port]), 282 | case Mod:connect(Server, Port, SockOpts, Timeout) of 283 | {ok, Sock} -> Sock; 284 | {error, Why} -> throw(Why) 285 | end 286 | end. 287 | 288 | domain(Options) -> 289 | case proplists:get_value(domain, Options) of 290 | undefined -> 291 | domain(); 292 | Domain when is_binary(Domain) -> 293 | Domain; 294 | Domain when is_list(Domain) -> 295 | list_to_binary(Domain) 296 | end. 297 | 298 | smtp_STARTTLS(ssl, Port, _Options, Extensions, _Domain, _Verbose) -> 299 | {Port, Extensions}; 300 | smtp_STARTTLS(Mod, Port, Options, Extensions, Domain, Verbose) -> 301 | case {proplists:get_value(tls, Options), proplists:get_value(<<"STARTTLS">>, Extensions)} of 302 | {always, true} -> 303 | do_STARTTLS(Mod, Port, Extensions, Verbose, Options, Domain); 304 | {if_available, true} -> 305 | do_STARTTLS(Mod, Port, Extensions, Verbose, Options, Domain); 306 | {always, _} -> 307 | smtp_close(Mod, Port), 308 | throw({missing_requirement, tls}); 309 | _ -> 310 | {Port, Extensions} 311 | end. 312 | 313 | do_STARTTLS(Mod, Port, Extensions, Verbose, Options, Domain) -> 314 | smtp_put(Mod, <<"STARTTLS">>, Port), 315 | smtp_expect(Mod, <<"220">>, Port, undefined), 316 | case Mod of 317 | ssl -> 318 | {Port, Extensions}; 319 | gen_tcp -> 320 | Sock = connect(ssl, Port, Verbose, Options), 321 | {ok, Extensions2} = try_HELO(Mod, Port, Domain), 322 | {Sock, Extensions2} 323 | end. 324 | 325 | try_AUTH(Mod, Port, Options, Ext, _Verbose) when Ext =:= undefined; Ext =:= [] -> 326 | case proplists:get_value(auth, Options) of 327 | always -> 328 | smtp_close(Mod, Port), 329 | throw({missing_requirement, auth}); 330 | _ -> 331 | {false, proplists:get_value(username, Options)} 332 | end; 333 | try_AUTH(Mod, Port, Options, AuthTypes, Verbose) -> 334 | Username = proplists:get_value(username, Options), 335 | Password = proplists:get_value(password, Options), 336 | Auth = proplists:get_value(auth, Options), 337 | case Auth of 338 | never -> 339 | {false, Username}; 340 | _ when Username =:= undefined -> 341 | throw({missing_auth, username}); 342 | _ when Password =:= undefined -> 343 | throw({missing_auth, password}); 344 | _ -> 345 | Types = [decode_auth(X) || X <- re:split(AuthTypes, " ", [{return, binary}, trim])], 346 | AllowedTypes = [X || X <- Types, is_atom(X)], 347 | case do_AUTH_each(Mod, Port, Username, Password, AllowedTypes, Verbose) of 348 | false when Auth =:= always -> 349 | smtp_close(Mod, Port), 350 | erlang:throw({permanent_failure, auth_failed}); 351 | false -> 352 | {false, Username}; 353 | true -> 354 | {true, Username} 355 | end 356 | end. 357 | 358 | decode_auth(<<"CRAM-MD5">>) -> cram_md5; 359 | decode_auth(<<"cram-md5">>) -> cram_md5; 360 | decode_auth(<<"LOGIN">>) -> login; 361 | decode_auth(<<"login">>) -> login; 362 | decode_auth(<<"PLAIN">>) -> plain; 363 | decode_auth(<<"plain">>) -> plain; 364 | decode_auth(Other) -> Other. 365 | 366 | to_hex(Prefix, Bin) -> list_to_binary(Prefix ++ [to_hex_int(I) || <> <= Bin]). 367 | to_hex_int(I) when I < 10 -> $0 + I; 368 | to_hex_int(I) when I < 16 -> $A + (I - 10); 369 | to_hex_int(I) when I < 256 -> J = I div 256, [to_hex_int(J), to_hex_int(I - 256*J)]. 370 | 371 | do_AUTH_each(_Mod, _Port, _Username, _Password, [], _Verbose) -> 372 | false; 373 | do_AUTH_each(Mod, Port, Username, Password, [cram_md5 | Tail], Verbose) -> 374 | smtp_put(Mod, <<"AUTH CRAM-MD5">>, Port), 375 | try 376 | {ok, Seed64} = smtp_expect(Mod, <<"334">>, Port, undefined), 377 | Seed = base64:decode_to_string(Seed64), 378 | Bin = crypto:mac(hmac, md5, Password, Seed), 379 | Digest = to_hex([Username, " "], Bin), 380 | smtp_put(Mod, base64:encode(Digest), Port), 381 | smtp_expect(Mod, <<"235">>, Port, undefined), 382 | print(Verbose, "Authenticated using crom_md5\n", []), 383 | true 384 | catch _:_ -> 385 | do_AUTH_each(Mod, Port, Username, Password, Tail, Verbose) 386 | end; 387 | do_AUTH_each(Mod, Port, Username, Password, [login | Tail], Verbose) -> 388 | smtp_put(Mod, <<"AUTH LOGIN">>, Port), 389 | try 390 | {ok, <<"VXNlcm5hbWU6", _/binary>>} = smtp_expect(Mod, <<"334">>, Port, undefined), 391 | U = base64:encode(Username), 392 | smtp_put(Mod, U, Port), 393 | {ok, <<"UGFzc3dvcmQ6", _/binary>>} = smtp_expect(Mod, <<"334">>, Port, undefined), 394 | P = base64:encode(Password), 395 | smtp_put(Mod, P, Port), 396 | smtp_expect(Mod, <<"235">>, Port, undefined), 397 | print(Verbose, "Authenticated using login\n", []), 398 | true 399 | catch _:_ -> 400 | do_AUTH_each(Mod, Port, Username, Password, Tail, Verbose) 401 | end; 402 | do_AUTH_each(Mod, Port, Username, Password, [plain | Tail], Verbose) -> 403 | AuthString = base64:encode("\0"++Username++"\0"++Password), 404 | smtp_put(Mod, [<<"AUTH PLAIN ">>, AuthString], Port), 405 | try 406 | smtp_expect(Mod, <<"235">>, Port, undefined), 407 | print(Verbose, "Authenticated using plain\n", []), 408 | true 409 | catch _:_ -> 410 | do_AUTH_each(Mod, Port, Username, Password, Tail, Verbose) 411 | end. 412 | 413 | try_HELO(Mod, Port, Domain) -> 414 | smtp_put(Mod, [<<"EHLO ">>, Domain], Port), 415 | try 416 | smtp_expect(Mod, <<"250">>, Port, undefined) 417 | catch throw:<<"500", _/binary>> -> 418 | smtp_put(Mod, [<<"HELO ">>, Domain], Port), 419 | smtp_expect(Mod, <<"250">>, Port, undefined) 420 | end. 421 | 422 | smtp_init(Mod, Server, From, Recipients, Verbose, Options) -> 423 | Port = connect(Mod, Server, Verbose, Options), 424 | smtp_expect(Mod, <<"220">>, Port, "SMTP server does not respond"), 425 | Domain = domain(Options), 426 | {ok, Extensions} = try_HELO(Mod, Port, Domain), 427 | print(Verbose, "Extensions: ~p\n", [Extensions]), 428 | {Port2, Extensions2} = smtp_STARTTLS(Mod, Port, Options, Extensions, Domain, Verbose), 429 | {_Auth, Username} = 430 | try_AUTH(Mod, Port, Options, proplists:get_value(<<"AUTH">>, Extensions2), Verbose), 431 | FromEmail = format_email(Username, From), 432 | print(Verbose, "From email: ~p\n", [FromEmail]), 433 | smtp_put(Mod, [<<"MAIL FROM: ">>, FromEmail], Port2), 434 | smtp_expect(Mod, <<"250">>, Port2, undefined), 435 | send_recipients(Mod, Recipients, Port2), 436 | smtp_put(Mod, <<"DATA">>, Port2), 437 | smtp_expect(Mod, <<"354">>, Port2, "Message not accepted by mail server."), 438 | Port2. 439 | 440 | smtp_close(Mod, Port) -> 441 | smtp_put(Mod, <<".">>, Port), 442 | smtp_expect(Mod, <<"250">>, Port, "Message not accepted by mail server."), 443 | Mod:close(Port), 444 | ok. 445 | 446 | format_email(undefined, Default) -> format_email(Default); 447 | format_email(Other, _Default) -> format_email(Other). 448 | 449 | format_email(Addr) when is_list(Addr) -> 450 | case lists:splitwith(fun(I) -> I =/= $< end, Addr) of 451 | {_, []} -> [list_to_binary([$< | Addr]), $>]; 452 | {_, A} -> list_to_binary(A) 453 | end; 454 | format_email(Addr) when is_binary(Addr) -> 455 | case binary:match(Addr, <<"<">>) of 456 | {0, _} -> Addr; 457 | {I, _} -> binary:part(Addr, {I, byte_size(Addr) - I}); 458 | nomatch -> [$<, Addr, $>] 459 | end. 460 | 461 | send_recipients(Mod, To, Port) when is_binary(To) -> 462 | send_recipients2(Mod, [<<"RCPT TO: ">>, format_email(To)], Port); 463 | send_recipients(Mod, [R|_] = Addr, Port) when is_integer(R) -> 464 | send_recipients2(Mod, [<<"RCPT TO: ">>, format_email(Addr)], Port); 465 | send_recipients(Mod, List, Port) when is_list(List) -> 466 | [send_recipients2(Mod, [<<"RCPT TO: ">>, format_email(A)], Port) || A <- List], 467 | ok. 468 | 469 | send_recipients2(Mod, Data, Port) -> 470 | smtp_put(Mod, Data, Port), 471 | smtp_expect(Mod, <<"250">>, Port, undefined). 472 | 473 | smtp_put(Mod, Message, Port) -> 474 | Mod:send(Port, [Message,<<"\r\n">>]). 475 | 476 | smtp_expect(Mod, Code, Port, ErrorMsg) -> 477 | smtp_expect(Mod, Code, Port, ErrorMsg, 0, []). 478 | smtp_expect(Mod, Code, Port, ErrorMsg, N, Acc) when is_binary(Code) -> 479 | case Mod:recv(Port, 0, 15000) of 480 | {ok, <> = Bin} when RespCode =:= Code -> 481 | case C of 482 | $ when Acc =:= [] -> 483 | {ok, trim_nl(Rest)}; 484 | $ -> 485 | {ok, Acc}; 486 | $- when N =:= 0 -> 487 | smtp_expect(Mod, Code, Port, ErrorMsg, N+1, Acc); 488 | $- -> 489 | ExtensionAcc = parse_extension(Rest, Acc), 490 | smtp_expect(Mod, Code, Port, ErrorMsg, N+1, ExtensionAcc); 491 | _ when ErrorMsg =:= undefined -> 492 | throw(Bin); 493 | _ -> 494 | throw(ErrorMsg) 495 | end; 496 | {ok, Other} when ErrorMsg =:= undefined -> 497 | throw(Other); 498 | {ok, _Other} -> 499 | throw(ErrorMsg); 500 | {error, closed} -> 501 | throw("Socket closed unexpectedly"); 502 | {error, Reason} -> 503 | throw({Mod, recv, Reason, lists:flatten(inet:format_error(Reason))}) 504 | end. 505 | 506 | parse_extension(Bin, Acc) -> 507 | case binary:match(Bin, <<" ">>) of 508 | {I, _} -> 509 | <> = Bin, 510 | [{to_upper(E), trim_nl(Args)} | Acc]; 511 | nomatch -> 512 | case binary:match(Bin, <<"=">>) of 513 | nomatch -> 514 | [{to_upper(trim_nl(Bin)), true} | Acc]; 515 | _ -> 516 | Acc 517 | end 518 | end. 519 | 520 | to_upper(Bin) -> to_upper(byte_size(Bin)-1, Bin). 521 | to_upper(-1, Bin) -> Bin; 522 | to_upper(I, Bin) -> 523 | case binary:at(Bin, I) of 524 | C when C >= $a, $z =< C -> 525 | list_to_binary(string:to_upper(binary_to_list(Bin))); 526 | _ -> 527 | to_upper(I-1, Bin) 528 | end. 529 | 530 | trim_nl(Bin) -> 531 | case binary:match(Bin, [<<"\r">>, <<"\n">>]) of 532 | {I, _} -> 533 | binary:part(Bin, {0, I}); 534 | nomatch -> 535 | Bin 536 | end. 537 | 538 | print(debug, Fmt, Args) -> 539 | io:format("SMTP: " ++ Fmt, Args); 540 | print(_, _Fmt, _Args) -> 541 | ok. 542 | 543 | %% Add an . at all lines starting with a dot. 544 | 545 | dot_escape(Data, NL) -> 546 | dot_escape(Data, NL, []). 547 | 548 | dot_escape([], NL, Acc) -> 549 | {NL, lists:reverse(Acc)}; 550 | dot_escape([$.|Rest], true, Acc) -> 551 | dot_escape(Rest, false, [$.,$.|Acc]); 552 | dot_escape([$\n|Rest], _, Acc) -> 553 | dot_escape(Rest, true, [$\n|Acc]); 554 | dot_escape([C|Rest], _, Acc) -> 555 | dot_escape(Rest, false, [C|Acc]). 556 | 557 | %% 558 | 559 | sting2base64(String) -> 560 | sting2base64(String, []). 561 | 562 | sting2base64([], Acc) -> 563 | lists:reverse(Acc); 564 | sting2base64(String, Acc) -> 565 | case str2b64_line(String, []) of 566 | {ok, Line, Rest} -> 567 | sting2base64(Rest, ["\n",Line|Acc]); 568 | {more, Cont} -> 569 | lists:reverse(["\n",str2b64_end(Cont)|Acc]) 570 | end. 571 | 572 | %% 573 | 574 | str2b64_line(S, []) -> str2b64_line(S, [], 0); 575 | str2b64_line(S, {Rest,Acc,N}) -> str2b64_line(Rest ++ S, Acc, N). 576 | 577 | str2b64_line(S, Out, 76) -> {ok,lists:reverse(Out),S}; 578 | str2b64_line([C1,C2,C3|S], Out, N) -> 579 | O1 = e(C1 bsr 2), 580 | O2 = e(((C1 band 16#03) bsl 4) bor (C2 bsr 4)), 581 | O3 = e(((C2 band 16#0f) bsl 2) bor (C3 bsr 6)), 582 | O4 = e(C3 band 16#3f), 583 | str2b64_line(S, [O4,O3,O2,O1|Out], N+4); 584 | str2b64_line(S, Out, N) -> 585 | {more,{S,Out,N}}. 586 | 587 | %% 588 | 589 | str2b64_end({[C1,C2],Out,_N}) -> 590 | O1 = e(C1 bsr 2), 591 | O2 = e(((C1 band 16#03) bsl 4) bor (C2 bsr 4)), 592 | O3 = e( (C2 band 16#0f) bsl 2 ), 593 | lists:reverse(Out, [O1,O2,O3,$=]); 594 | str2b64_end({[C1],Out,_N}) -> 595 | O1 = e(C1 bsr 2), 596 | O2 = e((C1 band 16#03) bsl 4), 597 | lists:reverse(Out, [O1,O2,$=,$=]); 598 | str2b64_end({[],Out,_N}) -> lists:reverse(Out); 599 | str2b64_end([]) -> []. 600 | 601 | %% 602 | 603 | boundary_bin([]) -> 604 | undefined; 605 | boundary_bin(_) -> 606 | rand:seed(exs64), 607 | <<"Boundary_(", (list_to_binary(random_list(10)))/binary, ")">>. 608 | 609 | random_list(0) -> []; 610 | random_list(N) -> [64+rand:uniform(25), 96+rand:uniform(25) | random_list(N-1)]. 611 | 612 | %% 613 | 614 | e(X) when X >= 0, X < 26 -> X + $A; 615 | e(X) when X >= 26, X < 52 -> X + $a - 26; 616 | e(X) when X >= 52, X < 62 -> X + $0 - 52; 617 | e(62) -> $+; 618 | e(63) -> $/; 619 | e(X) -> erlang:error({badchar,X}). 620 | 621 | %% 622 | mail_headers(_Key, []) -> []; 623 | mail_headers(Key, [H|T]) -> [mail_header(Key, H) | mail_headers(Key, T)]. 624 | 625 | mail_header(_Key, []) -> []; 626 | mail_header(Key, Val) -> [Key, Val, <<"\r\n">>]. 627 | -------------------------------------------------------------------------------- /src/sntp.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------------ 2 | %%% @doc Implements SNTP query logic. 3 | %%% SNTP - Simple Network Time Protocol (RFC-2030). 4 | %%% 5 | %%% @author Serge Aleynikov 6 | %%% @end 7 | %%%------------------------------------------------------------------------ 8 | %%% Created 2006-07-15 9 | %%%------------------------------------------------------------------------ 10 | -module(sntp). 11 | -author('saleyn@gmail.com'). 12 | 13 | %% External API 14 | -export([time/1, time_servers/0, time_servers/1, avg_time/0, avg_time/1]). 15 | 16 | -include("sntp.hrl"). 17 | -include_lib("kernel/include/inet.hrl"). 18 | 19 | %%%------------------------------------------------------------------------ 20 | %%% API 21 | %%%------------------------------------------------------------------------ 22 | 23 | %%------------------------------------------------------------------------- 24 | %% @doc Return a list of default NTP time servers for this host. 25 | %% @end 26 | %%------------------------------------------------------------------------- 27 | -spec time_servers() -> [ inet:ip_address() ]. 28 | time_servers() -> 29 | time_servers(true). 30 | 31 | %%------------------------------------------------------------------------- 32 | %% @doc Return a list of default NTP time servers for this host. If 33 | %% `Resolve' is true, the list will contain IP addresses or else 34 | %% host names. 35 | %% @end 36 | %%------------------------------------------------------------------------- 37 | -spec time_servers(boolean()) -> [ inet:ip_address() ]. 38 | time_servers(Resolve) when is_boolean(Resolve) -> 39 | {ok, Bin} = file:read_file("/etc/ntp.conf"), 40 | Res = re:run(Bin, <<"(?:^|\\n)[^#]\\s*erver\\s+([a-zA-Z0-9\\.-]+)">>, 41 | [{capture, [1], list}, global]), 42 | case Res of 43 | {match, Servers} -> 44 | IPs = [resolve(Resolve, A) || A <- Servers], 45 | [A || A <- IPs, A=/=nxdomain]; 46 | nomatch -> 47 | [] 48 | end. 49 | 50 | %%------------------------------------------------------------------------- 51 | %% @doc Query NTP time sources from `"/etc/ntp.conf"' and return 52 | %% min/max/avg offset of current host from given time sources. 53 | %% @see avg_time/1 54 | %% @end 55 | %%------------------------------------------------------------------------- 56 | -spec avg_time() -> {Min::integer(), Max::integer(), Avg::integer()}. 57 | avg_time() -> 58 | avg_time(time_servers()). 59 | 60 | %%------------------------------------------------------------------------- 61 | %% @doc Query `ServerAddress' NTP time sources and return min/max/avg offset 62 | %% of current host from given time sources. 63 | %% @end 64 | %%------------------------------------------------------------------------- 65 | -spec avg_time([ inet:ip_address() ]) -> {Min::integer(), Max::integer(), Avg::integer()}. 66 | avg_time(ServerAddresses) -> 67 | Results = [time(3, Addr, []) || Addr <- ServerAddresses], 68 | {Min, Max, Sum, N} = 69 | lists:foldl( 70 | fun(#sntp{offset=Offset}, {Min, Max, Sum, N}) -> 71 | {erlang:min(Min, Offset), 72 | erlang:max(Max, Offset), Sum+Offset, N+1}; 73 | (_, Acc) -> 74 | Acc 75 | end, 76 | {99999999, -99999999, 0, 0}, 77 | Results), 78 | {Min, Max, round(Sum/N)}. 79 | 80 | %%------------------------------------------------------------------------- 81 | %% @doc Query `ServerAddress' time source to find out server time and 82 | %% current host's offset from time source. 83 | %% @end 84 | %%------------------------------------------------------------------------- 85 | -spec time(ServerAddress::inet:ip_address()) -> #sntp{}. 86 | time(ServerAddress) -> 87 | {ok, S} = gen_udp:open(0, [binary, {active, false}]), 88 | try 89 | ok = gen_udp:send(S, ServerAddress, _Port = 123, encode()), 90 | case gen_udp:recv(S, 0, 3000) of 91 | {ok, {_Addr, _Port2, Reply}} -> 92 | decode(Reply); 93 | Other -> 94 | Other 95 | end 96 | after 97 | gen_udp:close(S) 98 | end. 99 | 100 | %%%------------------------------------------------------------------------ 101 | %%% Internal functions 102 | %%%------------------------------------------------------------------------ 103 | 104 | %% Try several consequitive time lookup and choose the best response. 105 | time(0, _, List) -> 106 | lists:foldl( 107 | fun(#sntp{offset=Offset} = T, #sntp{offset=Min}) when Offset < Min -> 108 | T; 109 | (_, Min) -> 110 | Min 111 | end, 112 | #sntp{}, %% (integer() < undefined) for any value. 113 | List); 114 | time(N, Server, Acc) -> 115 | Res = time(Server), 116 | time(N-1, Server, [Res | Acc]). 117 | 118 | encode() -> 119 | {Secs, US} = now_to_sntp_time(erlang:timestamp()), 120 | <<(_LI = 0):2, (_VN = 4):3, (_Mode = 3):3, 121 | 0:8, 0:8, 0:8, 0:32, 0:32, 0:32, 0:64, 0:64, 0:64, 122 | Secs:32/big-integer, US:32/big-integer>>. 123 | 124 | decode(<>) when LI < 3, Mode >= 3 -> 132 | DestTime = erlang:timestamp(), 133 | OrigTime = sntp_time_to_now(OrigTimeSec, OrigTimeUSec), 134 | RecvTime = sntp_time_to_now(RecvTimeSec, RecvTimeUSec), 135 | TransTime = sntp_time_to_now(TransTimeSec, TransTimeUSec), 136 | Delay = (timer:now_diff(DestTime, OrigTime) - timer:now_diff(RecvTime, TransTime)), 137 | Offset = (timer:now_diff(RecvTime, OrigTime) + timer:now_diff(TransTime, DestTime)) div 2, 138 | [I1 | Tail] = binary_to_list(RefId), 139 | Ref = lists:flatten(integer_to_list(I1) ++ [[$., integer_to_list(I)] || I <- Tail]), 140 | #sntp{version=Vsn, stratum=Stratum, precision=round((1 / (1 bsl abs(Precision)))*1000000), 141 | rootdelay=RootDelay / 65.536, rootdisp=(RootDispersion * 1000) / 65536, 142 | refid=Ref, reftime=sntp_time_to_now(RefTimeSec,RefTimeUSec), 143 | transtime=TransTime, delay=Delay, offset=Offset}; 144 | decode(<<3:2, _:6, _/binary>>) -> 145 | {error, clock_not_synchronized}; 146 | decode(Packet) -> 147 | {error, {unknown_packet_format, Packet}}. 148 | 149 | sntp_time_to_now(Sec, USec) -> 150 | case Sec band 16#80000000 of 151 | 0 -> Time = Sec + 2085978496; % use base: 7-Feb-2036 @ 06:28:16 UTC 152 | _ -> Time = Sec - 2208988800 % use base: 1-Jan-1900 @ 01:00:00 UTC 153 | end, 154 | {Time div 1000000, Time rem 1000000, round((USec * 1000000) / (1 bsl 32))}. 155 | 156 | now_to_sntp_time({_,_,USec} = Now) -> 157 | SecsSinceJan1900 = 16#80000000 bor 158 | (calendar:datetime_to_gregorian_seconds(calendar:now_to_universal_time(Now)) - 59958230400), 159 | {SecsSinceJan1900, round(USec * (1 bsl 32) / 1000000)}. 160 | 161 | -spec resolve(Resolve::boolean(), Name::string()|tuple()) -> inet:ip_address() | nxdomain. 162 | resolve(_, {_, _, _, _} = IP) -> 163 | IP; 164 | resolve(false, Name) -> 165 | Name; 166 | resolve(true, Name) when is_list(Name) -> 167 | % Do a DNS lookup on the hostname 168 | case inet:gethostbyname(Name) of 169 | {ok, #hostent{h_addr_list = [Addr | _]}} -> Addr; 170 | _ -> nxdomain 171 | end. 172 | -------------------------------------------------------------------------------- /src/ssh_sign.erl: -------------------------------------------------------------------------------- 1 | -module(ssh_sign). 2 | 3 | -export([sign/1 4 | ,verify/2 5 | ,public_identity_key/2 6 | ]). 7 | 8 | sign(Data) when is_binary(Data) -> 9 | {ok,Key} = ssh_file:private_identity_key("ssh-rsa",[]), 10 | ssh_rsa:sign(Key, Data). 11 | 12 | verify(Data, Sig) when is_binary(Data), is_binary(Sig) -> 13 | {ok,Key} = public_identity_key("ssh-rsa",[]), 14 | ssh_rsa:verify(Key, Data, Sig). 15 | 16 | public_identity_key(Alg, Opts) -> 17 | Path = ssh_file:file_name(user, public_identity_key_filename(Alg), Opts), 18 | read_public_key_v2(Path, Alg). 19 | 20 | public_identity_key_filename("ssh-dss") -> "id_dsa.pub"; 21 | public_identity_key_filename("ssh-rsa") -> "id_rsa.pub". 22 | 23 | read_public_key_v2(File, Type) -> 24 | case file:read_file(File) of 25 | {ok,Bin} -> 26 | List = binary_to_list(Bin), 27 | case lists:prefix(Type, List) of 28 | true -> 29 | List1 = lists:nthtail(length(Type), List), 30 | K_S = ssh_bits:b64_decode(List1), 31 | ssh_file:decode_public_key_v2(K_S, Type); 32 | false -> 33 | {error, bad_format} 34 | end; 35 | Error -> 36 | Error 37 | end. 38 | 39 | %% http://www.redhoterlang.com/entry/ce13f30fd1b067039fadc639cedbf06e 40 | -------------------------------------------------------------------------------- /src/ssh_tunnel.erl: -------------------------------------------------------------------------------- 1 | -module(ssh_tunnel). 2 | %% @doc Module for creating SSH tunnels using `ssh'. 3 | %% [https://github.com/drowzy/ssh_tunnel] 4 | %% 5 | %% It provides functions to create forwarded ssh channels, similair 6 | %% to how other channels can be created using `ssh_connection'. 7 | %% There are two type of channels supported 8 | %% * `directtcp-ip` - Forwards a port from the client machine to the remote machine. 9 | %% This is the same as `ssh -nNT -L 8080:forward.example.com:9000 user@sshserver.example.com' 10 | %% * `direct-streamlocal' - Forwards to a unix domain socket. 11 | %% This is the same as `ssh -nNT -L 8080:/var/lib/mysql/mysql.sock user@sshserver.example.com' 12 | %% When using `direct_tcpip/3' or `direct_stream_local/2' directly there 13 | %% will not be any local port or socket bound, this can either be done 14 | %% using `ssh_tunnel' or by manually sending data with `ssh_connection:send/3'. 15 | %% Although `connect/3' can be used to connect to the remote host, other 16 | %% methods are supported. 17 | %% One can use [SSHex](https://github.com/rubencaro/sshex), `ssh:connect/3' 18 | %% for instance. 19 | %% 20 | %% ## Tunnels 21 | %% Tunnels are on-demand TCP servers and are bound listeners to either a port 22 | %% or a path. The tunnel will handle relaying TCP messages to the ssh 23 | %% connection and back. 24 | %% 25 | %% ## Examples 26 | %% ``` 27 | %% {ok, SshRef} = ssh_tunnel:connect("sshserver.example.com", 22, []), 28 | %% {ok, Pid} = ssh_tunnel:start_tunnel(Pid, {tcpip, {8080, {"192.168.90.15", 80}}}), 29 | %% % Send a TCP message for instance HTTP 30 | %% Resp = HTTPoison.get!("127.0.0.1:8080"), 31 | %% io:format("Received body: ~p\n", [Resp]) 32 | %% ''' 33 | 34 | -export([start_tunnel/3]). 35 | -export([connect/0, connect/3, direct_tcpip/3, direct_stream_local/2, open_channel/6]). 36 | 37 | -define(DIRECT_TCPIP, "direct-tcpip"). 38 | -define(STREAM_LOCAL, "direct-streamlocal@openssh.com"). 39 | 40 | -define(INI_WINDOW_SIZE, 1024 * 1024). 41 | -define(MAX_PACKET_SIZE, 32 * 1024). 42 | 43 | -type location() :: {string(), integer()}. 44 | 45 | connect() -> connect({127,0,0,1}, 22, []). 46 | 47 | %% @doc Create a connetion to a remote host with the provided options. 48 | %% This function is mostly used as convenience wrapper around `ssh:connect/3' 49 | %% and does not support all options. 50 | %% returns: `{ok, Connection}' or `{error, Reason}'. 51 | %% [https://manpages.debian.org/stretch/erlang-manpages/ssh.3erl.en.html] 52 | -spec connect(list()|tuple(), integer(), list()) -> {ok, pid()} | {error, term()}. 53 | connect(Host, Port, Opts) when (is_list(Host) orelse is_tuple(Host)), is_integer(Port), is_list(Opts) -> 54 | Config = defaults(Opts), 55 | ssh:connect(Host, Port, Config). 56 | 57 | %% @doc Starts a SSHTunnel.Tunnel process. 58 | %% The tunnel will listen to either a local port or local path and handle 59 | %% passing messages between the TCP client and ssh connection. 60 | %% ## Examples 61 | %% {ok, SSH} = ssh_tunnel:connect("sshserver.example.com", 22), 62 | %% {ok, Pid} = ssh_tunnel:start_tunnel(Pid, tcp, {8080, {"192.168.90.15", 80}}) 63 | %% # Send a TCP message 64 | %% %HTTPoison.Response{body: body} = HTTPoison.get!("127.0.0.1:8080") 65 | %% IO.puts("Received body: #{body}) 66 | -spec start_tunnel(pid(), tcp|local, tuple()|integer()) -> {ok, pid()} | {error, term()}. 67 | start_tunnel(Pid, Transport, To) when (is_tuple(To) orelse is_integer(To)) 68 | , (Transport==tcp orelse Transport==local) -> 69 | case {Transport, To} of 70 | {tcp, ToPort} when is_integer(ToPort) -> 71 | direct_tcpip(Pid, {"localhost", ToPort}, {"localhost", ToPort}); 72 | {tcp, {From, To}} when is_integer(From), is_integer(To) -> 73 | direct_tcpip(Pid, {"localhost", From}, {"localhost", To}); 74 | {tcp, {From, {ToHost, ToPort}=To}} when is_integer(From), is_list(ToHost), is_integer(ToPort) -> 75 | direct_tcpip(Pid, {"localhost", From}, To); 76 | {tcp, {From, {ToHost, ToPort}=To}} when is_integer(From), is_list(ToHost), is_integer(ToPort) -> 77 | direct_tcpip(Pid, {"localhost", From}, To); 78 | {tcp, {{FromHost, FromPort}=From, {ToHost, ToPort}=To}} when is_list(FromHost), is_integer(FromPort), is_list(ToHost), is_integer(ToPort) -> 79 | direct_tcpip(Pid, From, To); 80 | {local, To} when is_list(To) -> 81 | direct_stream_local(Pid, To) 82 | end. 83 | 84 | %% @doc Creates a ssh directtcp-ip forwarded channel to a remote port. 85 | %% The returned channel together with a ssh connection reference (returned 86 | %% from `ssh:connect/4') can be used to send messages with `ssh_connection:send/3' 87 | %% returns: `{ok, channel}' or `{error, reason}'. 88 | %% ## Examples: 89 | %% msg = "GET / HTTP/1.1\r\nHost: localhost:8080\r\nUser-Agent: curl/7.47.0\r\nAccept: */*\r\n\r\n" 90 | %% {ok, Pid} = ssh_tunnel:connect("192.168.1.10", 22), 91 | %% {ok, Ch} = ssh_tunnel:direct_tcpip(Pid, {"127.0.0.1", 8080}, {"192.168.1.10", 80}), 92 | %% ok = ssh_connection:send(Pid, Ch, Msg), 93 | %% recieve do 94 | %% {ssh_cm, _, {data, Channel, _, Data}} -> io:format("Data: ~p\n", [Data]) 95 | %% end 96 | -spec direct_tcpip(pid(), From::location(), To::location()) -> {ok, integer()} | {error, term()}. 97 | direct_tcpip(Pid, {OrigHost, OrigPort} = _From, {RemHost, RemPort} = _To) when is_pid(Pid) -> 98 | LocH = list_to_binary(OrigHost), 99 | RemH = list_to_binary(RemHost), 100 | RemLen = byte_size(RemH), 101 | LocLen = byte_size(LocH), 102 | Msg = <>, 103 | open_channel(Pid, ?DIRECT_TCPIP, Msg, ?INI_WINDOW_SIZE, ?MAX_PACKET_SIZE, infinity). 104 | 105 | %% @doc Creates a ssh stream local-forward channel to a remote unix domain socket. 106 | %% It sends the request that the server make a connection to its local Unix domain socket. 107 | %% The returned channel together with a ssh connection reference (returned from `ssh:connect/4') 108 | %% can be used to send messages with `ssh_connection:send/3'. 109 | %% returns: `{ok, Channel}` or `{error, Reason}'. 110 | %% Ex: 111 | %% ``` 112 | %% msg = "GET /images/json HTTP/1.1\r\nHost: /var/run/docker.sock\r\nAccept: */*\r\n\r\n" 113 | %% {ok, Pid} = ssh_tunnel:connect("192.168.90.15", 22), 114 | %% {ok, Ch} = ssh_tunnel:direct_stream_local(Pid, "/var/run/docker.sock"), 115 | %% ok = ssh_connection:send(Pid, Ch, Msg) 116 | %% ''' 117 | -spec direct_stream_local(pid(), string()) -> {ok, integer()} | {error, term()}. 118 | direct_stream_local(Pid, SocketPath) when is_pid(Pid), is_list(SocketPath) -> 119 | SPath = list_to_binary(SocketPath), 120 | Msg = <<(byte_size(SPath)):32/integer, SPath/binary, 0:32, 0:32>>, 121 | open_channel(Pid, ?STREAM_LOCAL, Msg, ?INI_WINDOW_SIZE, ?MAX_PACKET_SIZE, infinity). 122 | 123 | open_channel(Pid, Type, Msg, WindowSize, MaxPktSz, Timeout) -> 124 | case ssh_connection_handler:open_channel(Pid,Type,Msg,WindowSize,MaxPktSz,Timeout) of 125 | {open, Ch} -> {ok, Ch}; 126 | {open_error, _, Reason, _} -> {error, to_string(Reason)}; 127 | {error, Reason} -> {error, inet:format_error(Reason)} 128 | end. 129 | 130 | defaults(Opts) -> 131 | [ 132 | {user_interaction, false}, 133 | {silently_accept_hosts, true} | 134 | Opts 135 | ]. 136 | 137 | to_string(A) when is_atom(A) -> atom_to_list(A); 138 | to_string(B) when is_binary(B) -> binary_to_list(B); 139 | to_string(B) when is_list(B) -> B. 140 | -------------------------------------------------------------------------------- /src/sup_bridge.erl: -------------------------------------------------------------------------------- 1 | %% ``The contents of this file are subject to the Erlang Public License, 2 | %% Version 1.1, (the "License"); you may not use this file except in 3 | %% compliance with the License. You should have received a copy of the 4 | %% Erlang Public License along with this software. If not, it can be 5 | %% retrieved via the world wide web at http://www.erlang.org/. 6 | %% 7 | %% Software distributed under the License is distributed on an "AS IS" 8 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 9 | %% the License for the specific language governing rights and limitations 10 | %% under the License. 11 | %% 12 | %% The Initial Developer of the Original Code is Ericsson Utvecklings AB. 13 | %% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings 14 | %% AB. All Rights Reserved.'' 15 | %% 16 | %% $Id$ 17 | %% 18 | %%------------------------------------------------------------------ 19 | %% This is a minor extension of the stdlib/supervisor_bridge module 20 | %% that exposes three additional functions: 21 | %% Mod:handle_call/3 22 | %% Mod:handle_cast/2 23 | %% Mod:handle_info/2 24 | %%------------------------------------------------------------------ 25 | -module(sup_bridge). 26 | 27 | -behaviour(gen_server). 28 | 29 | %% External exports 30 | -export([start_link/2, start_link/3, get_child_pid/1]). 31 | -export([behaviour_info/1]). 32 | %% Internal exports 33 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2]). 34 | -export([code_change/3]). 35 | 36 | behaviour_info(callbacks) -> 37 | [{init,1},{terminate,2},{handle_call,3},{handle_cast,2},{handle_info,2}]; 38 | behaviour_info(_Other) -> 39 | undefined. 40 | 41 | %%%----------------------------------------------------------------- 42 | %%% This is a rewrite of supervisor_bridge from BS.3. 43 | %%% 44 | %%% This module is built to function as process code 45 | %%% for a process sitting inbetween a real supervisor 46 | %%% and a not start&recovery complient server/system 47 | %%% The process inbetween simulates start&recovery 48 | %%% behaviour of the server/system below. 49 | %%% 50 | %%% The supervisor_bridge behaviour must export the following 51 | %%% functions: 52 | %%% init(Args) -> {ok, Pid, State} | {error, Reason} | ignore 53 | %%% where Pid is the child process 54 | %%% terminate(Reason, State) -> ok 55 | %%%----------------------------------------------------------------- 56 | -record(state, {mod, pid, child_state, name}). 57 | 58 | start_link(Mod, StartArgs) -> 59 | gen_server:start_link(?MODULE, [Mod, StartArgs, self], []). 60 | 61 | start_link(Name, Mod, StartArgs) -> 62 | gen_server:start_link(Name, ?MODULE, [Mod, StartArgs, Name], []). 63 | 64 | get_child_pid(Name) -> 65 | gen_server:call(Name, get_child_pid). 66 | 67 | %%----------------------------------------------------------------- 68 | %% Callback functions from gen_server 69 | %%----------------------------------------------------------------- 70 | init([Mod, StartArgs, Name0]) -> 71 | process_flag(trap_exit, true), 72 | Name = supname(Name0, Mod), 73 | case Mod:init(StartArgs) of 74 | {ok, Pid, ChildState} when is_pid(Pid) -> 75 | link(Pid), 76 | report_progress(Pid, Mod, StartArgs, Name), 77 | {ok, #state{mod = Mod, pid = Pid, 78 | child_state = ChildState, name = Name}}; 79 | ignore -> 80 | ignore; 81 | {error, Reason} -> 82 | {stop, Reason} 83 | end. 84 | 85 | supname(self, Mod) -> {self(),Mod}; 86 | supname(N, _) -> N. 87 | 88 | %% A supervisor *must* answer the supervisor:which_children call. 89 | handle_call(which_children, _From, State) -> 90 | {reply, [], State}; 91 | handle_call(get_child_pid, _From, #state{pid = Pid} = State) -> 92 | {reply, {ok, Pid}, State}; 93 | handle_call(Req, From, #state{mod = Mod, child_state = ChildState} = State) -> 94 | try Mod:handle_call(Req, From, ChildState) of 95 | {reply, Reply, NewState} -> 96 | {reply, Reply, State#state{child_state = NewState}}; 97 | {reply, Reply, NewState, Timeout} -> 98 | {reply, Reply, State#state{child_state = NewState}, Timeout}; 99 | {noreply, NewState} -> 100 | {noreply, State#state{child_state = NewState}}; 101 | {noreply, NewState, Detail} -> 102 | {noreply, State#state{child_state = NewState}, Detail}; 103 | {stop, Reason, NewState} -> 104 | {stop, Reason, State#state{child_state = NewState}}; 105 | {stop, Reason, Reply, NewState} -> 106 | {stop, Reason, Reply, State#state{child_state = NewState}} 107 | catch error:{undef, _} -> 108 | {reply, {error, badcall}, State}; 109 | _:Reason -> 110 | {stop, Reason, State} 111 | end. 112 | 113 | handle_cast(Req, #state{mod = Mod, child_state = ChildState} = State) -> 114 | try Mod:handle_cast(Req, ChildState) of 115 | {noreply, NewState} -> 116 | {noreply, State#state{child_state = NewState}}; 117 | {noreply, NewState, Timeout} -> 118 | {noreply, State#state{child_state = NewState}, Timeout}; 119 | {stop, Reason, NewState} -> 120 | {stop, Reason, State#state{child_state = NewState}} 121 | catch error:{undef, _} -> 122 | {noreply, State}; 123 | _:Reason -> 124 | {stop, Reason, State} 125 | end. 126 | 127 | handle_info({'EXIT', Pid, Reason}, State) when State#state.pid =:= Pid -> 128 | report_error(child_terminated, Reason, State), 129 | {stop, Reason, State#state{pid = undefined}}; 130 | handle_info(Req, #state{mod = Mod, child_state = ChildState} = State) -> 131 | try Mod:handle_info(Req, ChildState) of 132 | {noreply, NewState} -> 133 | {noreply, State#state{child_state = NewState}}; 134 | {noreply, NewState, Timeout} -> 135 | {noreply, State#state{child_state = NewState}, Timeout}; 136 | {stop, Reason, NewState} -> 137 | {stop, Reason, State#state{child_state = NewState}} 138 | catch error:{undef, _} -> 139 | {noreply, State}; 140 | _:Reason -> 141 | {stop, Reason, State} 142 | end. 143 | 144 | terminate(_Reason, #state{pid = undefined}) -> 145 | ok; 146 | terminate(Reason, State) -> 147 | terminate_pid(Reason, State). 148 | 149 | code_change(_OldVsn, State, _Extra) -> 150 | {ok, State}. 151 | 152 | %% This function is supposed to terminate the 'real' server. 153 | terminate_pid(Reason, #state{mod = Mod, child_state = ChildState}) -> 154 | Mod:terminate(Reason, ChildState). 155 | 156 | report_progress(Pid, Mod, StartArgs, SupName) -> 157 | Progress = [{supervisor, SupName}, 158 | {started, [{pid, Pid}, {mfa, {Mod, init, [StartArgs]}}]}], 159 | error_logger:info_report(progress, Progress). 160 | 161 | report_error(Error, Reason, #state{name = Name, pid = Pid, mod = Mod}) -> 162 | ErrorMsg = [{supervisor, Name}, 163 | {errorContext, Error}, 164 | {reason, Reason}, 165 | {offender, [{pid, Pid}, {mod, Mod}]}], 166 | error_logger:error_report(supervisor_report, ErrorMsg). 167 | -------------------------------------------------------------------------------- /src/throttle.erl: -------------------------------------------------------------------------------- 1 | %%------------------------------------------------------------------------------ 2 | %% @doc Throttle given rate over a number of seconds. 3 | %% 4 | %% Implementation uses time spacing reservation algorithm where each 5 | %% allocation of samples reserves a fraction of space in the throttling 6 | %% window. The reservation gets freed as the time goes by. No more than 7 | %% the `Rate' number of samples are allowed to fit in the milliseconds `Window'. 8 | %% 9 | %% This is an Erlang implementation of the throttling algorithm from the utxx 10 | %% library found at this URL: 11 | %% [https://github.com/saleyn/utxx/blob/master/include/utxx/rate_throttler.hpp] 12 | %% 13 | %% @author Serge Aleynikov 14 | %% @end 15 | %%------------------------------------------------------------------------------ 16 | %% Copyright (c) 2011 Serge Aleynikov 17 | %% 18 | %% Permission is hereby granted, free of charge, to any person 19 | %% obtaining a copy of this software and associated documentation 20 | %% files (the "Software"), to deal in the Software without restriction, 21 | %% including without limitation the rights to use, copy, modify, merge, 22 | %% publish, distribute, sublicense, and/or sell copies of the Software, 23 | %% and to permit persons to whom the Software is furnished to do 24 | %% so, subject to the following conditions: 25 | %% 26 | %% The above copyright notice and this permission notice shall be included 27 | %% in all copies or substantial portions of the Software. 28 | %% 29 | %% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 30 | %% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 31 | %% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 32 | %% IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 33 | %% CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 34 | %% TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 35 | %% SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 36 | %%------------------------------------------------------------------------------ 37 | -module(throttle). 38 | -export([new/1, new/2, new/3, available/1, available/2, used/1, used/2]). 39 | -export([next_timeout/1, call/2, call/3, call/4, call/5]). 40 | -export([now/0, reset/1, reset/2, add/1, add/2, add/3, curr_rps/1, curr_rps/2]). 41 | 42 | -compile({no_auto_import,[now/0]}). 43 | 44 | -record(throttle, { 45 | rate 46 | , window :: integer() %% In microseconds 47 | , step :: integer() %% In microseconds 48 | , next_ts :: integer() 49 | }). 50 | 51 | -type throttle() :: #throttle{}. 52 | -type time() :: non_neg_integer(). 53 | 54 | -type throttle_opts() :: #{ 55 | retries => integer(), 56 | retry_delay => integer(), 57 | blocking => boolean() 58 | }. 59 | %% `retries' - number of retries. 60 | %% `retry_delay' - delay in milliseconds between successive retries. 61 | %% `blocking' - instructs to block the call if throttled. 62 | 63 | -type throttle_result() :: 64 | {ok, any()} | {error, throttled | {Reason::any(), StackTrace::list()}}. 65 | 66 | -ifdef(TEST). 67 | -include_lib("eunit/include/eunit.hrl"). 68 | -endif. 69 | 70 | %% @doc Create a new throttle given the `Rate' per second. 71 | -spec new(non_neg_integer()) -> throttle(). 72 | new(Rate) -> 73 | new(Rate, 1000). 74 | 75 | %% @see new/3 76 | -spec new(non_neg_integer(), non_neg_integer()) -> throttle(). 77 | new(Rate, Window) -> 78 | new(Rate, Window, now()). 79 | 80 | %% @doc Create a new throttle given the `Rate' per `Window' milliseconds. 81 | %% `Now' is expressesed in microseconds since epoch using `now()'. 82 | -spec new(non_neg_integer(), non_neg_integer(), time()) -> throttle(). 83 | new(Rate, Window, Now) when is_integer(Rate), is_integer(Window), is_integer(Now) -> 84 | Win = Window * 1000, 85 | Step = if Rate == 0 -> 0; true -> Win div Rate end, 86 | #throttle{rate = Rate, window = Win, step = Step, next_ts = Now}. 87 | 88 | %% @see reset/2 89 | reset(#throttle{} = T) -> 90 | reset(T, now()). 91 | 92 | %% @doc Reset the throttle request counter 93 | reset(#throttle{} = T, Now) when is_integer(Now) -> 94 | T#throttle{next_ts = Now}. 95 | 96 | %% @doc Call the lambda `F', ensuring that it's not called more 97 | %% frequently than the throttle would allow. 98 | %% 99 | %% Example: 100 | %% 101 | %% 1> T = throttle:new(10, 1000). 102 | %% 2> lists:foldl(fun(_,{T1,A}) -> 103 | %% {T2,R} = throttle:call(T1, fun() -> http:get("google.com") end), 104 | %% {T2, [R|A]} 105 | %% end, {T,[]}, lists:seq(1, 100)). 106 | %% 107 | call(T, F) -> 108 | call2(T, F, #{}, now()). 109 | 110 | %% @doc Call the lambda `F', ensuring that it's not called more 111 | %% often then the throttle would allow. `Opts' are a map of options. 112 | %% When `{retries, R}' option is given and `R' is greater than 0, the 113 | %% throttler will call the function `F()' up to `R' times if the `F()' 114 | %% raises an exception. The delay between retries is controlled by 115 | %% the `{retry_delay, D}' options, expressed in milliseconds (default: `1') 116 | %% between successive executions of `F()'. 117 | %% If `F()' still raises an exception after the R's retry, that exception 118 | %% would be reraised and it would be the responsibility of the caller 119 | %% to handle it. 120 | -spec call(#throttle{}, fun(() -> any()), throttle_opts()) -> 121 | {#throttle{}, throttle_result()}. 122 | call(#throttle{} = T, F, Opts) when is_function(F, 0), is_map(Opts) -> 123 | call2(T, F, Opts, now()). 124 | 125 | %% @doc Call M,F,A, ensuring that it's not called more frequently than the 126 | %% throttle would allow. 127 | %% 128 | %% Example: 129 | %% 130 | %% 1> T = throttle:new(10, 1000). 131 | %% 2> lists:foldl(fun(_,{T1,A}) -> 132 | %% {T2,R} = throttle:call(T1, http, get, ["google.com"]), 133 | %% {T2, [R|A]} 134 | %% end, {T,[]}, lists:seq(1, 100)). 135 | %% 136 | call(T, M,F,A) when is_atom(M), is_atom(F), is_list(A) -> 137 | call(T, M,F,A, #{}, now()); 138 | call(T, F, Opts, Now) when is_function(F, 0), is_map(Opts), is_integer(Now) -> 139 | call2(T, F, Opts, Now). 140 | 141 | %% @doc Call M,F,A, ensuring that it's not called more frequently than the 142 | %% throttle would allow. 143 | call(T, M,F,A, Now) when is_integer(Now) -> 144 | call(T, M,F,A, #{}, Now); 145 | call(T, M,F,A, Opts) when is_map(Opts) -> 146 | call(T, M,F,A, Opts, now()). 147 | 148 | %% @doc Call M,F,A, ensuring that it's not called more frequently than the 149 | %% throttle would allow. 150 | -spec call(#throttle{}, atom(), atom(), [any()], non_neg_integer(), throttle_opts()) -> 151 | {#throttle{}, throttle_result()}. 152 | call(#throttle{} = T, M,F,A, Opts, Now) when is_atom(M), is_atom(F), is_list(A) -> 153 | call2(T, fun() -> apply(M,F,A) end, Opts, Now). 154 | 155 | -spec call2(#throttle{}, fun(() -> any()), throttle_opts(), non_neg_integer()) -> 156 | {#throttle{}, throttle_result()}. 157 | call2(#throttle{} = T, F, Opts, Now) when is_integer(Now), is_function(F, 0), is_map(Opts) -> 158 | Retries = maps:get(retries, Opts, 0), 159 | DelayMS = maps:get(retry_delay, Opts, 1), 160 | Block = maps:get(blocking, Opts, true), 161 | call3(T, F, Now, Block, Retries, DelayMS). 162 | 163 | call3(T, F, Now, Block, Retries, DelayMS) -> 164 | case next_timeout(T, Now) of 165 | 0 -> 166 | {1, T1} = add(T, 1, Now), 167 | Result = try {ok, F()} catch _:R:Trace -> {retry, {R, Trace}} end, 168 | case Result of 169 | {ok, _} -> 170 | {T1, Result}; 171 | {retry, _} when Retries > 0 -> 172 | receive after DelayMS -> ok end, 173 | call3(T, F, now(), Block, Retries-1, DelayMS); 174 | {retry, Error} -> 175 | {error, Error} 176 | end; 177 | _ when not Block -> 178 | {error, throttled}; 179 | WaitMS -> 180 | receive after WaitMS -> ok end, 181 | call3(T, F, now(), Block, Retries, DelayMS) 182 | end. 183 | 184 | %% @doc Add one sample to the throttle 185 | add(T) -> add(T, 1). 186 | 187 | %% @doc Add `Samples' to the throttle 188 | add(T, Samples) -> add(T, Samples, now()). 189 | 190 | %% @doc Add `Samples' to the throtlle. 191 | %% Return `{FitSamples, State}', where `FitSamples' are the number of samples 192 | %% that fit in the throttling window. 0 means that the throttler is fully 193 | %% congested, and more time needs to elapse before the throttles gets reset 194 | %% to accept more samples. 195 | -spec add(throttle(), integer(), time()) -> {integer(), throttle()}. 196 | add(#throttle{rate = 0}, Samples, _Now) -> 197 | Samples; 198 | add(#throttle{next_ts = TS, step = Step, window = Win} = T, Samples, Now) -> 199 | NextTS = TS + Samples * Step, 200 | NowNextTS = Now + Win, 201 | Diff = NextTS - NowNextTS, 202 | if 203 | Diff < -Win -> 204 | {Samples, T#throttle{next_ts = Now + Step}}; 205 | Diff < 0 -> 206 | {Samples, T#throttle{next_ts = NextTS}}; 207 | true -> 208 | N = max(0, Samples - (Diff div Step)), 209 | {N, T#throttle{next_ts = TS + N * Step}} 210 | end. 211 | 212 | %% @see available/2 213 | available(T) -> available(T, now()). 214 | 215 | %% @doc Return the number of available samples given `Now' current time. 216 | available(#throttle{rate=0}=T,_Now) -> T#throttle.window; 217 | available(#throttle{} =T, Now) -> calc_available(T, Now). 218 | 219 | %% @see used/2 220 | used(T) -> used(T, now()). 221 | 222 | %% @doc Return the number of used samples given `a_now' current time. 223 | used(#throttle{rate = 0}, _Now) -> 0; 224 | used(#throttle{rate = R} = T, Now) -> R-calc_available(T, Now). 225 | 226 | %% @doc Return the number of milliseconds to wait until the throttling 227 | %% threshold is satisfied to fit another sample. 228 | next_timeout(T) -> next_timeout(T, now()). 229 | next_timeout(#throttle{next_ts = TS, step = Step, window = Win}, Now) -> 230 | NextTS = TS + Step, 231 | NowNextTS = Now + Win, 232 | Diff = NextTS - NowNextTS, 233 | if 234 | Diff =< 0 -> 0; 235 | true -> ceil(Diff / 1000) 236 | end. 237 | 238 | %% @see curr_rps/2 239 | curr_rps(T) -> curr_rps(T, now()). 240 | 241 | %% @doc Return currently used rate per second. 242 | curr_rps(#throttle{rate=0}, _Now) -> 0; 243 | curr_rps(#throttle{rate=R}=T, Now) -> 244 | (R-calc_available(T, Now))*1000000/T#throttle.window. 245 | 246 | now() -> 247 | erlang:system_time(microsecond). 248 | 249 | %%------------------------------------------------------------------------------ 250 | %% Internal functions 251 | %%------------------------------------------------------------------------------ 252 | 253 | %% Return the number of available samples given `Now' current time. 254 | calc_available(#throttle{rate=R, window=W, step=S} = T, Now) -> 255 | Diff = Now - T#throttle.next_ts, 256 | if Diff >= 0 -> R; 257 | true -> min(R, max(0, (W+Diff) div S)) 258 | end. 259 | 260 | %%------------------------------------------------------------------------------ 261 | %% Unit testing 262 | %%------------------------------------------------------------------------------ 263 | 264 | -ifdef(EUNIT). 265 | time(TS, US) -> erlang:universaltime_to_posixtime(TS) * 1000000 + US. 266 | 267 | all_test() -> 268 | 269 | Now = time({{2015, 6, 1}, {11,59,58}}, 900000), 270 | Thr = throttle:new(10, 1000, Now), %% Throttle 10 samples / sec 271 | ?assertEqual(100000, Thr#throttle.step), 272 | ?assertEqual(10, throttle:available(Thr, Now)), 273 | {N, T1} = throttle:add(Thr, 1, Now), 274 | ?assertEqual(1, N), 275 | ?assertEqual(9, throttle:available(T1, Now)), 276 | ?assertEqual(1, throttle:used(T1, Now)), 277 | 278 | Now1 = time({{2015, 6, 1}, {11,59,58}}, 999999), 279 | ?assertEqual(9, throttle:available(T1, Now1)), 280 | ?assertEqual(1, throttle:used(T1, Now1)), 281 | 282 | Now2 = time({{2015, 6, 1}, {11,59,59}}, 0), 283 | ?assertEqual(10,throttle:available(T1, Now2)), 284 | ?assertEqual(0, throttle:used(T1, Now2)), 285 | 286 | Now3 = time({{2015, 6, 1}, {12,0,0}}, 0), 287 | % 1 second elapsed, the throttler's interval is reset, and 10 samples are available 288 | ?assertEqual(10,throttle:available(T1, Now3)), 289 | ?assertEqual(0, throttle:used(T1, Now2)), 290 | 291 | {N1, T2} = throttle:add(T1, 1, Now3), 292 | ?assertEqual(1, N1), 293 | ?assertEqual(9, throttle:available(T2, Now3)), 294 | ?assertEqual(1, throttle:used(T2, Now3)), 295 | 296 | TT = throttle:new(5, 1000), 297 | Now4 = now(), 298 | {_,RR} = lists:foldl(fun(_,{TT1,A}) -> 299 | {TT2, R} = throttle:call(TT1, erlang, system_time, [millisecond]), 300 | {TT2, [R|A]} 301 | end, {TT, []}, lists:seq(1, 15)), 302 | Now5 = now(), 303 | 304 | ?assertEqual(15, length(RR)), 305 | ?assert(Now5 - Now4 >= 2000000), 306 | 307 | TT2 = throttle:new(5, 1000), 308 | {_,RR1} = lists:foldl(fun(_,{TT3,A}) -> 309 | {TT4, R} = throttle:call(TT3, fun() -> erlang:system_time(millisecond) end), 310 | {TT4, [R|A]} 311 | end, {TT2, []}, lists:seq(1, 15)), 312 | Now6 = now(), 313 | 314 | ?assertEqual(15, length(RR1)), 315 | ?assert(Now6 - Now5 >= 2000000), 316 | 317 | ok. 318 | 319 | retry_ok_test() -> 320 | Now = now(), 321 | Opts = #{retries => 3, retry_delay => 100}, 322 | TT = throttle:new(10, 1000), 323 | Inc = fun(undefined) -> 1; (N) -> N+1 end, 324 | F = fun() -> 325 | case get(count) of 326 | 2 -> success; 327 | N -> put(count, Inc(N)), erlang:error(exception) 328 | end 329 | end, 330 | {_, R} = throttle:call(TT, F, Opts, Now), 331 | erase(count), 332 | ?assertEqual({ok, success}, R). 333 | 334 | retry_fail_test() -> 335 | Now = now(), 336 | Opts = #{retries => 3, retry_delay => 100}, 337 | TT = throttle:new(10, 1000), 338 | {error, {exception, _}} = throttle:call(TT, fun() -> erlang:error(exception) end, Opts, Now), 339 | Diff = now() - Now, 340 | %% Expected delay should be around 300ms 341 | ?assert(Diff >= 300000), 342 | ?assert(Diff < 400000). 343 | 344 | retry_fail_no_block_test() -> 345 | Now = now(), 346 | Opts = #{retries => 3, retry_delay => 0}, 347 | TT = throttle:new(10, 1000), 348 | {error, {exception, _}} = throttle:call(TT, fun() -> erlang:error(exception) end, Opts, Now), 349 | Diff = now() - Now, 350 | %% Expected delay should be around 0ms 351 | ?assert(Diff > 0), 352 | ?assert(Diff < 100). 353 | 354 | -endif. 355 | 356 | -------------------------------------------------------------------------------- /src/trunc_io.erl: -------------------------------------------------------------------------------- 1 | %% ``The contents of this file are subject to the Erlang Public License, 2 | %% Version 1.1, (the "License"); you may not use this file except in 3 | %% compliance with the License. You should have received a copy of the 4 | %% Erlang Public License along with your Erlang distribution. If not, it can be 5 | %% retrieved via the world wide web at http://www.erlang.org/. 6 | %% 7 | %% Software distributed under the License is distributed on an "AS IS" 8 | %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 9 | %% the License for the specific language governing rights and limitations 10 | %% under the License. 11 | %% 12 | %% The Initial Developer of the Original Code is Corelatus AB. 13 | %% Portions created by Corelatus are Copyright 2003, Corelatus 14 | %% AB. All Rights Reserved.'' 15 | %% 16 | %% @doc Module to print out terms for logging. Limits by length rather than depth. 17 | %% 18 | %% The resulting string may be slightly larger than the limit; the intention 19 | %% is to provide predictable CPU and memory consumption for formatting 20 | %% terms, not produce precise string lengths. 21 | %% 22 | %% Typical use: 23 | %% 24 | %% trunc_io:print(Term, 500). 25 | %% 26 | %% Source license: Erlang Public License. 27 | %% Original author: Matthias Lang, `matthias@corelatus.se' 28 | 29 | -module(trunc_io). 30 | -author('matthias@corelatus.se'). 31 | %% And thanks to Chris Newcombe for a bug fix 32 | -export([print/2, fprint/2, safe/2]). % interface functions 33 | -export([perf/0, perf/3, perf1/0, test/0, test/2]). % testing functions 34 | -version("$Id: trunc_io.erl,v 1.11 2009-02-23 12:01:06 matthias Exp $"). 35 | 36 | 37 | %% @doc Returns an flattened list containing the ASCII representation of the given 38 | %% term. 39 | -spec fprint(term(), pos_integer()) -> string(). 40 | fprint(T, Max) -> 41 | {L, _} = print(T, Max), 42 | lists:flatten(L). 43 | 44 | %% @doc Same as print, but never crashes. 45 | %% 46 | %% This is a tradeoff. Print might conceivably crash if it's asked to 47 | %% print something it doesn't understand, for example some new data 48 | %% type in a future version of Erlang. If print crashes, we fall back 49 | %% to io_lib to format the term, but then the formatting is 50 | %% depth-limited instead of length limited, so you might run out 51 | %% memory printing it. Out of the frying pan and into the fire. 52 | %% 53 | -spec safe(term(), pos_integer()) -> {string(), pos_integer()} | {string()}. 54 | safe(What, Len) -> 55 | case catch print(What, Len) of 56 | {L, Used} when is_list(L) -> {L, Used}; 57 | _ -> {"unable to print" ++ io_lib:write(What, 99)} 58 | end. 59 | 60 | %% @doc Returns {List, Length} 61 | -spec print(term(), pos_integer()) -> {iolist(), pos_integer()}. 62 | print(_, Max) when Max < 0 -> {"...", 3}; 63 | print(Tuple, Max) when is_tuple(Tuple) -> 64 | {TC, Len} = tuple_contents(Tuple, Max-2), 65 | {[${, TC, $}], Len + 2}; 66 | 67 | %% @doc We assume atoms, floats, funs, integers, PIDs, ports and refs never need 68 | %% to be truncated. This isn't strictly true, someone could make an 69 | %% arbitrarily long bignum. Let's assume that won't happen unless someone 70 | %% is being malicious. 71 | %% 72 | print(Atom, _Max) when is_atom(Atom) -> 73 | L = atom_to_list(Atom), 74 | {L, length(L)}; 75 | 76 | print(<<>>, _Max) -> 77 | {"<<>>", 4}; 78 | 79 | print(Binary, Max) when is_binary(Binary) -> 80 | B = binary_to_list(Binary, 1, lists:min([Max, size(Binary)])), 81 | {L, Len} = alist_start(B, Max-4), 82 | {["<<", L, ">>"], Len}; 83 | 84 | print(Float, _Max) when is_float(Float) -> 85 | L = float_to_list(Float), 86 | {L, length(L)}; 87 | 88 | print(Fun, _Max) when is_function(Fun) -> 89 | L = erlang:fun_to_list(Fun), 90 | {L, length(L)}; 91 | 92 | print(Integer, _Max) when is_integer(Integer) -> 93 | L = integer_to_list(Integer), 94 | {L, length(L)}; 95 | 96 | print(Pid, _Max) when is_pid(Pid) -> 97 | L = pid_to_list(Pid), 98 | {L, length(L)}; 99 | 100 | print(Ref, _Max) when is_reference(Ref) -> 101 | L = erlang:ref_to_list(Ref), 102 | {L, length(L)}; 103 | 104 | print(Port, _Max) when is_port(Port) -> 105 | L = erlang:port_to_list(Port), 106 | {L, length(L)}; 107 | 108 | print(List, Max) when is_list(List) -> 109 | alist_start(List, Max). 110 | 111 | %% Returns {List, Length} 112 | tuple_contents(Tuple, Max) -> 113 | L = tuple_to_list(Tuple), 114 | list_body(L, Max). 115 | 116 | %% Format the inside of a list, i.e. do not add a leading [ or trailing ]. 117 | %% Returns {List, Length} 118 | list_body([], _) -> {[], 0}; 119 | list_body(_, Max) when Max < 4 -> {"...", 3}; 120 | list_body([H|T], Max) -> 121 | {List, Len} = print(H, Max), 122 | {Final, FLen} = list_bodyc(T, Max - Len), 123 | {[List|Final], FLen + Len}; 124 | list_body(X, Max) -> %% improper list 125 | {List, Len} = print(X, Max - 1), 126 | {[$|,List], Len + 1}. 127 | 128 | list_bodyc([], _) -> {[], 0}; 129 | list_bodyc(_, Max) when Max < 4 -> {"...", 3}; 130 | list_bodyc([H|T], Max) -> 131 | {List, Len} = print(H, Max), 132 | {Final, FLen} = list_bodyc(T, Max - Len - 1), 133 | {[$,, List|Final], FLen + Len + 1}; 134 | list_bodyc(X,Max) -> %% improper list 135 | {List, Len} = print(X, Max - 1), 136 | {[$|,List], Len + 1}. 137 | 138 | %% The head of a list we hope is ascii. Examples: 139 | %% 140 | %% [65,66,67] -> "ABC" 141 | %% [65,0,67] -> "A"[0,67] 142 | %% [0,65,66] -> [0,65,66] 143 | %% [65,b,66] -> "A"[b,66] 144 | %% 145 | alist_start([], _) -> {"[]", 2}; 146 | alist_start(_, Max) when Max < 4 -> {"...", 3}; 147 | alist_start([H|T], Max) when H >= 16#20, H =< 16#7e -> % definitely printable 148 | {L, Len} = alist([H|T], Max-1), 149 | {[$\"|L], Len + 1}; 150 | alist_start([H|T], Max) when H == 9; H == 10; H == 13 -> % show as space 151 | {L, Len} = alist(T, Max-1), 152 | {[$ |L], Len + 1}; 153 | alist_start(L, Max) -> 154 | {R, Len} = list_body(L, Max-2), 155 | {[$[, R, $]], Len + 2}. 156 | 157 | alist([], _) -> {"\"", 1}; 158 | alist(_, Max) when Max < 5 -> {"...\"", 4}; 159 | alist([H|T], Max) when H >= 16#20, H =< 16#7e -> % definitely printable 160 | {L, Len} = alist(T, Max-1), 161 | {[H|L], Len + 1}; 162 | alist([H|T], Max) when H == 9; H == 10; H == 13 -> % show as space 163 | {L, Len} = alist(T, Max-1), 164 | {[$ |L], Len + 1}; 165 | alist(L, Max) -> 166 | {R, Len} = list_body(L, Max-3), 167 | {[$\", $[, R, $]], Len + 3}. 168 | 169 | 170 | %%-------------------- 171 | %% The start of a test suite. So far, it only checks for not crashing. 172 | %% @hidden 173 | -spec test() -> ok. 174 | test() -> 175 | test(trunc_io, print). 176 | 177 | %% @hidden 178 | -spec test(atom(), atom()) -> ok. 179 | test(Mod, Func) -> 180 | Simple_items = [atom, 1234, 1234.0, {tuple}, [], [list], "string", self(), 181 | <<1,2,3>>, make_ref(), fun() -> ok end], 182 | F = fun(A) -> 183 | Mod:Func(A, 100), 184 | Mod:Func(A, 2), 185 | Mod:Func(A, 20) 186 | end, 187 | 188 | G = fun(A) -> 189 | case catch F(A) of 190 | {'EXIT', _} -> exit({failed, A}); 191 | _ -> ok 192 | end 193 | end, 194 | 195 | lists:foreach(G, Simple_items), 196 | 197 | Tuples = [ {1,2,3,a,b,c}, {"abc", def, 1234}, 198 | {{{{a},b,c,{d},e}},f}], 199 | 200 | Lists = [ [1,2,3,4,5,6,7], lists:seq(1,1000), 201 | [{a}, {a,b}, {a, [b,c]}, "def"], [a|b], [$a|$b] ], 202 | 203 | 204 | lists:foreach(G, Tuples), 205 | lists:foreach(G, Lists). 206 | 207 | %% @hidden 208 | -spec perf() -> ok. 209 | perf() -> 210 | {New, _} = timer:tc(trunc_io, perf, [trunc_io, print, 1000]), 211 | {Old, _} = timer:tc(trunc_io, perf, [io_lib, write, 1000]), 212 | io:fwrite("New code took ~p us, old code ~p\n", [New, Old]). 213 | 214 | %% @hidden 215 | -spec perf(atom(), atom(), integer()) -> done. 216 | perf(M, F, Reps) when Reps > 0 -> 217 | test(M,F), 218 | perf(M,F,Reps-1); 219 | perf(_,_,_) -> 220 | done. 221 | 222 | %% @hidden 223 | %% Performance test. Needs a particularly large term I saved as a binary... 224 | -spec perf1() -> {non_neg_integer(), non_neg_integer()}. 225 | perf1() -> 226 | {ok, Bin} = file:read_file("bin"), 227 | A = binary_to_term(Bin), 228 | {N, _} = timer:tc(trunc_io, print, [A, 1500]), 229 | {M, _} = timer:tc(io_lib, write, [A]), 230 | {N, M}. 231 | -------------------------------------------------------------------------------- /src/ttl_map.erl: -------------------------------------------------------------------------------- 1 | %%------------------------------------------------------------------------------ 2 | %% @doc Map with TTL key/value eviction. 3 | %% 4 | %% An insert of a Key/Value pair in the map will store the timestamp of the 5 | %% maybe_add. Additionally a queue of maybe_adds is maintained by this container, 6 | %% which is checked on each insert and the expired Key/Value pairs are 7 | %% evicted from the map. 8 | %% 9 | %% @author Serge Aleynikov 10 | %% @end 11 | %%------------------------------------------------------------------------------ 12 | %% Copyright (c) 2011 Serge Aleynikov 13 | %% 14 | %% Permission is hereby granted, free of charge, to any person 15 | %% obtaining a copy of this software and associated documentation 16 | %% files (the "Software"), to deal in the Software without restriction, 17 | %% including without limitation the rights to use, copy, modify, merge, 18 | %% publish, distribute, sublicense, and/or sell copies of the Software, 19 | %% and to permit persons to whom the Software is furnished to do 20 | %% so, subject to the following conditions: 21 | %% 22 | %% The above copyright notice and this permission notice shall be included 23 | %% in all copies or substantial portions of the Software. 24 | %% 25 | %% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 26 | %% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 27 | %% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 28 | %% IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 29 | %% CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 30 | %% TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 31 | %% SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 32 | %%------------------------------------------------------------------------------ 33 | -module(ttl_map). 34 | -author('saleyn@gmail.com'). 35 | 36 | -export([new/1, new/2, try_add/4, size/1, evict/2, evict/3, now/0]). 37 | 38 | -compile({no_auto_import,[now/0, size/1]}). 39 | 40 | -record(ttl_map, {ets, q, ttl}). 41 | 42 | -type ttl_map() :: #ttl_map{}. 43 | 44 | -ifdef(TEST). 45 | -include_lib("eunit/include/eunit.hrl"). 46 | -endif. 47 | 48 | %% @doc Create a new map with a given TTL time for inserted items 49 | new(TTL) -> 50 | new(TTL, #{}). 51 | 52 | %% @doc Create a new map with a given TTL time for inserted items. 53 | %% `Opts' is a list of options: 54 | %%
55 | %%
name
The name of the ETS table (defaults to `undefined')
56 | %%
access
The access level of the ETS table (defaults to `private')
57 | %%
58 | new(TTL, Opts) when is_integer(TTL), is_map(Opts) -> 59 | Name = maps:get(name, Opts, undefined), 60 | ACL = maps:get(access, Opts, private), 61 | EtsOpts = 62 | case Name of 63 | undefined -> [ACL]; 64 | _ -> [named_table, ACL] 65 | end, 66 | #ttl_map{ets = ets:new(Name, EtsOpts), q = queue:new(), ttl = TTL}. 67 | 68 | %% @doc Try to add a `Key/Value' pair to the map. 69 | %% If more than TTL time elapsed since the last insert of the `Key' or the 70 | %% `Key' is not found in the map, the value is inserted, otherwise no insertion 71 | %% is made. 72 | -spec try_add(ttl_map(), any(), any(), non_neg_integer()) -> {ttl_map(), Inserted::boolean()}. 73 | try_add(TTLMap = #ttl_map{ets = ETS, q = Q}, Key, Value, Now) when is_integer(Now) -> 74 | TTLMap1 = evict(TTLMap, Now), %% Evict stale entries from the ETS 75 | case ets:lookup(ETS, Key) of 76 | [] -> 77 | ets:insert(ETS, {Key, {Value, Now}}), 78 | {TTLMap1#ttl_map{q = queue:in({Now, Key}, Q)}, true}; 79 | [_] -> 80 | {TTLMap1, false} 81 | end. 82 | 83 | %% @doc Evict stale items from the map given the current timestamp `Now'. 84 | -spec evict(ttl_map(), non_neg_integer()) -> ttl_map(). 85 | evict(TTLMap = #ttl_map{ets = ETS, q = Q, ttl = TTL}, Now) -> 86 | Threshold = Now - TTL, 87 | Size = size(TTLMap), 88 | {R, Q1} = peek(Q), 89 | case dropwhile(Q1, R, ETS, 0, Threshold, Size) of 90 | {_, 0} -> TTLMap#ttl_map{q = Q1}; 91 | {Q2, _} -> TTLMap#ttl_map{q = Q2} 92 | end. 93 | 94 | %% @doc Evict stale items (up to the `Limit') from the map given the current timestamp `Now'. 95 | -spec evict(ttl_map(), non_neg_integer(), non_neg_integer()) -> ttl_map(). 96 | evict(TTLMap = #ttl_map{ets = ETS, q = Q, ttl = TTL}, Now, Limit) -> 97 | Threshold = Now - TTL, 98 | {R, Q1} = peek(Q), 99 | case dropwhile(Q1, R, ETS, 0, Threshold, Limit) of 100 | {_, 0} -> TTLMap#ttl_map{q = Q1}; 101 | {Q2, _} -> TTLMap#ttl_map{q = Q2} 102 | end. 103 | 104 | %% @doc Get the number of items in the map. 105 | -spec size(ttl_map()) -> non_neg_integer(). 106 | size(#ttl_map{ets = ETS}) -> 107 | ets:info(ETS, size). 108 | 109 | %% @doc Get the current timestamp in microseconds since Unix epoch. 110 | -spec now() -> non_neg_integer(). 111 | now() -> 112 | erlang:system_time(microsecond). 113 | 114 | %%------------------------------------------------------------------------------ 115 | %% Internal functions 116 | %%------------------------------------------------------------------------------ 117 | 118 | dropwhile(Q, {value, {Time, Key}}, ETS, N, Threshold, I) when Time =< Threshold, I > 0 -> 119 | ets:delete(ETS, Key), 120 | Q1 = queue:drop(Q), %% Evict first element from the queue 121 | {Res, Q2} = peek(Q1), %% Pick the next element in the queue 122 | dropwhile(Q2, Res, ETS, N+1, Threshold, I-1); 123 | dropwhile(Q, _, _, N, _, _) -> 124 | {Q, N}. 125 | 126 | %% We use this implementation of `peek' instead of the `queue:peek/1' because 127 | %% the later will occasionally call `lists:reverse/1' when the second list in 128 | %% the queue is empty, and wouldn't update the queue, whereas we want to memorize 129 | %% the result of reversal if one has been made. 130 | peek({_, [V|_]}=Q) -> {{value, V}, Q}; 131 | peek({[], []}=Q) -> {undefined, Q}; 132 | peek({[V],[]}=Q) -> {{value, V}, Q}; 133 | peek({[Y|In],[]}) -> 134 | [V|_] = L = lists:reverse(In, []), 135 | {{value,V}, {[Y], L}}. 136 | 137 | %%------------------------------------------------------------------------------ 138 | %% Unit testing 139 | %%------------------------------------------------------------------------------ 140 | 141 | -ifdef(EUNIT). 142 | 143 | add_test() -> 144 | %fun() -> 145 | Map0 = ttl_map:new(1000), 146 | ?assertEqual(0, size(Map0)), 147 | {Map1, R1} = ttl_map:try_add(Map0, 1, 123, 5000), 148 | ?assertEqual(1, ttl_map:size(Map1)), 149 | ?assert(R1), 150 | {Map2, R2} = ttl_map:try_add(Map1, 2, 234, 5001), 151 | ?assertEqual(2, ttl_map:size(Map2)), 152 | ?assert(R2), 153 | {Map3, R3} = ttl_map:try_add(Map2, 1, 124, 5999), 154 | ?assertEqual(2, ttl_map:size(Map3)), 155 | ?assertNot(R3), 156 | Map4 = ttl_map:evict(Map3, 6000), 157 | ?assertEqual(1, ttl_map:size(Map4)), 158 | {Map5, R5} = ttl_map:try_add(Map4, 1, 124, 6000), 159 | ?assertEqual(2, ttl_map:size(Map5)), 160 | ?assert(R5), 161 | Map6 = ttl_map:evict(Map5, 6500), 162 | ?assertEqual(1, ttl_map:size(Map6)), 163 | Map7 = ttl_map:evict(Map6, 7001), 164 | ?assertEqual(0, ttl_map:size(Map7)), 165 | ?assertEqual(queue:new(), Map7#ttl_map.q), 166 | ok. 167 | %end. 168 | 169 | -endif. 170 | -------------------------------------------------------------------------------- /src/user_default.erl: -------------------------------------------------------------------------------- 1 | %%%vim:ts=2:sw=2:et 2 | %%%------------------------------------------------------------------------ 3 | %%% File: $Id$ 4 | %%%------------------------------------------------------------------------ 5 | %%% @doc This is an extension of the shell commands 6 | %%% to do all the work! Either place this file in the 7 | %%% path accessible to Erlang (via ERL_LIBS) or 8 | %%% add this line to the ~/.erlang file: 9 | %%% ``code:load_abs(os:getenv("HOME") ++ "/.erlang/user_default").'' 10 | %%% 11 | %%% @author Serge Aleynikov 12 | %%% @version $Revision$ 13 | %%% $Date$ 14 | %%% @end 15 | %%%------------------------------------------------------------------------ 16 | %%% $URL$ 17 | %%%------------------------------------------------------------------------ 18 | %%% ``The contents of this file are subject to the Erlang Public License, 19 | %%% Version 1.1, (the "License"); you may not use this file except in 20 | %%% compliance with the License. You should have received a copy of the 21 | %%% Erlang Public License along with this software. If not, it can be 22 | %%% retrieved via the world wide web at http://www.erlang.org/. 23 | %%% 24 | %%% Software distributed under the License is distributed on an "AS IS" 25 | %%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 26 | %%% the License for the specific language governing rights and limitations 27 | %%% under the License. 28 | %%% 29 | %%% The Initial Developer of the Original Code is Serge Aleynikov. 30 | %%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings 31 | %%% AB. All Rights Reserved.'' 32 | %%%------------------------------------------------------------------------ 33 | -module(user_default). 34 | -author('saleyn@gmail.com'). 35 | 36 | -export([help/0, saveh/1, debug/0, dbgtc/1, dbgon/1, dbgon/2, 37 | dbgadd/1, dbgadd/2, dbgdel/1, dbgdel/2, dbgoff/0, 38 | p/1, nl/0, tc/2, tc/4]). 39 | 40 | -import(io, [format/1, format/2]). 41 | 42 | help() -> 43 | shell_default:help(), 44 | format("** user extended commands **~n"), 45 | format("saveh(File) -- save command history to a file\n"), 46 | format("debug() -- start the debugger application\n"), 47 | format("debug(Mods) -- start the debugger application and add the list of modules\n"), 48 | format("dbgtc(File) -- use dbg:trace_client() to read data from File\n"), 49 | format("dbgon(M) -- enable dbg tracer on all funs in module(s) M :: atom()|[atom()]\n"), 50 | format("dbgon(M,Fun) -- enable dbg tracer for module M and function F\n"), 51 | format("dbgon(M,File) -- enable dbg tracer for module M and log to File\n"), 52 | format("dbgadd(M) -- enable call tracer for module(s) M :: atom()|[atom()]\n"), 53 | format("dbgadd(M,F) -- enable call tracer for function M:F\n"), 54 | format("dbgdel(M) -- disable call tracer for module(s) M :: atom()|[atom()]\n"), 55 | format("dbgdel(M,F) -- disable call tracer for function M:F\n"), 56 | format("dbgoff() -- disable dbg tracer (calls dbg:stop/0)\n"), 57 | format("p(Term) -- print term using io:format(\"~s\\n\", [Term])\n", ["~p"]), 58 | format("nl() -- load all changed modules on all known nodes\n"), 59 | format("tc(N,M,F,A) -- evaluate {M,F,A} N times and return {MkSecs/call, Result}\n"), 60 | format("tc(N,F) -- evaluate F N times and return {MkSecs/call, Result}\n"), 61 | true. 62 | 63 | %% These are in alphabetic order it would be nice if they were to *stay* so! 64 | 65 | debug() -> 66 | debug([]). 67 | 68 | debug(Modules) when is_list(Modules) -> 69 | R = debugger:start(), 70 | i:iaa([break]), 71 | [i:ii(M) || M <- Modules], 72 | R. 73 | 74 | dbgtc(File) -> 75 | Fun = fun({trace,_,call,{M,F,A}}, _) -> io:format("call: ~w:~w~w~n", [M,F,A]); 76 | ({trace,_,return_from,{M,F,A},R}, _) -> io:format("retn: ~w:~w/~w -> ~w~n", [M,F,A,R]); 77 | (A,B) -> io:format("~w: ~w~n", [A,B]) end, 78 | dbg:trace_client(file, File, {Fun, []}). 79 | 80 | dbgon(Modules) when is_atom(Modules); is_list(Modules) -> 81 | case dbg:tracer() of 82 | {ok,_} -> 83 | dbg:p(all,call), 84 | dbgadd(Modules); 85 | Else -> 86 | Else 87 | end. 88 | 89 | dbgon(Module, Fun) when is_atom(Fun) -> 90 | {ok,_} = dbg:tracer(), 91 | dbg:p(all,call), 92 | dbg:tpl(Module, Fun, [{'_',[],[{return_trace}]}]), 93 | ok; 94 | 95 | dbgon(Module, File) when is_list(File) -> 96 | {ok,_} = dbg:tracer(port, dbg:trace_port(file, File)), 97 | dbg:p(all,call), 98 | dbgadd(Module). 99 | 100 | dbgadd(Module) when is_atom(Module) -> 101 | dbgadd([Module]); 102 | dbgadd(Modules) when is_list(Modules) -> 103 | [dbg:tpl(M, [{'_',[],[{return_trace}]}]) || M <- Modules], 104 | ok. 105 | 106 | dbgadd(Module, Fun) -> 107 | dbg:tpl(Module, Fun, [{'_',[],[{return_trace}]}]), 108 | ok. 109 | 110 | dbgdel(Module) when is_atom(Module) -> 111 | dbgdel([Module]); 112 | dbgdel(Modules) when is_list(Modules) -> 113 | [dbg:ctpl(M) || M <- Modules], 114 | ok. 115 | 116 | dbgdel(Module, Fun) -> 117 | dbg:ctpl(Module, Fun), 118 | ok. 119 | 120 | dbgoff() -> 121 | dbg:stop(). 122 | 123 | %% @doc Term printer 124 | p(Term) -> 125 | io:format("~p\n", [Term]). 126 | 127 | %% @doc Load all changed modules on all visible nodes 128 | 129 | nl() -> 130 | [io:format("Network loading ~p -> ~p~n", [M, c:nl(M)]) || M <- c:mm()], 131 | ok. 132 | 133 | %% @doc Save command history to file 134 | saveh(File) -> 135 | {ok, Io} = file:open(File, [write, read, delayed_write]), 136 | GetHist = fun() -> 137 | {links, [Shell|_]} = hd(process_info(self(), [links])), 138 | Shell ! {shell_req, self(), get_cmd}, 139 | receive {shell_rep, Shell, R} -> R end 140 | end, 141 | Commands = lists:sort([{N,C} || {{command, N}, C} <- GetHist()]), 142 | try 143 | [case Trees of 144 | [] -> ok; 145 | [T] -> io:format(Io, "~s.\n", [erl_prettypr:format(T)]); 146 | [T|Ts] -> io:format(Io, "~s~s.\n", [ 147 | erl_prettypr:format(T), [", "++erl_prettypr:format(Tree) || Tree <- Ts] 148 | ]) 149 | end || {_, Trees} <- Commands], 150 | ok 151 | after 152 | file:close(Io) 153 | end. 154 | 155 | % Profiling functions inspired by Ulf Wiger post: 156 | % http://www.erlang.org/pipermail/erlang-questions/2007-August/028462.html 157 | 158 | tc(N, F) when N > 0 -> 159 | time_it(fun() -> exit(call(N, N, F, erlang:system_time(microsecond))) end). 160 | 161 | tc(N, M, F, A) when N > 0 -> 162 | time_it(fun() -> exit(call(N, N, M, F, A, erlang:system_time(microsecond))) end). 163 | 164 | time_it(F) -> 165 | Pid = spawn_opt(F, [{min_heap_size, 16384}]), 166 | MRef = erlang:monitor(process, Pid), 167 | receive 168 | {'DOWN', MRef, process, _, Result} -> Result 169 | end. 170 | 171 | call(1, X, F, Time1) -> 172 | Res = (catch F()), 173 | return(X, Res, Time1, erlang:system_time(microsecond)); 174 | call(N, X, F, Time1) -> 175 | (catch F()), 176 | call(N-1, X, F, Time1). 177 | 178 | call(1, X, M, F, A, Time1) -> 179 | Res = (catch apply(M, F, A)), 180 | return(X, Res, Time1, erlang:system_time(microsecond)); 181 | call(N, X, M, F, A, Time1) -> 182 | catch apply(M, F, A), 183 | call(N-1, X, M, F, A, Time1). 184 | 185 | return(N, Res, Time1, Time2) -> 186 | Int = Time2 - Time1, 187 | {Int / N, Res}. 188 | 189 | -------------------------------------------------------------------------------- /src/util.app.src: -------------------------------------------------------------------------------- 1 | {application,util, 2 | [{description,"Miscellaneous utility modules"}, 3 | {vsn,"1.3.4"}, 4 | {modules,[]}, 5 | {registered,[]}, 6 | {applications,[kernel,stdlib]}, 7 | {env,[]}, 8 | {maintainers,["Serge Aleynikov"]}, 9 | {licenses,["BSD"]}, 10 | {links,[{"Github","https://github.com/saleyn/util"}]}]}. 11 | -------------------------------------------------------------------------------- /src/util_log_color_formatter.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% Implementation of coloring handler for the Erlang's logger. 3 | %% See [https://github.com/hauleth/logger_colorful]. 4 | %% 5 | %% == Options == 6 | %% 7 | %%
    8 | %%
  • `formatter' - parent formatter which will be used for message 9 | %% formatting
    • 10 | %%
  • `colors' - map of `logger:log_level()' and colors in form atom 11 | %% describing color name, or 2-ary or 3-ary tuple with 1 or 2 modifiers for 12 | %% the color
    • 13 | %%
14 | %% 15 | %% Available colors: 16 | %% 17 | %%
    18 | %%
  • `black'
    • 19 | %%
  • `red'
    • 20 | %%
  • `green'
    • 21 | %%
  • `yellow'
    • 22 | %%
  • `blue'
    • 23 | %%
  • `magenta'
    • 24 | %%
  • `cyan'
    • 25 | %%
  • `white'
    • 26 | %%
27 | %% 28 | %% Available modifiers: 29 | %% 30 | %%
    31 | %%
  • `fg' - set foreground color
    • 32 | %%
  • `bg' - set background color
    • 33 | %%
  • `bright' - use bright color
    • 34 | %%
35 | %% 36 | %% @end 37 | -module(util_log_color_formatter). 38 | 39 | -define(RESET, "\e[m"). 40 | -define(CLREOL, "\e[K"). 41 | -define(CSI(Code), ["\e[", integer_to_binary(Code), $m]). 42 | 43 | -export([check_config/1, format/2]). 44 | 45 | %% @hidden 46 | check_config(Config0) -> 47 | Formatter = maps:get(formatter, Config0, logger_formatter), 48 | Colors = maps:get(colors, Config0, #{}), 49 | case check_colors(Colors) of 50 | true -> 51 | Config = maps:without([formatter, colors], Config0), 52 | try_callback_call(Formatter, ?FUNCTION_NAME, [Config], ok); 53 | _ -> 54 | {error, invalid_colors} 55 | end. 56 | 57 | check_colors(Colors) when is_map(Colors) -> 58 | lists:all(fun check_value/1, maps:to_list(Colors)); 59 | check_colors(_Colors) -> false. 60 | 61 | check_value({Level, Color}) -> 62 | lists:member(Level, [emergency, alert, critical, error, warning, notice, info, debug]) 63 | andalso is_color(Color). 64 | 65 | -define(color(C), lists:member(C, [black, red, green, yellow, blue, magenta, cyan, white])). 66 | -define(mod(C), lists:member(C, [fg, bg, bright])). 67 | 68 | is_color(normal) -> true; 69 | is_color({Mod1, Mod2, Color}) -> 70 | ?mod(Mod1) andalso ?mod(Mod2) andalso ?color(Color); 71 | is_color({Mod, Color}) -> 72 | ?mod(Mod) andalso ?color(Color); 73 | is_color(Color) -> 74 | ?color(Color). 75 | 76 | %% @hidden 77 | format(#{level := Level} = Event, Config0) -> 78 | Formatter = maps:get(formatter, Config0, logger_formatter), 79 | Color = color(Level, Config0), 80 | Config = maps:without([formatter, colors], Config0), 81 | Formatted = Formatter:format(Event, Config), 82 | {Leading, Trailing} = string:take(Formatted, "\n", false, trailing), 83 | FullLines = string:replace(Leading, "\n", [$\n, ?CLREOL], all), 84 | [?RESET, Color, FullLines, ?CLREOL, ?RESET, Trailing]. 85 | 86 | color(Level, Config) -> 87 | Color = case Config of 88 | #{colors := #{Level := C}} -> C; 89 | _ -> default(Level) 90 | end, 91 | color_to_escape(Color). 92 | 93 | default(emergency) -> {bg, red}; 94 | default(alert) -> {bg, red}; 95 | default(critical) -> {bg, red}; 96 | default(error) -> red; 97 | default(warning) -> yellow; 98 | default(debug) -> blue; 99 | default(_) -> normal. 100 | 101 | color_to_escape(normal) -> []; 102 | color_to_escape({Mod, Color}) -> ?CSI(mod(Mod) + code(Color)); 103 | color_to_escape({Mod1, Mod2, Color}) -> 104 | ?CSI(mod(Mod1) + mod(Mod2) + code(Color)); 105 | color_to_escape(Color) -> ?CSI(code(Color)). 106 | 107 | mod(fg) -> 0; 108 | mod(bg) -> 10; 109 | mod(bright) -> 60. 110 | 111 | code(black) -> 30; 112 | code(red) -> 31; 113 | code(green) -> 32; 114 | code(yellow) -> 33; 115 | code(blue) -> 34; 116 | code(magenta) -> 35; 117 | code(cyan) -> 36; 118 | code(white) -> 37. 119 | 120 | try_callback_call(Module, Function, Args, DefRet) -> 121 | try 122 | apply(Module, Function, Args) 123 | catch 124 | error:undef:S -> 125 | case S of 126 | [{Module, Function, Args} | _] -> 127 | DefRet; 128 | _ -> 129 | erlang:raise(error, undef, S) 130 | end 131 | end. 132 | -------------------------------------------------------------------------------- /src/xmltree.erl: -------------------------------------------------------------------------------- 1 | %%% vim:ts=2:sw=2:et 2 | %%%----------------------------------------------------------------------------- 3 | %%% @doc Parse XML into a hierarchical Erlang term 4 | %%% ``` 5 | %%% % Example xml: 6 | %%% 7 | %%% 8 | %%% 9 | %%% 10 | %%% vvv\nxxx\n 11 | %%% 12 | %%% 13 | %%% 14 | %%% # Usage example 15 | %%% 1> xmltree:file(L). 16 | %%% {root,[{id,<<"1">>}], 17 | %%% [{ele,[{id,<<"2">>}],[]}, 18 | %%% {ele,[{id,<<"3">>}],<<"vvv\nxxx\n">>}]} 19 | %%% 20 | %%% 2> Rules = {root, [{id,integer}], [{ele, [{id,integer}], string}]}, 21 | %%% 2> xmltree:string(L, Rules). 22 | %%% {root,[{id,1}], 23 | %%% [{ele,[{id,2}],[]},{ele,[{id,3}],"vvv\nxxx\n"}]} 24 | %%% ''' 25 | %%% @author Serge Aleynikov 26 | %%% @end 27 | %%%----------------------------------------------------------------------------- 28 | %%% Date: 2015-12-10 29 | %%%----------------------------------------------------------------------------- 30 | %%% Copyright (c) 2015 Serge Aleynikov 31 | %%%----------------------------------------------------------------------------- 32 | -module(xmltree). 33 | -export([file/1, file/2, string/1, string/2, xml/1, xml/2]). 34 | 35 | -include_lib("xmerl/include/xmerl.hrl"). 36 | 37 | file(Filename) when is_list(Filename) -> 38 | {Xml, _} = xmerl_scan:file(Filename), 39 | xml(Xml). 40 | file(Filename, RulesFile) when is_list(Filename), is_list(RulesFile) -> 41 | {Xml, _} = xmerl_scan:file(Filename), 42 | case file:consult(RulesFile) of 43 | {ok, [Rules]} -> xml(Xml, Rules); 44 | {ok, Rules } -> xml(Xml, Rules) 45 | end; 46 | file(Filename, Rules) when is_list(Filename), is_tuple(Rules) -> 47 | {Xml, _} = xmerl_scan:file(Filename), 48 | xml(Xml, Rules). 49 | 50 | string(XmlS) when is_list(XmlS) -> 51 | {Xml, _} = xmerl_scan:string(XmlS), 52 | xml(Xml). 53 | string(XmlS, Rules) when is_list(XmlS), is_tuple(Rules) -> 54 | {Xml, _} = xmerl_scan:string(XmlS), 55 | xml(Xml, Rules). 56 | 57 | 58 | xml(#xmlElement{name = N, attributes = A, content = C}) -> 59 | {N, process_attributes(A), xml(C)}; 60 | xml([#xmlElement{} = E | T]) -> 61 | [xml(E) | xml(T)]; 62 | xml([#xmlComment{} | T]) -> 63 | xml(T); 64 | xml([#xmlText{value = V} | T]) -> 65 | case [C || C <- V, not lists:member(C, "\n ")] of 66 | [] -> xml(T); 67 | _ -> [unicode:characters_to_binary(V, utf8) | xml(T)] 68 | end; 69 | xml([]) -> 70 | []. 71 | 72 | xml(#xmlElement{name = N, attributes = A, content = C}, {N, AttrRules, ChildRules}) -> 73 | {N, process_attributes(A, AttrRules), xml(C, ChildRules)}; 74 | xml([#xmlElement{name = N} = E | T], ChildRules) -> 75 | case lists:keyfind(N, 1, ChildRules) of 76 | false -> throw({no_rule_for_element, N, E}); 77 | {F, A} -> [xml(E, {F,A,[]}) | xml(T, ChildRules)]; 78 | {_,_,_} = Rule -> [xml(E, Rule) | xml(T, ChildRules)] 79 | end; 80 | xml([#xmlComment{} | T], ChildRules) -> 81 | xml(T, ChildRules); 82 | xml([#xmlText{value = V} | T], ChildRules) -> 83 | case [C || C <- V, not lists:member(C, "\n ")] of 84 | [] -> xml(T, ChildRules); 85 | _ -> [process_value(V, ChildRules) | xml(T, ChildRules)] 86 | end; 87 | xml([], _) -> 88 | []. 89 | 90 | process_attributes([#xmlAttribute{name=N, value=V} | T]) -> 91 | [{N, unicode:characters_to_binary(V, utf8)} | process_attributes(T)]; 92 | process_attributes([]) -> 93 | []. 94 | 95 | process_attributes([#xmlAttribute{name=N, value=V} | T], Rules) -> 96 | [{N, process_value(V, proplists:get_value(N, Rules))} | process_attributes(T, Rules)]; 97 | process_attributes([], _) -> 98 | []. 99 | 100 | 101 | process_value(Value, Fun) when is_function(Fun ,1) -> Fun(Value); 102 | process_value(Value, atom) -> list_to_atom (Value); 103 | process_value("Y", boolean) -> true; 104 | process_value("N", boolean) -> false; 105 | process_value(Value, boolean) -> A = list_to_existing_atom(Value), 106 | if is_boolean(A) -> A; 107 | true -> throw({value_is_not_boolean, Value}) 108 | end; 109 | process_value(Value, integer) -> list_to_integer(Value); 110 | process_value(Value, float) -> list_to_float (Value); 111 | process_value(Value, binary) -> list_to_binary (Value); 112 | process_value(Value, string) -> Value; 113 | process_value(Value, _) -> unicode:characters_to_binary(Value, utf8). 114 | -------------------------------------------------------------------------------- /src/xref_test.erl: -------------------------------------------------------------------------------- 1 | %% Code for testing during development. Finds misspelled function 2 | %% names and incorrect arity usage. It requiers that the modules 3 | %% tested, have already been debug compiled - use erlc with the 4 | %% +debug_info flag, e.g. : 5 | %% 6 | %% erlc +debug_info xxxx.erl 7 | %% 8 | %% This code assumes that the current directory (when calling 9 | %% xref_test:run) is the build folder (the directory where the .beam 10 | %% files are). 11 | %% This code has been tested on my (hsten) local machine, with a 12 | %% 13 | %% > cd src 14 | %% > erlc -W +debug_info *.erl 15 | %% > erl 16 | %% 1> xref_test:run(). 17 | %% 18 | %% in the source directory, but should also work in the build 19 | %% directory using the yxa Makefile to compile it. 20 | %%-------------------------------------------------------------------- 21 | %% LICENSE: This file is part of the YXA open-source project at: 22 | %% http://www.stacken.kth.se/project/yxa/ 23 | %%-------------------------------------------------------------------- 24 | -module(xref_test). 25 | 26 | %%-------------------------------------------------------------------- 27 | %% External exports 28 | %%-------------------------------------------------------------------- 29 | -export([ 30 | run/0, 31 | run/1, 32 | run/2, 33 | run_shell/0 34 | ]). 35 | 36 | %%-------------------------------------------------------------------- 37 | %% Function: run() 38 | %% Descrip.: run xref on yxa code, to look for bugs 39 | %% Returns : - 40 | %%-------------------------------------------------------------------- 41 | run() -> 42 | run([]). 43 | 44 | run(Dirs) when is_list(Dirs) -> 45 | run(Dirs, []). 46 | 47 | run(Dirs, AddAnalysis) when is_list(Dirs) -> 48 | Xref = foobar, 49 | 50 | %% stop any old xref process 51 | try xref:stop(Xref) 52 | catch 53 | throw: _ -> ok; 54 | error: _ -> ok; 55 | exit: _ -> ok 56 | end, 57 | %% start new "empty" xref process 58 | xref:start(Xref, {xref_mode, functions}), 59 | 60 | %% add path to OTP modules - they should not be detected as unkown modules 61 | OTP = code:get_path(), 62 | xref:set_library_path(Xref, OTP, [{verbose, true}]), 63 | 64 | AddOptions = [ 65 | {builtins, false}, 66 | {recurse, false}, 67 | {verbose, true}, 68 | {warnings, true} 69 | ], 70 | 71 | Dir = 72 | case filelib:wildcard("*.beam") of 73 | [] -> 74 | case filelib:is_dir("../ebin") of 75 | true -> "../ebin"; 76 | false -> "." 77 | end; 78 | _ -> 79 | "." 80 | end, 81 | 82 | %% tell xref where to look for modules to check 83 | Res = lists:foldl(fun(D, Acc) -> 84 | case xref:add_directory(Xref, D, AddOptions) of 85 | {ok, Mods} -> 86 | Mods ++ Acc; 87 | _ -> 88 | Acc 89 | end 90 | end, [], [Dir] ++ Dirs), 91 | 92 | io:format("add_directory:~n ~p~n", [Res]), 93 | 94 | %% determine which properties to check with xref 95 | Analysis = [ 96 | undefined_function_calls, 97 | undefined_functions, 98 | locals_not_used, 99 | 100 | %% this lists lots of functions - some are exported 101 | %% behaviour callbacks, others are unused functions intended 102 | %% for future use (to expose a useful interface to the module) 103 | %% and some are probably callback functions not related to 104 | %% behaviours. 105 | 106 | %% exports_not_used, 107 | deprecated_function_calls, 108 | deprecated_functions 109 | 110 | %% {deprecated_function_calls, DeprFlag}, 111 | %% {deprecated_functions, DeprFlag}, 112 | %% {call, FuncSpec}, 113 | %% {use, FuncSpec}, 114 | %% {module_call, ModSpec}, 115 | %% {module_use, ModSpec}, 116 | %% {application_call, AppSpec}, 117 | %% {application_use, AppSpec}, 118 | %% {release_call, RelSpec}, 119 | %% {release_use, RelSpec} 120 | ] ++ AddAnalysis, 121 | 122 | %% format analysis results 123 | Options = [{verbose, true}], 124 | F = fun(AnalysisKind) -> 125 | ARes = filter(xref:analyze(Xref, AnalysisKind, Options), AnalysisKind), 126 | case ARes of 127 | {ok, L} -> L; 128 | L -> L 129 | end, 130 | io:format("~n----------------------------------------------------"), 131 | io:format("~n- ANALYSIS ~p", [AnalysisKind]), 132 | io:format("~n----------------------------------------------------"), 133 | io:format("~n~p~n", [L]), 134 | L 135 | end, 136 | lists:append(lists:map(F, Analysis)) =:= []. 137 | 138 | run_shell() -> 139 | case run() of 140 | true -> 141 | erlang:halt(0); 142 | false -> 143 | erlang:halt(1) 144 | end. 145 | 146 | %%==================================================================== 147 | %% Behaviour functions 148 | %%==================================================================== 149 | 150 | %%==================================================================== 151 | %% Internal functions 152 | %%==================================================================== 153 | 154 | %%-------------------------------------------------------------------- 155 | %% Function: filter(Res, AnalysisKind) 156 | %% Res = term(), return value of xref:analyze 157 | %% AnalysisKind = atom(), the xref:analyze kind 158 | %% Descrip.: remove certain xref:analyze output that only appears 159 | %% to be wrong 160 | %% Returns : list() of term() 161 | %%-------------------------------------------------------------------- 162 | %% filter out the all calls to local:xxxx/yyy 163 | filter(Res, undefined_function_calls) -> 164 | {ok, L} = Res, 165 | F = fun(E, Acc) -> 166 | case E of 167 | {_, {local,_,_}} -> Acc; 168 | _ -> [E | Acc] 169 | end 170 | end, 171 | lists:reverse(lists:foldl(F, [], L)); 172 | 173 | %% filter out the all calls to local:xxxx/yyy 174 | filter(Res, undefined_functions) -> 175 | {ok, L} = Res, 176 | F = fun(E, Acc) -> 177 | case E of 178 | {local,_,_} -> Acc; 179 | _ -> [E | Acc] 180 | end 181 | end, 182 | lists:reverse(lists:foldl(F, [], L)); 183 | 184 | filter(Res, _AnalysisKind) -> 185 | Res. 186 | --------------------------------------------------------------------------------