diff options
| author | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
|---|---|---|
| committer | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
| commit | 84adefa331c4159d432d22840663c38f155cd4c1 (patch) | |
| tree | bff9a9c66adda4df2106dfd0e5c053ab182a12bd /erts/etc/unix | |
| download | otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2 otp-84adefa331c4159d432d22840663c38f155cd4c1.zip | |
The R13B03 release.OTP_R13B03
Diffstat (limited to 'erts/etc/unix')
| -rw-r--r-- | erts/etc/unix/Install.src | 175 | ||||
| -rw-r--r-- | erts/etc/unix/README | 111 | ||||
| -rw-r--r-- | erts/etc/unix/RELNOTES | 327 | ||||
| -rw-r--r-- | erts/etc/unix/cerl.src | 285 | ||||
| -rw-r--r-- | erts/etc/unix/dyn_erl.c | 400 | ||||
| -rw-r--r-- | erts/etc/unix/erl.src.src | 28 | ||||
| -rw-r--r-- | erts/etc/unix/etp-commands | 2054 | ||||
| -rw-r--r-- | erts/etc/unix/etp_commands.erl | 173 | ||||
| -rw-r--r-- | erts/etc/unix/etp_commands.mk | 27 | ||||
| -rw-r--r-- | erts/etc/unix/format_man_pages | 149 | ||||
| -rw-r--r-- | erts/etc/unix/makewhatis | 327 | ||||
| -rw-r--r-- | erts/etc/unix/run_erl.c | 1298 | ||||
| -rw-r--r-- | erts/etc/unix/run_erl.h | 30 | ||||
| -rw-r--r-- | erts/etc/unix/safe_string.c | 123 | ||||
| -rw-r--r-- | erts/etc/unix/safe_string.h | 65 | ||||
| -rw-r--r-- | erts/etc/unix/setuid_socket_wrap.c | 259 | ||||
| -rw-r--r-- | erts/etc/unix/start.src | 36 | ||||
| -rw-r--r-- | erts/etc/unix/start_erl.src | 47 | ||||
| -rw-r--r-- | erts/etc/unix/to_erl.c | 610 |
19 files changed, 6524 insertions, 0 deletions
diff --git a/erts/etc/unix/Install.src b/erts/etc/unix/Install.src new file mode 100644 index 0000000000..410a77d91c --- /dev/null +++ b/erts/etc/unix/Install.src @@ -0,0 +1,175 @@ +#!/bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Patch $ERL_ROOT/emulator/obj/Makefile.dist & make +# +# +start_option=query +unset cross +while [ $# -ne 0 ]; do + case $1 in + -minimal) start_option=minimal ;; + -sasl) start_option=sasl ;; + -cross) cross=yes ;; + *) ERL_ROOT=$1 ;; + esac + shift +done + +if [ -z "$cross" ] +then + TARGET_ERL_ROOT="$ERL_ROOT" +else + TARGET_ERL_ROOT="$ERL_ROOT" + ERL_ROOT=`pwd` +fi + +if [ -z "$ERL_ROOT" -o ! -d "$ERL_ROOT" ] +then + echo "Install: need ERL_ROOT directory as argument" + exit 1 +fi + +case ":$ERL_ROOT" in + :/*) + ;; + *) + echo "Install: need an absolute path to ERL_ROOT" + exit 1 + ;; +esac + +if [ ! -d "$ERL_ROOT/erts-%I_VSN%/bin" ] +then + echo "Install: The directory $ERL_ROOT/erts-%I_VSN%/bin does not exist" + echo " Bad location or erts module not un-tared" + exit 1 +fi + +if [ ! -d $ERL_ROOT/bin ] +then + mkdir $ERL_ROOT/bin +fi + +# +# Fetch target system. +# +SYS=`(uname -s) 2>/dev/null` || SYS=unknown +REL=`(uname -r) 2>/dev/null` || REL=unknown +case $SYS:$REL in + SunOS:5.*) + TARGET=sunos5 ;; + Linux:*) + TARGET=linux ;; + *) + TARGET="" ;; +esac + +cd $ERL_ROOT/erts-%I_VSN%/bin + +sed -e "s;%FINAL_ROOTDIR%;$TARGET_ERL_ROOT;" erl.src > erl +chmod 755 erl + +# +# Create start file for embedded system use, +# +(cd $ERL_ROOT/erts-%I_VSN%/bin; + sed -e "s;%FINAL_ROOTDIR%;$TARGET_ERL_ROOT;" start.src > start; + chmod 755 start) + +cd $ERL_ROOT/bin + +cp -p $ERL_ROOT/erts-%I_VSN%/bin/erl . +cp -p $ERL_ROOT/erts-%I_VSN%/bin/erlc . +cp -p $ERL_ROOT/erts-%I_VSN%/bin/dialyzer . +cp -p $ERL_ROOT/erts-%I_VSN%/bin/typer . +cp -p $ERL_ROOT/erts-%I_VSN%/bin/escript . + +# +# Set a soft link to epmd +# This should not be done for an embedded system! +# + +# Remove old links first. +if [ -h epmd ]; then + /bin/rm -f epmd +fi + +ln -s $TARGET_ERL_ROOT/erts-%I_VSN%/bin/epmd epmd + +cp -p $ERL_ROOT/erts-%I_VSN%/bin/run_erl . +cp -p $ERL_ROOT/erts-%I_VSN%/bin/to_erl . +cp -p $ERL_ROOT/erts-%I_VSN%/bin/start . +sed -e "s;%EMU%;%EMULATOR%%EMULATOR_NUMBER%;" $ERL_ROOT/erts-%I_VSN%/bin/start_erl.src > start_erl +chmod 755 start_erl +echo "" + +echo %I_VSN% %I_SYSTEM_VSN% > $ERL_ROOT/releases/start_erl.data +sed -e "s;%ERL_ROOT%;$TARGET_ERL_ROOT;" $ERL_ROOT/releases/RELEASES.src > $ERL_ROOT/releases/RELEASES + +if [ "$start_option" = "query" ] +then + echo "Do you want to use a minimal system startup" + echo "instead of the SASL startup? (y/n) [n]: " | tr -d '\012' + read reply + case $reply in + [Yy]*) + start_option=minimal ;; + *) + start_option=sasl ;; + esac +fi + +case $start_option in + minimal) + Name=start_clean ;; + sasl) + Name=start_sasl ;; + *) + Name=start_sasl ;; +esac + +cp -p ../releases/%I_SYSTEM_VSN%/start_*.boot . +cp -p $Name.boot start.boot +cp -p ../releases/%I_SYSTEM_VSN%/$Name.script start.script + +# +# We always run ranlib unless Solaris/SunOS 5 +# but ignore failures. +# +if [ "X$TARGET" != "Xsunos5" -a -d $ERL_ROOT/usr/lib ]; then + cd $ERL_ROOT/usr/lib + for library in lib*.a + do + (ranlib $library) > /dev/null 2>&1 + done +fi + + +# +# Fixing the man pages +# + +if [ -d $ERL_ROOT/man ] +then + cd $ERL_ROOT + ./misc/format_man_pages $ERL_ROOT +fi + + diff --git a/erts/etc/unix/README b/erts/etc/unix/README new file mode 100644 index 0000000000..45b4aec2da --- /dev/null +++ b/erts/etc/unix/README @@ -0,0 +1,111 @@ + + %CopyrightBegin% + + Copyright Ericsson AB 1996-2009. All Rights Reserved. + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + %CopyrightEnd% + +-------------------------------------------------------------------------------- +%sunos4 This is Erlang version %VERSION% for SunOS 4. +%solaris2 This is Erlang version %VERSION% for Solaris 2 (SunOS 5). +%isc32 This is Erlang version %VERSION% for Interactive UNIX. +%aix This is Erlang version %VERSION% for AIX. +%hpux This is Erlang version %VERSION% for HP-UX. +%osf This is Erlang version %VERSION% for OSF/1 (currently unsupported). +%linux This is Erlang version %VERSION% for Linux. +%qnx This is Erlang version %VERSION% for QNX. +%freebsd This is Erlang version %VERSION% for FreeBSD. + + +Installation +------------ + +Please refer to the "System Administrator's Guide" for a description +of how to install the Erlang system. Ultra-short summary for the +impatient: Run the 'Install' script in this directory and answer the +questions; defaults (if any) are given in square brackets [] at the +end of each question. + +Note that the Install script will terminate if it detects problems - +you will have to correct them and re-run the script. If everything +goes well, the last printout should be: + +Erlang installation sucessfully completed + +If it isn't, something went wrong - check the printouts to find out +what it was. + +%hpux Note: On HP-UX, it isn't possible to have per-manpage-tree 'whatis' +%hpux files. Thus, 'erl -man -k <subject>' will not work, and it isn't +%hpux recommended to integrate the Erlang man pages into /usr/lib/whatis +%hpux since (as mentioned in the "System Administrator's Guide") there are +%hpux some potential conflicts in naming with standard Unix man pages. +%hpux +%isc32 Note: The release currently includes several files with names longer +%isc32 than 14 characters - this means that you will have problems unpacking +%isc32 it in a standard Interactive S51K (or S52K) filesystem (which you've +%isc32 probably already noticed...). Furthermore, the Erlang filer makes no +%isc32 attempts to deal "intelligently" with such restrictions. The bottom +%isc32 line is that you have to install the Erlang system in an S5L (or +%isc32 possibly NFS) filesystem, unless you have found a way to make the +%isc32 Interactive system silently truncate filenames longer than 14 +%isc32 characters when using S5?K (if so, please tell us about it!). +%isc32 + +Overview of the files/directories in the system +----------------------------------------------- + +README - this file. + +RELNOTES - release notes. + +Install - the main installation script. + +bin - the directory where all code that is to be executed + directly by UNIX is placed during the installation. + +lib - a number of "bundles" included in the release - each + bundle lives in a subdirectory. Most of them are written + entirely in Erlang, but in some cases C programs are also + used (these are copied to the bin directory during + installation). The code server will automatically add the + appropriate directory for each bundle to the search path. + Some of the more noteworthy bundles: + std - this is the standard library, with modules such as + file, io, lists, etc. + compiler - the Erlang compiler (of course) + debugger - the Erlang debugger (ditto) + pxw - the "Primitive X Window interface", which perhaps + isn't so primitive anymore... + For further information on these and the other bundles, + please refer to the man pages. + +doc - The printed documentation in compressed PostScript format, + and some code examples. + +man - Manual pages, best accessed with 'erl -man' - there are + some conflicts with standard Unix manpages if you put + this directory in $MANPATH. + +emulator - The object code for the emulator itself is in the 'obj' + subdirectory, along with a simple Makefile and a couple + of source files that advanced users *may* be interested in + changing - care should be taken, of course, since any + changes may make the system non-functional. Refer to the + "System Adminstrator's Guide" and "Additional Features" + documents for some more information on this. + +misc - Some pieces that don't belong to any particular part of the + system - e.g. the new erl_interface package, and an Erlang + mode for emacs. diff --git a/erts/etc/unix/RELNOTES b/erts/etc/unix/RELNOTES new file mode 100644 index 0000000000..d1a110fce3 --- /dev/null +++ b/erts/etc/unix/RELNOTES @@ -0,0 +1,327 @@ + + %CopyrightBegin% + + Copyright Ericsson AB 1996-2009. All Rights Reserved. + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + %CopyrightEnd% + +============================================================================= + +Release Notes Erlang 4.3.1, Stockholm, October 1995 + +This is a maintenance release correcting some minor problems in the 4.3 +release. The changes are mostly related to problems when using Erlang in +an distributed environment. For features and incompatibilities look in the +following description of the 4.3 release. + +-- If you already have the 4.3 release and run in an distributed environment + you should change all nodes to 4.3.1 since some changes could (at least + potentially) create problems/incompatibilities. (You ought to change + anyway due to bugs fixed...). + +============================================================================= + +Release Notes Erlang 4.3, Stockholm, June 1995 + +This is a list of the changes, fixes, and enhancements which have occurred +between the Erlang 4.2 release of March 1994, and the Erlang 4.3 release of +June 1995. There is also information on problems reported for 4.2 that still +remain in release 4.3. For a more detailed description of new or changed +functions, please refer to the respective manual pages, which are referred +to as man-page(3) or man-page(1). + +Erlang release 4.3 is basically the same system as release 4.2. +A large number of improvements and enhancements have, however, +occurred. The 4.3 system is largely source code compatible with +the 4.2 system, but there is a number of incompatibilities. + +*** Major Improvements +------------------------------------------------------------------ + +-- The system is considerably faster and smaller. + A fully networked system now requires less than a Megabyte + of memory to start. + +-- The system has built-in hashlists which makes it possible + to store,search and manipulate very large quantities of data, + see ets(3). + +-- Bignums, integers can now be arbitrarily large (almost) + +-- A fully integrated debugger/interpreter that can be used + to debug distributed applications, see int(3), and + the user manual. + +-- Distributed Erlang can now be run in environments where DNS + (The Domain Name system) is not configured, see dist_erl(1). + +-- A new trace/3 BIF which can be used for a variety of + purposes, see erlang(3). + + +*** Minor improvements and new modules. +--------------------------------------------------------------------- + +-- A new BIF to monitor other nodes, monitor_node/2, + see erlang(3). + +-- Floating point exceptions and bad parameters to math functions + are now handled correctly, (possibly not implemented on all + architectures) + +-- epmd can be used to access DNS, see epmd(3). + +-- Erlang now contains MACROS, include files, structures, etc. + These are currently not documented, and are used at the + user's own risk, as the syntax might change. + +-- The configuration of the Erlang system has been simplified. + Not many users are aware of this possibility at all, however. + The only parameter left for configuration is now the size of + TMP_BUF, so no upper limits remain for the number of functions, + modules, etc. + +-- Parallel make, see make(3). + +-- generic.erl, is recommended for writing servers, + see generic(3). + +-- timer.erl a new module to be used for various types of timing + related activities. + +-- The new formatter ~p has been introduced into the formatting + routines. io:format("String ~p", [Term]). will print the + term Term with any lists of integers that seem to be strings + as strings. This means that the majority of printouts will + now have a more attractive appearance. However, it also means + that some lists of integers that are real "lists of integers" + will be displayed as strings. Example: + + 1> [65,66]. + "AB" + +-- Deep lists can now be sent to ports. The lists must be well formed + but can contain integers and binaries. + +-- There is a new interface to udp/ip, see udp(3). + +-- slave.erl is a new and nicer way to start up slave nodes in a + UNIX environment. + +-- ddd.erl is a distributed fully replicated data dictionary. + +-- queue.erl FIFO queues as an abstract datatype. + +-- There are enhancements in the socket interface, see socket(3). + +-- rpc.erl is a new module that now contains some of the functions + that used to be in net.erl, which has now been removed, + see rpc(3). + +-- lists.erl contains some new functionality, see lists(3). + +-- BIF erlang:now() returns the current time. + This BIF is guaranteed to produce continuously increasing values. + +-- The new module auth.erl is for handling authentication, see auth(3). + +-- The file $HOME/.erlang.cookie is now automatically and + silently created if it does not exist. This means that new and/or + naive users can ignore the issues of cookies entirely. + +-- user.erl has been slightly rewritten so that Erlang + programs can now be part of a UNIX pipe, see erl(3), io(3). + +-- The new library directory tools now contain various + "tools" + + +*** Command line flags changes. +------------------------------------------------------------------- + +-- The -s and -h flags take values measured in H_GRAIN and S_GRAIN + H_GRAIN == S_GRAIN == 64. (Default is 1, which means that the default + heap and stack size is 64 words.) + +-- The maximum size of the atom_table is now configurable from + the command line. + +-- erl -sname Name starts a new node with a short name. (s == short), + see erl(1). + +-- The breakhandler can now be turned off with the aid of the flag +B. + +-- init.erl has been rewritten. A -load flag is now accepted, + see init(3). + +-- The -cookie flag is no longer necessary if the system is to + read the $HOME/.erlang.cookie file. This is the default. + +-- The flag -env Variable Value extends the UNIX environment + for the Erlang system, see erl(3). + + +*** Reported Fixed Bugs and Malfunctions +------------------------------------------------------------------- + +-- Do not assume that the first two directory entries "." and ".." + make file:list_dir() work better in some environments. + +-- Faster/better garbage collection. + +-- Stack sizes are automatically shrunk. + +-- Distributed Erlang now handles the case when for example the + Ethernet plug is unplugged. Erlang continuously polls all + remote nodes to ensure that the remote nodes are really alive. + +-- A bug has been corrected in the terminal driver. The system + could fail after a large series of printouts without any + newlines "\n" at all. + +-- Formating of floats: a '9' would sometimes become a ':'. + +-- Formating with the use of '*' and negativ size fields now work + as expected. + +-- The format of the 'EXIT' values is now ALWAYS the same + regardless of where the 'EXIT' was produced. + +-- Bugs in exit/2 when the first argument is a port + and second argument is a tuple, have been fixed. + +-- A bug in the random generator has been fixed, see random(3)) + +-- Object code can now be 'trace' compiled by passing the + flag 'trace' to the compiler. This is necessary for + the trace/3 BIF to work on function calls. + +-- error_logger has been improved and is more flexible, see error_logger(3). + +-- The compiler is not so verbose any more. + +-- A bug in the loading of code has been fixed. It is now possible to load + code into the "hole" created by erlang:delete_module/1. + +-- The file system now accepts very large messages. In 4.2 there + was a limit of 64K, which meant that some VERY large modules + could not be compiled. + +-- Support for real interrupts/signals in linked-in drivers have been added. + +-- open_port does not make new atoms all the time. + +-- statistics(io) does now return two counters, + one for all input and one for all output. + +-- There have been minor bug fixes in the erl_interface c-library. + + +*** New TOOLS for Software Development/Tuning/Debugging +--------------------------------------------------------------- + +-- int, is a fully integrated debugger/interpreter, see int(3). + +-- eprof, is a (tty-based) tool for real-time profiling, see eprof(3). + +-- dbg, is a (tty-based) interface to the the trace/3 BIF, see dbg(3). + +-- pman, is a (pxw-based) interface to the trace/3 BIF. + +-- emseq, is a (tty-based) message sequence chart tool. (Not documented) + +-- perfmon, is a (pxw-based) performance monitor. (Not documented) + +-- exref, is a (tty-based) cross-reference tool. + + +*** New Targets Not Generally Available for 4.2 +------------------------------------------------------------------ + +FreeBSD running on PCs +LINUX running on PCs +QNX + + +*** Incompatibilities with 4.2. +-------------------------------------------------------------------- + +-- The BIF node_link/1 has been replace by monitor_node/2 + See erlang(3). + +-- The 4.3 system is not object code compatible with 4.2. + This means that all source code has to be recompiled. It + is not possible to load 4.2 object code. It is also not + possible to run distribution between 4.3 and erlier versions + due to the new alive check. + +-- The external term format has been changed. This will only affect + programs where the BIF term_to_binary/1 has been used for writing + output on files. The directory misc/external contains a program + ext42_to_ext43.erl that can be used for converting files and + binaries from 4.2 format to 4.3 format. This will affect very + few programs. + +-- The names of the Erlang specific i/o modules are now prefixed by + "erl_", for example erl_scan and erl_parse. + +-- The calls to tokenize/parse have been changed, partially to make their + naming more systematic and also to handle the new line number + information. Their return values have also been made more regular with + all functions returning 'ok', {ok, Value} or {ok, Value, EndLine} where + appropriate when successful, and {error, ErrorInfo} or + {error, ErrorInfo, EndLine} if there is an error. + +-- There is a standardised error information format, ErrorInfo above, which + is returned for all input functions. It has the format: + {ErrorLine, Module, ErrorDescriptor} + where a string describing the error can be obtained by calling + apply(Module, format_error, [ErrorDescriptor]). + The handling of line number is application specific. + +-- The function io:read/1/2 now returns {ok, Term} or {error, ErrorInfo} + for consistency. + +-- The Erlang tokeniser/parser has been converted to return line number + information in the token and parse formats. These formats can now + be handled by the pretty printer (erl_pp) but it does not make use of them. + +-- The function file:open/2 now returns {ok, Pid} or {error, What}. This is + consistent with the return values from the rest of the i/o system. + +-- RTFMP! (Read The Friendly Man Pages) + +-- Module net.erl has been removed. The functionality of net.erl + now resides in the rpc, auth and net_kernel modules. + +-- The old debug BIFs (including the module debugger.erl) have + been removed. The BIF trace/3 replaces it. + +-- The BIF not_alive/0 has been removed. + + +*** Documentation: +-------------- + +All manual pages have been updated, some of them substantially. + + +*** Known problems: +--------------- + +The $HOME/.erlang file should be run before the shell is started. + +The Postscript documentation in the doc directory assumes A4 paper. + +list_to_pid/1 on remote pids may behave in an unexpected manner. diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src new file mode 100644 index 0000000000..f81ef6b0fe --- /dev/null +++ b/erts/etc/unix/cerl.src @@ -0,0 +1,285 @@ +#!/bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2003-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +# This is a script to start Erlang/OTP for debugging. PATH is set to +# include this script so if slave nodes are started they will use this +# script as well. +# +# usage: cerl [ OPTIONS ] [ ARGS ] +# +# The OPTIONS are +# +# -rootdir $MYROOTDIR +# Run an installed emulator built from this source +# -debug Run debug compiled emulator +# -gdb Run the debug compiled emulator in emacs and gdb. +# You have to start beam in gdb using "run". +# -break F Run the debug compiled emulator in emacs and gdb and set break. +# The session is started, i.e. "run" is already don for you. +# -xxgdb FIXME currently disabled +# -purify Run emulator compiled for purify +# -quantify Run emulator compiled for quantify +# -purecov Run emulator compiled for purecov +# -gcov Run emulator compiled for gcov +# -valgrind Run emulator compiled for valgrind +# -lcnt Run emulator compiled for lock counting +# -nox Unset the DISPLAY variable to disable us of X Windows +# +# FIXME For GDB you can also set the break point using "-break FUNCTION". +# FIXME For GDB you can also point out your own .gdbini...... + +# These are marked for export +export ROOTDIR +export PROGNAME +export EMU +export BINDIR +export PATH + +cargs= +xargs= +cxargs_add() { + while [ $# -gt 0 ]; do + cargs="$cargs $1" + xargs="$xargs $1" + shift + done +} + +core= + +GDB= +GDBBP= +TYPE= +EMU_TYPE= +debug= +run_valgrind=no + +# Default rootdir +ROOTDIR=%SRC_ROOTDIR% +BINDIR="$ROOTDIR/bin/`$ROOTDIR/erts/autoconf/config.guess`" +#BINDIR="$ROOTDIR/bin/%TARGET%" +PROGNAME=$ROOTDIR/bin/cerl +EMU=beam + +PRELOADED=$ROOTDIR/erts/preloaded/ebin + + +while [ $# -gt 0 ]; do + case "$1" in + +*) + # A system parameter! + cxargs_add $1 + shift + # If next argument does not begin with a hyphen or a plus, + # it is used as the value of the system parameter. + if [ $# -gt 0 ]; then + case $1 in + -*|+*) + ;; + *) + cxargs_add $1 + shift;; + esac + fi;; + "-instr") + cxargs_add $1 + shift + ;; + "-target") + shift + BINDIR="$ROOTDIR/bin/$1" + shift + ;; + "-rootdir") + shift + cargs="$cargs -rootdir $1" + ROOTDIR="$1" + BINDIR=$ROOTDIR/erts-%VSN%/bin + shift + ;; + "-display") + shift + DISPLAY="$1" + export DISPLAY + shift + ;; + "-nox") + shift + unset DISPLAY + ;; + "-smp") + shift + cargs="$cargs -smp" + EMU_TYPE=.smp + ;; + "-lcnt") + shift + cargs="$cargs -lcnt" + TYPE=.lcnt + ;; + "-frag") + shift + cargs="$cargs -frag" + EMU_TYPE=.frag + ;; + "-smp_frag") + shift + cargs="$cargs -smp_frag" + EMU_TYPE=.smp_frag + ;; + "-gprof") + shift + cargs="$cargs -gprof" + TYPE=.gprof + ;; + "-hybrid") + shift + cargs="$cargs -hybrid" + EMU_TYPE=.hybrid + ;; + "-debug") + shift + cargs="$cargs -debug" + TYPE=.debug + ;; + "-gdb") + shift + GDB=gdb + ;; + "-break") + shift + GDB=gdb + GDBBP="$GDBBP (insert-string \"break $1\") (comint-send-input)" + shift + ;; + "-core") + shift + GDB=gdb + core="$1" + shift + ;; +# "-xxgdb") +# shift +# GDB=xxgdb +# ;; + "-shared") + shift + cargs="$cargs -shared" + TYPE=.shared + ;; + "-purify") + shift + cargs="$cargs -purify" + TYPE=.purify + ;; + "-quantify") + shift + cargs="$cargs -quantify" + TYPE=.quantify + ;; + "-purecov") + shift + cargs="$cargs -purecov" + TYPE=.purecov + ;; + "-gcov") + shift + cargs="$cargs -gcov" + TYPE=.gcov + ;; + "-valgrind") + shift + cargs="$cargs -valgrind" + TYPE=.valgrind + run_valgrind=yes + ;; + *) + break + ;; + esac +done + + +PATH=$BINDIR:$ROOTDIR/bin:$PATH +EXEC=$BINDIR/erlexec + +PROGNAME="$PROGNAME $cargs" +EMU=$EMU$TYPE$EMU_TYPE +if [ $run_valgrind != yes ]; then + xargs="$xargs -pz $PRELOADED --" +fi +if [ "x$GDB" = "x" ]; then + if [ $run_valgrind = yes ]; then + emu_xargs=`echo $xargs | sed "s|+|-|g"` + if [ "x$VALGRIND_LOG_DIR" = "x" ]; then + valgrind_log= + else + valgrind_log="--log-file=$VALGRIND_LOG_DIR/$VALGRIND_LOGFILE_PREFIX$VALGRIND_LOGFILE_INFIX$EMU.log" + fi + if [ "x$VALGRIND_LOG_XML" = "x" ]; then + valgrind_xml= + else + export VALGRIND_LOG_XML + valgrind_xml="--xml=yes" + fi + if [ "x$VALGRIND_MISC_FLAGS" = "x" ]; then + valgrind_misc_flags= + else + valgrind_misc_flags="$VALGRIND_MISC_FLAGS" + fi + beam_args=`$EXEC -emu_args_exit ${1+"$@"}` + # Ahhhh... Need to quote $PROGNAME... + early_beam_args=`echo $beam_args | sed "s|^\(.*-progname\).*$|\1|g"` + late_beam_args=`echo $beam_args | sed "s|^$pre_beam_args.*\(-- -home.*\)$|\1|g"` + + exec valgrind $valgrind_xml $valgrind_log $valgrind_misc_flags $BINDIR/$EMU $emu_xargs $early_beam_args "$PROGNAME" $late_beam_args -pz $PRELOADED + else + exec $EXEC $xargs ${1+"$@"} + fi +else + if [ "x$EMACS" = "x" ]; then + EMACS=emacs + fi + + case "x$core" in + x) + # Get emu args to use from erlexec... + beam_args=`$EXEC -emu_args_exit ${1+"$@"}` + gdbcmd="(insert-string \"set args $beam_args\") \ + (comint-send-input)" + ;; + x/*) + gdbcmd="(insert-string \"core ${core}\") (comint-send-input)" + GDBBP= + ;; + *) + dir=`pwd` + gdbcmd="(insert-string \"core ${dir}/${core}\") \ + (comint-send-input)" + GDBBP= + ;; + esac + + gdbcmd="$gdbcmd $GDBBP \ + (insert-string \"source $ROOTDIR/erts/etc/unix/etp-commands\") \ + (comint-send-input)" + # Fire up gdb in emacs... + exec $EMACS --eval "(progn (gdb \"gdb $EMU\") $gdbcmd)" +fi diff --git a/erts/etc/unix/dyn_erl.c b/erts/etc/unix/dyn_erl.c new file mode 100644 index 0000000000..984935417e --- /dev/null +++ b/erts/etc/unix/dyn_erl.c @@ -0,0 +1,400 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * This is a C version of the erl Bourne shell script + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include <stdlib.h> +#include <stdarg.h> + +#define BOOL int +#define TRUE 1 +#define FALSE 0 +#define PATHSEP ":" +#define DIRSEP "/" +#define DIRSEPCHAR '/' + +static void +error(char* format, ...) +{ + char sbuf[1024]; + va_list ap; + + va_start(ap, format); + vsprintf(sbuf, format, ap); + va_end(ap); + fprintf(stderr, "erl: %s\n", sbuf); + exit(1); +} + +/* + * Variables. + */ + +/* + * Manage memory + */ + +static void * +emalloc(size_t size) +{ + void *p = malloc(size); + if (p == NULL) + error("Insufficient memory"); + return p; +} + +/* +static void * +erealloc(void *p, size_t size) +{ + void *res = realloc(p, size); + if (res == NULL) + error("Insufficient memory"); + return res; +} +*/ + +static void +efree(void *p) +{ + free(p); +} + +static char* +strsave(char* string) +{ + char* p = emalloc(strlen(string)+1); + strcpy(p, string); + return p; +} + +/* + * Manage environment variables + */ + +static char * +get_env(char *key) +{ + return getenv(key); +} + +static void +set_env(char *key, char *value) +{ + size_t size = strlen(key) + 1 + strlen(value) + 1; + char *str = emalloc(size); + sprintf(str, "%s=%s", key, value); + if (putenv(str) != 0) + error("putenv(\"%s\") failed!", str); +#ifdef HAVE_COPYING_PUTENV + efree(str); +#endif +} + +// /* A realpath look alike */ +// static char * +// follow_symlinks(const char *path, char *resolved_path) +// { +// char tmp[PATH_MAX]; +// int len; +// +// strcpy(resolved_path, path); +// +// for (;;) { +// len = readlink(resolved_path, tmp, PATH_MAX); +// +// if (len == -1) { +// if (errno == EINVAL) { +// /* Not a symbolic link. use the original name */ +// break; +// } else { +// return NULL; +// } +// } else { +// tmp[len] = '\0'; +// strcpy(resolved_path, tmp); +// } +// } +// +// return resolved_path; +// } + +/* + * Find absolute path to this program + */ + +static char * +find_prog(char *origpath) +{ + char relpath[PATH_MAX]; + char abspath[PATH_MAX]; + + strcpy(relpath, origpath); + + if (strstr(relpath, DIRSEP) == NULL) { + /* Just a base name */ + char *envpath; + + envpath = get_env("PATH"); + if (envpath) { + /* Try to find the executable in the path */ + char dir[PATH_MAX]; + char *beg = envpath; + char *end; + int sz; + DIR *dp; /* Pointer to directory structure. */ + struct dirent* dirp; /* Pointer to directory entry. */ + BOOL look_for_sep = TRUE; + + while (look_for_sep) { + end = strstr(beg, PATHSEP); + if (end != NULL) { + sz = end - beg; + strncpy(dir, beg, sz); + dir[sz] = '\0'; + } else { + sz = strlen(beg); + strcpy(dir, beg); + look_for_sep = FALSE; + } + beg = end + 1; + + dp = opendir(dir); + if (dp != NULL) { + while (TRUE) { + dirp = readdir(dp); + if (dirp == NULL) { + closedir(dp); + /* Try next directory in path */ + break; + } + + if (strcmp(origpath, dirp->d_name) == 0) { + /* Wow. We found the executable. */ + strcpy(relpath, dir); + strcat(relpath, DIRSEP); + strcat(relpath, dirp->d_name); + closedir(dp); + look_for_sep = FALSE; + break; + } + } + } + } + } + } + + if (!realpath(relpath, abspath)) { + error("Cannot determine real path to erl"); + } + + return strdup(abspath); +} + +/* + * Find bindir + */ + +static void +copy_latest_vsn(char *latest_vsn, char *next_vsn) +{ + char *lp; + char *np; + BOOL greater; + + /* Find vsn */ + for (lp = latest_vsn+strlen(latest_vsn)-1 ;lp > latest_vsn && *lp != DIRSEPCHAR; --lp) + ; + + /* lp =+ length("erts-"); */ + for (np = next_vsn+strlen(next_vsn)-1 ;np > next_vsn && *np != DIRSEPCHAR; --np) + ; + + /* np =+ length("erts-"); */ + while (TRUE) { + if (*lp != *np) { + if (*np > *lp) { + greater = TRUE; + } else { + greater = FALSE; + } + + /* Find next dot or eos */ + while (*lp != '\0' && *np != '\0') { + lp++; + np++; + if (*np == '.' && *lp == '.') { + break; + } + if (*np == '\0' && *lp == '\0') { + break; + } + if (*lp == '.' || *lp == '\0') { + greater = TRUE; + } + if (*np == '.' || *np == '\0') { + greater = FALSE; + } + } + if (greater) { + strcpy(latest_vsn, next_vsn); + } + return; + } + ++lp; + ++np; + } +} + +static char * +find_erts_vsn(char *erl_top) +{ + /* List install dir and look for latest erts-vsn */ + DIR *dp; /* Pointer to directory structure. */ + struct dirent* dirp; /* Pointer to directory entry. */ + char latest_vsn[PATH_MAX]; /* Latest erts-vsn directory name. */ + + dp = opendir(erl_top); + if (dp == NULL) { + return NULL; + } + + latest_vsn[0] = '\0'; + for (;;) { + dirp = readdir(dp); + if (dirp == NULL) { + closedir(dp); + break; + } + if (strncmp("erts-", dirp->d_name, 5) == 0) { + copy_latest_vsn(latest_vsn, dirp->d_name); + } + } + + if (latest_vsn[0] == '\0') { + return NULL; + } else { + char *p = malloc((strlen(erl_top)+1+strlen(latest_vsn)+4+1)*sizeof(char)); + strcpy(p,erl_top); + strcat(p,DIRSEP); + strcat(p,latest_vsn); + strcat(p,DIRSEP); + strcat(p,"bin"); + return p; + } +} + +static char * +find_bindir(char *erlpath) +{ + /* Assume that the path to erl is absolute and + * that it is not a symbolic link*/ + + char *p; + char *p2; + char buffer[PATH_MAX]; + + strcpy(buffer, erlpath); + + /* Chop of base name*/ + for (p = buffer+strlen(buffer)-1 ;p >= buffer && *p != DIRSEPCHAR; --p) + ; + *p = '\0'; + p--; + + /* Check if dir path is like ...\buffer\erts-vsn\bin */ + for (;p >= buffer && *p != DIRSEPCHAR; --p) + ; + p--; + for (p2 = p;p2 >= buffer && *p2 != DIRSEPCHAR; --p2) + ; + p2++; + if (strncmp(p2, "erts-", 5) == 0) { + p = strsave(buffer); + return p; + } + + /* Assume that dir path is like ...\buffer\bin */ + *++p ='\0'; /* chop off bin dir */ + + p = find_erts_vsn(buffer); + if (p == NULL) { + return strsave(buffer); + } else { + return p; + } +} + +/* + * main + */ + +int +main(int argc, char **argv) +{ + char *p; + char *abspath; + char *bindir; /* Location of executables. */ + char rootdir[PATH_MAX]; /* Root location of Erlang installation. */ + char progname[PATH_MAX]; /* Name of this program. */ + char erlexec[PATH_MAX]; /* Path to erlexec */ + + /* Determine progname */ + abspath = find_prog(argv[0]); + strcpy(progname, abspath); + for (p = progname+strlen(progname)-1;p >= progname && *p != '/'; --p) + ; + + /* Determine bindir */ + bindir = find_bindir(abspath); + + /* Determine rootdir */ + strcpy(rootdir, bindir); + for (p = rootdir+strlen(rootdir)-1;p >= rootdir && *p != '/'; --p) + ; + p--; + for (;p >= rootdir && *p != '/'; --p) + ; + *p ='\0'; + + /* Update environment */ + set_env("EMU", "beam"); + set_env("PROGNAME", progname); + set_env("BINDIR", bindir); + set_env("ROOTDIR", rootdir); + + /* Invoke erlexec */ + strcpy(erlexec, bindir); + strcat(erlexec, DIRSEP); + strcat(erlexec, "erlexec"); + + efree(abspath); + efree(bindir); + + execvp(erlexec, argv); + error("Error %d executing \'%s\'.", errno, erlexec); + return 2; +} diff --git a/erts/etc/unix/erl.src.src b/erts/etc/unix/erl.src.src new file mode 100644 index 0000000000..50603f12f4 --- /dev/null +++ b/erts/etc/unix/erl.src.src @@ -0,0 +1,28 @@ +#!/bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +ROOTDIR=%FINAL_ROOTDIR% +BINDIR=$ROOTDIR/erts-%VSN%/bin +EMU=%EMULATOR%%EMULATOR_NUMBER% +PROGNAME=`echo $0 | sed 's/.*\///'` +export EMU +export ROOTDIR +export BINDIR +export PROGNAME +exec $BINDIR/erlexec ${1+"$@"} diff --git a/erts/etc/unix/etp-commands b/erts/etc/unix/etp-commands new file mode 100644 index 0000000000..6a01e0b7e0 --- /dev/null +++ b/erts/etc/unix/etp-commands @@ -0,0 +1,2054 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2005-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +############################################################################ +# Help commands +# + +define etp-help + help etp-help +end + +document etp-help +%--------------------------------------------------------------------------- +% etp-help +% +% Same as "help etp-help" +% +% Emulator Toolbox for Pathologists +% - GDB command toolbox for analyzing core dumps from the +% Erlang emulator (BEAM). +% +% Should work for 32-bit erts-5.2/R9B, ... +% +% The commands are prefixed with: +% etp: Acronym for erts-term-print +% etpf: Acronym for erts-term-print-flat +% +% User commands (these have help themselves): +% +% Most useful: +% etp, etpf +% +% Useful for doing step-by-step traversal of lists and tuples after +% calling the toplevel command etpf: +% etpf-cons, etpf-boxed, +% +% Special commands for not really terms: +% etp-mfa, etp-cp, +% etp-msgq, etpf-msgq, +% etp-stacktrace, etp-stackdump, etpf-stackdump, etp-dictdump +% etp-offheapdump, etpf-offheapdump, +% etp-print-procs, etp-search-heaps, etp-search-alloc, +% etp-ets-tables, etp-ets-tabledump +% +% Complex commands that use the Erlang support module. +% etp-overlapped-heaps, etp-chart, etp-chart-start, etp-chart-end +% +% Erlang support module handling commands: +% etp-run +% +% Parameter handling commands: +% etp-show, etp-set-max-depth, etp-set-max-string-length +% +% Other commands you may find in this toolbox are suffixed -1, -2, ... +% and are internal; not for the console user. +% +% The Erlang support module requires `erl' and `erlc' in the path. +% The compiled "erl_commands.beam" file is stored in the current +% working directory, so it is thereby in the search path of `erl'. +% +% These are just helpful commands when analyzing core dumps, but +% you will not get away without knowing the gory details of the +% tag bits. Do not forget about the e.g p, p/x, x and x/4x commands. +% +% Execution speed of user defined gdb commands is not lightning fast. +% It may well take half a minute to dump a complex term with the default +% max depth values on our old Sparc Ultra-10's. +% +% To use the Erlang support module, the environment variable ROOTDIR +% must be set to the toplevel installation directory of Erlang/OTP, +% so the etp-commands file becomes: +% $ROOTDIR/erts/etc/unix/etp-commands +% Also, erl and erlc must be in the path. +%--------------------------------------------------------------------------- +end + +############################################################################ +# Toplevel commands +# + +define etp +# Args: Eterm +# +# Reentrant +# + etp-1 ((Eterm)($arg0)) 0 + printf ".\n" +end + +document etp +%--------------------------------------------------------------------------- +% etp Eterm +% +% Takes a toplevel Erlang term and prints the whole deep term +% very much as in Erlang itself. Up to a max depth. See etp-show. +%--------------------------------------------------------------------------- +end + +define etp-1 +# Args: Eterm, int depth +# +# Reentrant +# + if (($arg0) & 0x3) == 1 + # Cons pointer + if $etp_flat + printf "<etpf-cons %#x>", ($arg0) + else + etp-list-1 ($arg0) ($arg1) + end + else + if (($arg0) & 0x3) == 2 + if $etp_flat + printf "<etpf-boxed %#x>", ($arg0) + else + etp-boxed-1 ($arg0) ($arg1) + end + else + if (($arg0) & 0x3) == 3 + etp-immediate-1 ($arg0) + else + # (($arg0) & 0x3) == 0 + if (($arg0) == 0x0) + printf "<the non-value>" + else + if (($arg0) == 0x4) + printf "<the non-value debug>" + else + etp-cp-1 ($arg0) + end + end + end + end + end +end + +define etpf +# Args: Eterm +# +# Non-reentrant + set $etp_flat = 1 + etp-1 ((Eterm)($arg0)) + set $etp_flat = 0 + printf ".\n" +end + +document etpf +%--------------------------------------------------------------------------- +% etpf Eterm +% +% Takes a toplevel Erlang term and prints it is. If it is a deep term +% print which command to use to traverse down one level. +%--------------------------------------------------------------------------- +end + +############################################################################ +# Commands for nested terms. Some are recursive. +# + +define etp-list-1 +# Args: Eterm cons_cell, int depth +# +# Reentrant +# + if (($arg0) & 0x3) != 0x1 + printf "#NotCons<%#x>", ($arg0) + else + # Cons pointer + if $etp_chart + etp-chart-entry-1 ($arg0) ($arg1) 2 + end + etp-list-printable-1 ($arg0) ($arg1) + if !$etp_list_printable + # Print normal list + printf "[" + etp-list-2 ($arg0) (($arg1)+1) + end + end +end + +define etp-list-printable-1 +# Args: Eterm list, int depth +# +# Non-reentrant +# +# Returns: $etp_list_printable +# + if (($arg0) & 0x3) != 0x1 + printf "#NotCons<%#x>", ($arg0) + else + # Loop to check if it is a printable string + set $etp_list_p = ($arg0) + set $etp_list_printable = ($etp_list_p != $etp_nil) + set $etp_list_i = 0 + while ($etp_list_p != $etp_nil) && \ + ($etp_list_i < $etp_max_string_length) && \ + $etp_list_printable + if ($etp_list_p & 0x3) == 0x1 + # Cons pointer + set $etp_list_n = ((Eterm*)($etp_list_p & ~0x3))[0] + if ($etp_list_n & 0xF) == 0xF + etp-ct-printable-1 ($etp_list_n>>4) + if $etp_ct_printable + # Printable + set $etp_list_p = ((Eterm*)($etp_list_p & ~0x3))[1] + set $etp_list_i++ + else + set $etp_list_printable = 0 + end + else + set $etp_list_printable = 0 + end + else + set $etp_list_printable = 0 + end + end + # + if $etp_list_printable + # Print printable string + printf "\"" + set $etp_list_p = ($arg0) + set $etp_list_i = 0 + while $etp_list_p != $etp_nil + set $etp_list_n = ((Eterm*)($etp_list_p & ~0x3))[0] + etp-char-1 ($etp_list_n>>4) '"' + set $etp_list_p = ((Eterm*)($etp_list_p & ~0x3))[1] + set $etp_list_i++ + if $etp_list_p == $etp_nil + printf "\"" + else + if $etp_list_i >= $etp_max_string_length + set $etp_list_p = $etp_nil + printf "\"++[...]" + else + if $etp_chart + etp-chart-entry-1 ($arg0) (($arg1)+$etp_list_i) 2 + end + end + end + end + end + end +end + +define etp-list-2 +# Args: Eterm cons_cell, int depth +# +# Reentrant +# + if (($arg0) & 0x3) != 0x1 + printf "#NotCons<%#x>", ($arg0) + else + # Cons pointer + if ($arg1) >= $etp_max_depth + printf "...]" + else + etp-1 (((Eterm*)(($arg0)&~0x3))[0]) (($arg1)+1) + if ((Eterm*)(($arg0) & ~0x3))[1] == $etp_nil + # Tail is [] + printf "]" + else + if $etp_chart + etp-chart-entry-1 ($arg0) ($arg1) 2 + end + if (((Eterm*)(($arg0)&~0x3))[1]&0x3) == 0x1 + # Tail is cons cell + printf "," + etp-list-2 (((Eterm*)(($arg0)&~0x3))[1]) (($arg1)+1) + else + # Tail is other term + printf "|" + etp-1 (((Eterm*)(($arg0)&~0x3))[1]) (($arg1)+1) + printf "]" + end + end + end + end +end + +define etpf-cons +# Args: Eterm +# +# Reentrant capable +# + if ((Eterm)($arg0) & 0x3) != 0x1 + printf "#NotCons<%#x>", ($arg0) + else + # Cons pointer + set $etp_flat = 1 + printf "[" + etp-1 (((Eterm*)((Eterm)($arg0)&~0x3))[0]) + printf "|" + etp-1 (((Eterm*)((Eterm)($arg0)&~0x3))[1]) + printf "]\n" + set $etp_flat = 0 + end +end + +document etpf-cons +%--------------------------------------------------------------------------- +% etpf-cons Eterm +% +% Takes a Cons ptr and prints the Car and Cdr cells with etpf (flat). +%--------------------------------------------------------------------------- +end + + + +define etp-boxed-1 +# Args: Eterm, int depth +# +# Reentrant +# + if (($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", ($arg0) + else + if (((Eterm*)(($arg0) & ~0x3))[0] & 0x3) != 0x0 + if $etp_chart + etp-chart-entry-1 (($arg0)&~0x3) ($arg1) 1 + end + printf "#BoxedError<%#x>", ($arg0) + else + if $etp_chart + etp-chart-entry-1 (($arg0)&~0x3) ($arg1) \ + ((((Eterm*)(($arg0)&~0x3))[0]>>6)+1) + end + if (((Eterm*)(($arg0) & ~0x3))[0] & 0x3f) == 0x0 + printf "{" + etp-array-1 ((Eterm*)(($arg0)&~0x3)) ($arg1) ($arg1) \ + 1 ((((Eterm*)(($arg0)&~0x3))[0]>>6)+1) '}' + else + etp-boxed-immediate-1 ($arg0) + end + end + end +end + +define etp-boxed-immediate-1 +# Args: Eterm, int depth +# +# Non-reentrant +# + if (($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", ($arg0) + else + if (((Eterm*)(($arg0) & ~0x3))[0] & 0x3) != 0x0 + printf "#BoxedError<%#x>", ($arg0) + else + set $etp_boxed_immediate_p = (Eterm*)(($arg0) & ~0x3) + set $etp_boxed_immediate_h = ($etp_boxed_immediate_p[0] >> 2) & 0xF + if $etp_boxed_immediate_h == 0xC + etp-extpid-1 ($arg0) + else + if $etp_boxed_immediate_h == 0xD + etp-extport-1 ($arg0) + else + if ($etp_boxed_immediate_h == 0x2) || \ + ($etp_boxed_immediate_h == 0x3) + etp-bignum-1 ($arg0) + else + if ($etp_boxed_immediate_h == 0x6) + etp-float-1 ($arg0) + else + if ($etp_boxed_immediate_h == 0x4) + etp-ref-1 ($arg0) + else + if ($etp_boxed_immediate_h == 0xE) + etp-extref-1 ($arg0) + else + # Hexdump the rest + if ($etp_boxed_immediate_h == 0x5) + printf "#Fun<" + else + if ($etp_boxed_immediate_h == 0x8) + printf "#RefcBinary<" + else + if ($etp_boxed_immediate_h == 0x9) + printf "#HeapBinary<" + else + if ($etp_boxed_immediate_h == 0xA) + printf "#SubBinary<" + else + printf "#Header%X<", $etp_boxed_immediate_h + end + end + end + end + set $etp_boxed_immediate_arity = $etp_boxed_immediate_p[0]>>6 + while $etp_boxed_immediate_arity > 0 + set $etp_boxed_immediate_p++ + if $etp_boxed_immediate_arity > 1 + printf "%#x,", *$etp_boxed_immediate_p + else + printf "%#x", *$etp_boxed_immediate_p + if ($etp_boxed_immediate_h == 0xA) + set $etp_boxed_immediate_p++ + printf ":%#x", *$etp_boxed_immediate_p + end + printf ">" + end + set $etp_boxed_immediate_arity-- + end + # End of hexdump + end + end + end + end + end + end + end + end +end + +define etpf-boxed +# Args: Eterm +# +# Non-reentrant +# + set $etp_flat = 1 + etp-boxed-1 ((Eterm)($arg0)) 0 + set $etp_flat = 0 + printf ".\n" +end + +document etpf-boxed +%--------------------------------------------------------------------------- +% etpf-boxed Eterm +% +% Take a Boxed ptr and print the contents in one level using etpf (flat). +%--------------------------------------------------------------------------- +end + + + +define etp-array-1 +# Args: Eterm* p, int depth, int width, int pos, int size, int end_char +# +# Reentrant +# + if ($arg3) < ($arg4) + if (($arg1) < $etp_max_depth) && (($arg2) < $etp_max_depth) + etp-1 (($arg0)[($arg3)]) (($arg1)+1) + if (($arg3) + 1) != ($arg4) + printf "," + end + etp-array-1 ($arg0) ($arg1) (($arg2)+1) (($arg3)+1) ($arg4) ($arg5) + else + printf "...%c", ($arg5) + end + else + printf "%c", ($arg5) + end +end + + + +#define etpa-1 +## Args: Eterm, int depth, int index, int arity +## +## Reentrant +## +# if ($arg1) >= $etp_max_depth+$etp_max_string_length +# printf "%% Max depth for term %d\n", $etp_chart_id +# else +# if ($arg2) < ($arg3) +# etp-1 (((Eterm*)(($arg0)&~0x3))[$arg2]) (($arg1)+1) +# etpa-1 ($arg0) (($arg1)+1) (($arg2)+1) ($arg3) +# end +# end +#end + +############################################################################ +# Commands for non-nested terms. Recursion leaves. Some call other leaves. +# + +define etp-immediate-1 +# Args: Eterm +# +# Reentrant capable +# + if (($arg0) & 0x3) != 0x3 + printf "#NotImmediate<%#x>", ($arg0) + else + if (($arg0) & 0xF) == 0x3 + etp-pid-1 ($arg0) + else + if (($arg0) & 0xF) == 0x7 + etp-port-1 ($arg0) + else + if (($arg0) & 0xF) == 0xf + # Fixnum + printf "%ld", (long)((Sint)($arg0)>>4) + else + # Immediate2 - 0xB + if (($arg0) & 0x3f) == 0x0b + etp-atom-1 ($arg0) + else + if (($arg0) & 0x3f) == 0x1b + printf "#Catch<%d>", ($arg0)>>6 + else + if (($arg0) == $etp_nil) + printf "[]" + else + printf "#UnknownImmediate<%#x>", ($arg0) + end + end + end + end + end + end + end +end + + + +define etp-atom-1 +# Args: Eterm atom +# +# Non-reentrant +# + if ((Eterm)($arg0) & 0x3f) != 0xb + printf "#NotAtom<%#x>", ($arg0) + else + set $etp_atom_1_ap = (Atom*)erts_atom_table.seg_table[(Eterm)($arg0)>>16][((Eterm)($arg0)>>6)&0x3FF] + set $etp_atom_1_i = ($etp_atom_1_ap)->len + set $etp_atom_1_p = ($etp_atom_1_ap)->name + set $etp_atom_1_quote = 1 + # Check if atom has to be quoted + if ($etp_atom_1_i > 0) + etp-ct-atom-1 (*$etp_atom_1_p) + if $etp_ct_atom + # Atom start character + set $etp_atom_1_p++ + set $etp_atom_1_i-- + set $etp_atom_1_quote = 0 + else + set $etp_atom_1_i = 0 + end + end + while $etp_atom_1_i > 0 + etp-ct-name-1 (*$etp_atom_1_p) + if $etp_ct_name + # Name character + set $etp_atom_1_p++ + set $etp_atom_1_i-- + else + set $etp_atom_1_quote = 1 + set $etp_atom_1_i = 0 + end + end + # Print the atom + if $etp_atom_1_quote + printf "'" + end + set $etp_atom_1_i = ($etp_atom_1_ap)->len + set $etp_atom_1_p = ($etp_atom_1_ap)->name + while $etp_atom_1_i > 0 + etp-char-1 (*$etp_atom_1_p) '\'' + set $etp_atom_1_p++ + set $etp_atom_1_i-- + end + if $etp_atom_1_quote + printf "'" + end + end +end + + + +define etp-char-1 +# Args: int char, int quote_char +# +# Non-reentrant +# + if (($arg0) < 0) || (0377 < ($arg0)) + printf "#NotChar<%#x>", ($arg0) + else + if ($arg0) == ($arg1) + printf "\\%c", ($arg0) + else + etp-ct-printable-1 ($arg0) + if $etp_ct_printable + if $etp_ct_printable < 0 + printf "%c", ($arg0) + else + printf "\\%c", $etp_ct_printable + end + else + printf "\\%03o", ($arg0) + end + end + end +end + +define etp-ct-printable-1 +# Args: int +# +# Determines if integer is a printable character +# +# Non-reentrant +# Returns: $etp_ct_printable +# escape alias char, or -1 if no escape alias + if ($arg0) == 010 + set $etp_ct_printable = 'b' + else + if ($arg0) == 011 + set $etp_ct_printable = 't' + else + if ($arg0) == 012 + set $etp_ct_printable = 'n' + else + if ($arg0) == 013 + set $etp_ct_printable = 'v' + else + if ($arg0) == 014 + set $etp_ct_printable = 'f' + else + if ($arg0) == 033 + set $etp_ct_printable = 'e' + else + if ((040 <= ($arg0)) && (($arg0) <= 0176)) || \ + ((0240 <= ($arg0)) && (($arg0) <= 0377)) + # Other printable character + set $etp_ct_printable = -1 + else + set $etp_ct_printable = 0 + end + end + end + end + end + end + end +end + +define etp-ct-atom-1 +# Args: int +# +# Determines if integer is a atom first character +# +# Non-reentrant +# Returns: $etp_ct_atom + if ((0141 <= ($arg0)) && (($arg0) <= 0172)) || \ + ((0337 <= ($arg0)) && (($arg0) != 0367) && (($arg0) <= 0377)) + # Atom start character + set $etp_ct_atom = 1 + else + set $etp_ct_atom = 0 + end +end + +define etp-ct-variable-1 +# Args: int +# +# Determines if integer is a variable first character +# +# Non-reentrant +# Returns: $etp_ct_variable + if ((056 == ($arg0)) || \ + (0101 <= ($arg0)) && (($arg0) <= 0132)) || \ + (0137 == ($arg0)) || \ + ((0300 <= ($arg0)) && (($arg0) != 0327) && (($arg0) <= 0336)) + # Variable start character + set $etp_ct_variable = 1 + else + set $etp_ct_variable = 0 + end +end + +define etp-ct-name-1 +# Args: int +# +# Determines if integer is a name character, +# i.e non-first atom or variable character. +# +# Non-reentrant +# Returns: $etp_ct_variable + if (($arg0) == 0100 || \ + (060 <= ($arg0)) && (($arg0) <= 071)) + set $etp_ct_name = 1 + else + etp-ct-atom-1 ($arg0) + if $etp_ct_atom + set $etp_ct_name = 1 + else + etp-ct-variable-1 ($arg0) + set $etp_ct_name = $etp_ct_variable + end + end +end + + + +define etp-pid-1 +# Args: Eterm pid +# +# Non-reentrant +# + set $etp_pid_1 = (Eterm)($arg0) + if ($etp_pid_1 & 0xF) == 0x3 + # Internal pid + printf "<0.%u.%u>", (unsigned) ($etp_pid_1>>4)&0x7fff, \ + (unsigned) ($etp_pid_1>>19)&0x1fff + else + printf "#NotPid<%#x>", ($arg0) + end +end + +define etp-extpid-1 +# Args: Eterm extpid +# +# Non-reentrant +# + if ((Eterm)($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", (Eterm)($arg0) + else + set $etp_extpid_1_p = (ExternalThing*)((Eterm)($arg0) & ~0x3) + if ($etp_extpid_1_p->header & 0x3f) != 0x30 + printf "#NotExternalPid<%#x>", $etp_extpid_1_p->header + else + ## External pid + set $etp_extpid_1_number = $etp_extpid_1_p->data.ui[0]&0x7fff + set $etp_extpid_1_serial = ($etp_extpid_1_p->data.ui[0]>>15)&0x1fff + set $etp_extpid_1_np = $etp_extpid_1_p->node + set $etp_extpid_1_creation = $etp_extpid_1_np->creation + set $etp_extpid_1_dep = $etp_extpid_1_np->dist_entry + set $etp_extpid_1_node = $etp_extpid_1_np->sysname + if ($etp_extpid_1_node & 0x3f) != 0xb + # Should be an atom + printf "#ExternalPidError<%#x>", ($arg0) + else + if $etp_extpid_1_dep == erts_this_dist_entry + printf "<0:" + else + printf "<%u:", $etp_extpid_1_node>>6 + end + etp-atom-1 ($etp_extpid_1_node) + printf "/%u.%u.%u>", $etp_extpid_1_creation, \ + $etp_extpid_1_number, $etp_extpid_1_serial + end + end + end +end + + + +define etp-port-1 +# Args: Eterm port +# +# Non-reentrant +# + set $etp_port_1 = (Eterm)($arg0) + if ($etp_port_1 & 0xF) == 0x7 + # Internal port + printf "#Port<0.%u>", (unsigned) ($etp_port_1>>4)&0x3ffff + else + printf "#NotPort<%#x>", ($arg0) + end +end + +define etp-extport-1 +# Args: Eterm extport +# +# Non-reentrant +# + if ((Eterm)($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", (Eterm)($arg0) + else + set $etp_extport_1_p = (ExternalThing*)((Eterm)($arg0) & ~0x3) + if ($etp_extport_1_p->header & 0x3F) != 0x34 + printf "#NotExternalPort<%#x>", $etp_extport_1->header + else + ## External port + set $etp_extport_1_number = $etp_extport_1_p->data.ui[0]&0x3ffff + set $etp_extport_1_np = $etp_extport_1_p->node + set $etp_extport_1_creation = $etp_extport_1_np->creation + set $etp_extport_1_dep = $etp_extport_1_np->dist_entry + set $etp_extport_1_node = $etp_extport_1_np->sysname + if ($etp_extport_1_node & 0x3f) != 0xb + # Should be an atom + printf "#ExternalPortError<%#x>", ($arg0) + else + if $etp_extport_1_dep == erts_this_dist_entry + printf "#Port<0:" + else + printf "#Port<%u:", $etp_extport_1_node>>6 + end + etp-atom-1 ($etp_extport_1_node) + printf "/%u.%u>", $etp_extport_1_creation, $etp_extport_1_number + end + end + end +end + + + +define etp-bignum-1 +# Args: Eterm bignum +# +# Non-reentrant +# + if ((Eterm)($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", (Eterm)($arg0) + else + set $etp_bignum_1_p = (Eterm*)((Eterm)($arg0) & ~0x3) + if ($etp_bignum_1_p[0] & 0x3b) != 0x08 + printf "#NotBignum<%#x>", $etp_bignum_1_p[0] + else + set $etp_bignum_1_i = ($etp_bignum_1_p[0] >> 6) + if $etp_bignum_1_i < 1 + printf "#BignumError<%#x>", (Eterm)($arg0) + else + if $etp_bignum_1_p[0] & 0x04 + printf "-" + end + set $etp_bignum_1_p = (ErtsDigit *)($etp_bignum_1_p + 1) + printf "16#" + if $etp_arch64 + while $etp_bignum_1_i > 0 + set $etp_bignum_1_i-- + printf "%016lx", $etp_bignum_1_p[$etp_bignum_1_i] + end + else + while $etp_bignum_1_i > 0 + set $etp_bignum_1_i-- + printf "%08x", $etp_bignum_1_p[$etp_bignum_1_i] + end + end + end + end + end +end + + + +define etp-float-1 +# Args: Eterm float +# +# Non-reentrant +# + if ((Eterm)($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", (Eterm)($arg0) + else + set $etp_float_1_p = (Eterm*)((Eterm)($arg0) & ~0x3) + if ($etp_float_1_p[0] & 0x3f) != 0x18 + printf "#NotFloat<%#x>", $etp_float_1_p[0] + else + printf "%f", *(double*)($etp_float_1_p+1) + end + end +end + + + +define etp-ref-1 +# Args: Eterm ref +# +# Non-reentrant +# + if ((Eterm)($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", (Eterm)($arg0) + else + set $etp_ref_1_p = (RefThing *)((Eterm)($arg0) & ~0x3) + if ($etp_ref_1_p->header & 0x3b) != 0x10 + printf "#NotRef<%#x>", $etp_ref_1_p->header + else + set $etp_ref_1_nump = (Uint32 *) 0 + set $etp_ref_1_error = 0 + if ($etp_ref_1_p->header >> 6) == 0 + set $etp_ref_1_error = 1 + else + if $etp_arch64 + set $etp_ref_1_i = (int) $etp_ref_1_p->data.ui32[0] + if (($etp_ref_1_i + 1) > (2 * ($etp_ref_1_p->header >> 6))) + set $etp_ref_1_error = 1 + else + set $etp_ref_1_nump = &$etp_ref_1_p->data.ui32[1] + end + else + set $etp_ref_1_i = (int) ($etp_ref_1_p->header >> 6) + set $etp_ref_1_nump = &$etp_ref_1_p->data.ui32[0] + end + end + if $etp_ref_1_error + printf "#InternalRefError<%#x>", ($arg0) + else + printf "#Ref<0" + set $etp_ref_1_i-- + while $etp_ref_1_i >= 0 + printf ".%u", (unsigned) $etp_ref_1_nump[$etp_ref_1_i] + set $etp_ref_1_i-- + end + printf ">" + end + end + end +end + + + +define etp-extref-1 +# Args: Eterm extref +# +# Non-reentrant +# + if ((Eterm)($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", (Eterm)($arg0) + else + set $etp_extref_1_p = (ExternalThing*)((Eterm)($arg0) & ~0x3) + if ($etp_extref_1_p->header & 0x3F) != 0x38 + printf "#NotExternalRef<%#x>", $etp_extref_1->header + else + ## External ref + set $etp_extref_1_nump = (Uint32 *) 0 + set $etp_extref_1_error = 0 + set $etp_extref_1_i = (int) ($etp_extref_1_p->header >> 6) + set $etp_extref_1_np = $etp_extref_1_p->node + set $etp_extref_1_creation = $etp_extref_1_np->creation + set $etp_extref_1_dep = $etp_extref_1_np->dist_entry + set $etp_extref_1_node = $etp_extref_1_np->sysname + if ($etp_extref_1_node & 0x3f) != 0xb || $etp_extref_1_i < 3 + # Node should be an atom + set $etp_extref_1_error = 1 + else + ## $etp_extref_1_i now equals data (Uint) words + set $etp_extref_1_i -= 2 + if $etp_arch64 + if ((((int) $etp_extref_1_p->data.ui32[0]) + 1) \ + > (2 * $etp_extref_1_i)) + set $etp_extref_1_error = 1 + else + set $etp_extref_1_nump = &$etp_extref_1_p->data.ui32[1] + set $etp_extref_1_i = (int) $etp_extref_1_p->data.ui32[0] + end + else + set $etp_extref_1_nump = &$etp_extref_1_p->data.ui32[0] + end + ## $etp_extref_1_i now equals no of ref num (Uint32) words + if !$etp_extref_1_error + if $etp_extref_1_dep == erts_this_dist_entry + printf "#Ref<0:" + else + printf "#Ref<%u:", $etp_extref_1_node>>6 + end + etp-atom-1 ($etp_extref_1_node) + printf "/%u", $etp_extref_1_creation + end + end + if $etp_extref_1_error + printf "#ExternalRefError<%#x>", ($arg0) + else + set $etp_extref_1_i-- + while $etp_extref_1_i >= 0 + printf ".%u", (unsigned) $etp_extref_1_nump[$etp_extref_1_i] + set $etp_extref_1_i-- + end + printf ">" + end + end + end +end + + + +define etp-mfa-1 +# Args: Eterm*, int offset +# +# Reentrant +# + printf "<" + etp-atom-1 (((Eterm*)($arg0))[0]) + printf ":" + etp-atom-1 (((Eterm*)($arg0))[1]) + printf "/%d", ((Eterm*)($arg0))[2] + if ($arg1) > 0 + printf "+%#x>", ($arg1) + else + printf ">" + end +end + +define etp-mfa +# Args: Eterm* +# +# Reentrant capable +# + etp-mfa-1 ($arg0) 0 + printf ".\n" +end + +document etp-mfa +%--------------------------------------------------------------------------- +% etp-mfa Eterm* +% +% Take an Eterm* to an MFA function name entry and print it. +% These can be found e.g in the process structure; +% process_tab[i]->current and process_tab[i]->initial. +%--------------------------------------------------------------------------- +end + + + +define etp-cp-1 +# Args: Eterm cp +# +# Non-reentrant +# + set $etp_cp = (Eterm)($arg0) + set $etp_cp_low = modules + set $etp_cp_high = $etp_cp_low + num_loaded_modules + set $etp_cp_mid = mid_module + set $etp_cp_p = 0 + # + while $etp_cp_low < $etp_cp_high + if $etp_cp < $etp_cp_mid->start + set $etp_cp_high = $etp_cp_mid + else + if $etp_cp > $etp_cp_mid->end + set $etp_cp_low = $etp_cp_mid + 1 + else + set $etp_cp_p = $etp_cp_low = $etp_cp_high = $etp_cp_mid + end + end + set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2 + end + if $etp_cp_p + set $etp_cp_low = (Eterm**)($etp_cp_p->start + 8) + set $etp_cp_high = $etp_cp_low +$etp_cp_p->start[0] + set $etp_cp_p = 0 + while $etp_cp_low < $etp_cp_high + set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2 + if $etp_cp < $etp_cp_mid[0] + set $etp_cp_high = $etp_cp_mid + else + if $etp_cp < $etp_cp_mid[1] + set $etp_cp_p = $etp_cp_mid[0]+2 + set $etp_cp_low = $etp_cp_high = $etp_cp_mid + else + set $etp_cp_low = $etp_cp_mid + 1 + end + end + end + end + if $etp_cp_p + printf "#Cp" + etp-mfa-1 ($etp_cp_p) ($etp_cp-((Eterm)($etp_cp_p-2))) + else + if $etp_cp == beam_apply+1 + printf "#Cp<terminate process normally>" + else + if *(Eterm*)($etp_cp) == beam_return_trace[0] + if ($etp_cp) == beam_exception_trace + printf "#Cp<exception trace>" + else + printf "#Cp<return trace>" + end + else + if *(Eterm*)($etp_cp) == beam_return_to_trace[0] + printf "#Cp<return to trace>" + else + printf "#Cp<%#x>", $etp_cp + end + end + end + end +end + +define etp-cp +# Args: Eterm cp +# +# Reentrant capable +# + etp-cp-1 ($arg0) + printf ".\n" +end + +document etp-cp +%--------------------------------------------------------------------------- +% etp-cp Eterm +% +% Take a code continuation pointer and print +% module, function, arity and offset. +% +% Code continuation pointers can be found in the process structure e.g +% process_tab[i]->cp and process_tab[i]->i, the second is the +% program counter, which is the same thing as a continuation pointer. +%--------------------------------------------------------------------------- +end + +############################################################################ +# Commands for special term bunches. +# + +define etp-msgq +# Args: ErlMessageQueue* +# +# Non-reentrant +# + set $etp_msgq = ($arg0) + set $etp_msgq_p = $etp_msgq->first + set $etp_msgq_i = $etp_msgq->len + set $etp_msgq_prev = $etp_msgq->last + printf "%% Message queue (%d):", $etp_msgq_i + if ($etp_msgq_i > 0) && $etp_msgq_p + printf "\n[" + else + printf "\n" + end + while ($etp_msgq_i > 0) && $etp_msgq_p + set $etp_msgq_i-- + set $etp_msgq_next = $etp_msgq_p->next + # Msg + etp-1 ($etp_msgq_p->m[0]) 0 + if ($etp_msgq_i > 0) && $etp_msgq_next + printf ", %% " + else + printf "]. %% " + end + # Seq_trace token + etp-1 ($etp_msgq_p->m[1]) 0 + if $etp_msgq_p == $etp_msgq->save + printf ", <=\n" + else + printf "\n" + end + if ($etp_msgq_i > 0) && $etp_msgq_next + printf " " + end + # + set $etp_msgq_prev = $etp_msgq_p + set $etp_msgq_p = $etp_msgq_next + end + if $etp_msgq_i != 0 + printf "#MsgQShort<%d>\n", $etp_msgq_i + end + if $etp_msgq_p != 0 + printf "#MsgQLong<%#lx%p>\n", (unsigned long)$etp_msgq_p + end + if $etp_msgq_prev != $etp_msgq->last + printf "#MsgQEndError<%#lx%p>\n", (unsigned long)$etp_msgq_prev + end +end + +document etp-msgq +%--------------------------------------------------------------------------- +% etp-msgq ErlMessageQueue* +% +% Take an ErlMessageQueue* and print the contents of the message queue. +% Sequential trace tokens are included in comments and +% the current match position in the queue is marked '<='. +% +% A process's message queue is process_tab[i]->msg. +%--------------------------------------------------------------------------- +end + + + +define etpf-msgq +# Args: Process* +# +# Non-reentrant +# + set $etp_flat = 1 + etp-msgq ($arg0) + set $etp_flat = 0 +end + +document etpf-msgq +%--------------------------------------------------------------------------- +% etpf-msgq ErlMessageQueue* +% +% Same as 'etp-msgq' but print the messages using etpf (flat). +%--------------------------------------------------------------------------- +end + + + +define etp-stacktrace +# Args: Process* +# +# Non-reentrant +# + set $etp_stacktrace_p = ($arg0)->stop + set $etp_stacktrace_end = ($arg0)->hend + printf "%% Stacktrace (%u): ", $etp_stacktrace_end-$etp_stacktrace_p + etp ($arg0)->cp + while $etp_stacktrace_p < $etp_stacktrace_end + if ($etp_stacktrace_p[0] & 0x3) == 0x0 + # Continuation pointer + etp $etp_stacktrace_p[0] + end + set $etp_stacktrace_p++ + end +end + +document etp-stacktrace +%--------------------------------------------------------------------------- +% etp-stacktrace Process* +% +% Take an Process* and print a stactrace for the process. +% The stacktrace consists just of the pushed code continuation +% pointers on the stack, the most recently pushed first. +%--------------------------------------------------------------------------- +end + +define etp-stackdump +# Args: Process* +# +# Non-reentrant +# + set $etp_stackdump_p = ($arg0)->stop + set $etp_stackdump_end = ($arg0)->hend + printf "%% Stackdump (%u): ", $etp_stackdump_end-$etp_stackdump_p + etp ($arg0)->cp + while $etp_stackdump_p < $etp_stackdump_end + etp $etp_stackdump_p[0] + set $etp_stackdump_p++ + end +end + +document etp-stackdump +%--------------------------------------------------------------------------- +% etp-stackdump Process* +% +% Take an Process* and print a stackdump for the process. +% The stackdump consists of all pushed values on the stack. +% All code continuation pointers are preceeded with a line +% of dashes to make the stack frames more visible. +%--------------------------------------------------------------------------- +end + +define etpf-stackdump +# Args: Process* +# +# Non-reentrant +# + set $etp_flat = 1 + etp-stackdump ($arg0) + set $etp_flat = 0 +end + +document etpf-stackdump +%--------------------------------------------------------------------------- +% etpf-stackdump Process* +% +% Same as etp-stackdump but print the values using etpf (flat). +%--------------------------------------------------------------------------- +end + + + +define etp-dictdump +# Args: ProcDict* +# +# Non-reentrant +# + set $etp_dictdump = ($arg0) + if $etp_dictdump + set $etp_dictdump_n = \ + $etp_dictdump->homeSize + $etp_dictdump->splitPosition + set $etp_dictdump_i = 0 + set $etp_dictdump_written = 0 + if $etp_dictdump_n > $etp_dictdump->size + set $etp_dictdump_n = $etp_dictdump->size + end + set $etp_dictdump_cnt = $etp_dictdump->numElements + printf "%% Dictionary (%d):\n[", $etp_dictdump_cnt + while $etp_dictdump_i < $etp_dictdump_n && \ + $etp_dictdump_cnt > 0 + set $etp_dictdump_p = $etp_dictdump->data[$etp_dictdump_i] + if $etp_dictdump_p != $etp_nil + if ((Eterm)$etp_dictdump_p & 0x3) == 0x2 + # Boxed + if $etp_dictdump_written + printf ",\n " + else + set $etp_dictdump_written = 1 + end + etp-1 $etp_dictdump_p 0 + set $etp_dictdump_cnt-- + else + while ((Eterm)$etp_dictdump_p & 0x3) == 0x1 && \ + $etp_dictdump_cnt > 0 + # Cons ptr + if $etp_dictdump_written + printf ",\n " + else + set $etp_dictdump_written = 1 + end + etp-1 (((Eterm*)((Eterm)$etp_dictdump_p&~0x3))[0]) 0 + set $etp_dictdump_cnt-- + set $etp_dictdump_p = ((Eterm*)((Eterm)$etp_dictdump_p & ~0x3))[1] + end + if $etp_dictdump_p != $etp_nil + printf "#DictSlotError<%d>:", $etp_dictdump_i + set $etp_dictdump_flat = $etp_flat + set $etp_flat = 1 + etp-1 ((Eterm)$etp_dictdump_p) 0 + set $etp_flat = $etp_dictdump_flat + end + end + end + set $etp_dictdump_i++ + end + if $etp_dictdump_cnt != 0 + printf "#DictCntError<%d>, ", $etp_dictdump_cnt + end + else + printf "%% Dictionary (0):\n[" + end + printf "].\n" +end + +document etp-dictdump +%--------------------------------------------------------------------------- +% etp-dictdump ErlProcDict* +% +% Take an ErlProcDict* and print all entries in the process dictionary. +%--------------------------------------------------------------------------- +end + +define etpf-dictdump +# Args: ErlProcDict* +# +# Non-reentrant +# + set $etp_flat = 1 + etp-dictdump ($arg0) + set $etp_flat = 0 +end + +document etpf-dictdump +%--------------------------------------------------------------------------- +% etpf-dictdump ErlProcDict* +% +% Same as etp-dictdump but print the values using etpf (flat). +%--------------------------------------------------------------------------- +end + + + +define etp-offheapdump +# Args: ( ExternalThing* | ProcBin* | ErlFunThing* ) +# +# Non-reentrant +# + set $etp_offheapdump_p = ($arg0) + set $etp_offheapdump_i = 0 + set $etp_offheapdump_ + printf "%% Offheap dump:\n[" + while ($etp_offheapdump_p != 0) && ($etp_offheapdump_i < $etp_max_depth) + if ((Eterm)$etp_offheapdump_p & 0x3) == 0x0 + if $etp_offheapdump_i > 0 + printf ",\n " + end + etp-1 ((Eterm)$etp_offheapdump_p|0x2) 0 + set $etp_offheapdump_p = $etp_offheapdump_p->next + set $etp_offheapdump_i++ + else + printf "#TaggedPtr<%#x>", $etp_offheapdump_p + set $etp_offheapdump_p = 0 + end + end + printf "].\n" +end + +document etp-offheapdump +%--------------------------------------------------------------------------- +% etp-offheapdump ( ExternalThing* | ProcBin* | ErlFunThing* ) +% +% Take an pointer to a linked list and print the terms in the list +% up to the max depth. +%--------------------------------------------------------------------------- +end + +define etpf-offheapdump +# Args: ( ExternalThing* | ProcBin* | ErlFunThing* ) +# +# Non-reentrant +# + set $etp_flat = 1 + etp-offheapdump ($arg0) + set $etp_flat = 0 +end + +document etpf-offheapdump +%--------------------------------------------------------------------------- +% etpf-offheapdump ( ExternalThing* | ProcBin* | ErlFunThing* ) +% +% Same as etp-offheapdump but print the values using etpf (flat). +%--------------------------------------------------------------------------- +end + +define etp-print-procs +# Args: Eterm +# +# Non-reentrant +# + etp-print-procs-1 +end + +define etp-print-procs-1 +# Args: Eterm* +# +# Non-reentrant +# + set $etp_print_procs_q = erts_max_processes / 10 + set $etp_print_procs_r = erts_max_processes % 10 + set $etp_print_procs_t = 10 + set $etp_print_procs_m = $etp_print_procs_q + if $etp_print_procs_r > 0 + set $etp_print_procs_m++ + set $etp_print_procs_r-- + end + set $etp_print_procs_i = 0 + set $etp_print_procs_found = 0 + while $etp_print_procs_i < erts_max_processes + if process_tab[$etp_print_procs_i] + printf "%d: ", $etp_print_procs_i + etp-1 process_tab[$etp_print_procs_i]->id + printf " " + etp-1 ((Eterm)(process_tab[$etp_print_procs_i]->i)) + printf " heap=%d/%d(%d)", process_tab[$etp_print_procs_i]->htop - process_tab[$etp_print_procs_i]->heap, \ + process_tab[$etp_print_procs_i]->hend - process_tab[$etp_print_procs_i]->heap, \ + process_tab[$etp_print_procs_i]->hend - process_tab[$etp_print_procs_i]->stop + printf " old=%d/%d ", process_tab[$etp_print_procs_i]->old_htop - process_tab[$etp_print_procs_i]->old_heap, \ + process_tab[$etp_print_procs_i]->old_hend - process_tab[$etp_print_procs_i]->old_heap + printf " mbuf_sz=%d ", process_tab[$etp_print_procs_i]->mbuf_sz + printf " min=%d ", process_tab[$etp_print_procs_i]->min_heap_size + printf " flags=%x ", process_tab[$etp_print_procs_i]->flags + printf " msgs=%d ", process_tab[$etp_print_procs_i]->msg.len + printf "\n" + end + set $etp_print_procs_i++ + if $etp_print_procs_i > $etp_print_procs_m + printf "%% %d%%...\n", $etp_print_procs_t + set $etp_print_procs_t += 10 + set $etp_print_procs_m += $etp_print_procs_q + if $etp_print_procs_r > 0 + set $etp_print_procs_m++ + set $etp_print_procs_r-- + end + end + end + printf "%% 100%%.\n" +end + +document etp-print-procs +%--------------------------------------------------------------------------- +% etp-print-procs Eterm +% +% Print some information about ALL processes. +%--------------------------------------------------------------------------- +end + + +define etp-search-heaps +# Args: Eterm +# +# Non-reentrant +# + printf "%% Search all (<%u) process heaps for ", erts_max_processes + set $etp_flat = 1 + etp-1 ($arg0) 0 + set $etp_flat = 0 + printf ":...\n" + etp-search-heaps-1 ((Eterm*)((Eterm)($arg0)&~3)) +end + +define etp-search-heaps-1 +# Args: Eterm* +# +# Non-reentrant +# + set $etp_search_heaps_q = erts_max_processes / 10 + set $etp_search_heaps_r = erts_max_processes % 10 + set $etp_search_heaps_t = 10 + set $etp_search_heaps_m = $etp_search_heaps_q + if $etp_search_heaps_r > 0 + set $etp_search_heaps_m++ + set $etp_search_heaps_r-- + end + set $etp_search_heaps_i = 0 + set $etp_search_heaps_found = 0 + while $etp_search_heaps_i < erts_max_processes + if process_tab[$etp_search_heaps_i] + if (process_tab[$etp_search_heaps_i]->heap <= ($arg0)) && \ + (($arg0) < process_tab[$etp_search_heaps_i]->hend) + printf "process_tab[%d]->heap+%d\n", $etp_search_heaps_i, \ + ($arg0)-process_tab[$etp_search_heaps_i]->heap + end + if (process_tab[$etp_search_heaps_i]->old_heap <= ($arg0)) && \ + (($arg0) <= process_tab[$etp_search_heaps_i]->old_hend) + printf "process_tab[%d]->old_heap+%d\n", $etp_search_heaps_i, \ + ($arg0)-process_tab[$etp_search_heaps_i]->old_heap + end + set $etp_search_heaps_cnt = 0 + set $etp_search_heaps_p = process_tab[$etp_search_heaps_i]->mbuf + while $etp_search_heaps_p && ($etp_search_heaps_cnt < $etp_max_depth) + set $etp_search_heaps_cnt++ + if (&($etp_search_heaps_p->mem) <= ($arg0)) && \ + (($arg0) < &($etp_search_heaps_p->mem)+$etp_search_heaps_p->size) + printf "process_tab[%d]->mbuf(%d)+%d\n", \ + $etp_search_heaps_i, $etp_search_heaps_cnt, \ + ($arg0)-&($etp_search_heaps_p->mem) + end + set $etp_search_heaps_p = $etp_search_heaps_p->next + end + if $etp_search_heaps_p + printf "process_tab[%d] %% Too many HeapFragments\n", \ + $etp_search_heaps_i + end + end + set $etp_search_heaps_i++ + if $etp_search_heaps_i > $etp_search_heaps_m + printf "%% %d%%...\n", $etp_search_heaps_t + set $etp_search_heaps_t += 10 + set $etp_search_heaps_m += $etp_search_heaps_q + if $etp_search_heaps_r > 0 + set $etp_search_heaps_m++ + set $etp_search_heaps_r-- + end + end + end + printf "%% 100%%.\n" +end + +document etp-search-heaps +%--------------------------------------------------------------------------- +% etp-search-heaps Eterm +% +% Search all process heaps in process_tab[], including the heap fragments +% (process_tab[]->mbuf) for the specified Eterm. +%--------------------------------------------------------------------------- +end + + + +define etp-search-alloc +# Args: Eterm +# +# Non-reentrant +# + printf "%% Search allocated memory blocks for " + set $etp_flat = 1 + etp-1 ($arg0) 0 + set $etp_flat = 0 + printf ":...\n" + set $etp_search_alloc_n = sizeof(erts_allctrs) / sizeof(*erts_allctrs) + set $etp_search_alloc_i = 0 + while $etp_search_alloc_i < $etp_search_alloc_n + if erts_allctrs[$etp_search_alloc_i].alloc + set $etp_search_alloc_f = (erts_allctrs+$etp_search_alloc_i) + while ($etp_search_alloc_f->alloc == debug_alloc) || \ + ($etp_search_alloc_f->alloc == stat_alloc) || \ + ($etp_search_alloc_f->alloc == map_stat_alloc) + set $etp_search_alloc_f = \ + (ErtsAllocatorFunctions_t*)$etp_search_alloc_f->extra + end + if ($etp_search_alloc_f->alloc != erts_sys_alloc) && \ + ($etp_search_alloc_f->alloc != erts_fix_alloc) + if ($etp_search_alloc_f->alloc == erts_alcu_alloc) || \ + ($etp_search_alloc_f->alloc == erts_alcu_alloc_ts) + # alcu alloc + set $etp_search_alloc_e = (Allctr_t*)$etp_search_alloc_f->extra + # mbc_list + set $etp_search_alloc_p = $etp_search_alloc_e->mbc_list.first + set $etp_search_alloc_cnt = 0 + while $etp_search_alloc_p && \ + ($etp_search_alloc_cnt < $etp_max_depth) + set $etp_search_alloc_cnt++ + if $etp_search_alloc_p <= ($arg0) && \ + ($arg0) < (char*)$etp_search_alloc_p + \ + ($etp_search_alloc_p->chdr & (Uint)~7) + printf "erts_allctrs[%d] %% %salloc: mbc_list: %d\n", \ + $etp_search_alloc_i, $etp_search_alloc_e->name_prefix, \ + $etp_search_alloc_cnt + end + if $etp_search_alloc_p == $etp_search_alloc_e->mbc_list.last + if $etp_search_alloc_p->next + printf \ + "erts_allctrs[%d] %% %salloc: mbc_list.last error %p\n",\ + $etp_search_alloc_i, $etp_search_alloc_e->name_prefix,\ + $etp_search_alloc_p + end + set $etp_search_alloc_p = 0 + else + set $etp_search_alloc_p = $etp_search_alloc_p->next + end + end + if $etp_search_alloc_p + printf "erts_allctrs[%d] %% %salloc: too large mbc_list %p\n", \ + $ept_search_alloc_i, $etp_search_alloc_e->name_prefix, + $ept_search_alloc_p + end + # sbc_list + set $etp_search_alloc_p = $etp_search_alloc_e->sbc_list.first + set $etp_search_alloc_cnt = 0 + while $etp_search_alloc_p && \ + ($etp_search_alloc_cnt < $etp_max_depth) + set $etp_search_alloc_cnt++ + if $etp_search_alloc_p <= ($arg0) && \ + ($arg0) < (char*)$etp_search_alloc_p + \ + ($etp_search_alloc_p->chdr & (Uint)~7) + printf "erts_allctrs[%d] %% %salloc: sbc_list: %d\n", \ + $etp_search_alloc_i, $etp_search_alloc_e->name_prefix, \ + $etp_search_alloc_cnt + end + if $etp_search_alloc_p == $etp_search_alloc_e->sbc_list.last + if $etp_search_alloc_p->next + printf \ + "erts_allctrs[%d] %% %salloc: sbc_list.last error %p",\ + $etp_search_alloc_i, $etp_search_alloc_e->name_prefix,\ + $etp_search_alloc_p + end + set $etp_search_alloc_p = 0 + else + set $etp_search_alloc_p = $etp_search_alloc_p->next + end + end + if $etp_search_alloc_p + printf "erts_allctrs[%d] %% %salloc: too large sbc_list %p\n", \ + $ept_search_alloc_i, $etp_search_alloc_e->name_prefix, + $ept_search_alloc_p + end + else + printf "erts_allctrs[%d] %% %s: unknown allocator\n", \ + $etp_search_alloc_i, erts_alc_a2ad[$etp_search_alloc_i] + end + end + end + set $etp_search_alloc_i++ + end +end + +document etp-search-alloc +%--------------------------------------------------------------------------- +% etp-search-heaps Eterm +% +% Search all internal allocator memory blocks for for the specified Eterm. +%--------------------------------------------------------------------------- +end + + + +define etp-overlapped-heaps +# Args: +# +# Non-reentrant +# + printf "%% Dumping heap addresses to \"etp-commands.bin\"\n" + set $etp_overlapped_heaps_q = erts_max_processes / 10 + set $etp_overlapped_heaps_r = erts_max_processes % 10 + set $etp_overlapped_heaps_t = 10 + set $etp_overlapped_heaps_m = $etp_overlapped_heaps_q + if $etp_overlapped_heaps_r > 0 + set $etp_overlapped_heaps_m++ + set $etp_overlapped_heaps_r-- + end + set $etp_overlapped_heaps_i = 0 + set $etp_overlapped_heaps_found = 0 + dump binary value etp-commands.bin 'o' + append binary value etp-commands.bin 'v' + append binary value etp-commands.bin 'e' + append binary value etp-commands.bin 'r' + append binary value etp-commands.bin 'l' + append binary value etp-commands.bin 'a' + append binary value etp-commands.bin 'p' + append binary value etp-commands.bin 'p' + append binary value etp-commands.bin 'e' + append binary value etp-commands.bin 'd' + append binary value etp-commands.bin '-' + append binary value etp-commands.bin 'h' + append binary value etp-commands.bin 'e' + append binary value etp-commands.bin 'a' + append binary value etp-commands.bin 'p' + append binary value etp-commands.bin 's' + append binary value etp-commands.bin '\0' + while $etp_overlapped_heaps_i < erts_max_processes + if process_tab[$etp_overlapped_heaps_i] + append binary value etp-commands.bin \ + (Eterm)$etp_overlapped_heaps_i + append binary value etp-commands.bin \ + (Eterm)process_tab[$etp_overlapped_heaps_i]->heap + append binary value etp-commands.bin \ + (Eterm)process_tab[$etp_overlapped_heaps_i]->hend + append binary value etp-commands.bin \ + (Eterm)process_tab[$etp_overlapped_heaps_i]->old_heap + append binary value etp-commands.bin \ + (Eterm)process_tab[$etp_overlapped_heaps_i]->old_hend + set $etp_overlapped_heaps_p = process_tab[$etp_overlapped_heaps_i]->mbuf + set $etp_overlapped_heaps_cnt = 0 + while $etp_overlapped_heaps_p && \ + ($etp_overlapped_heaps_cnt < $etp_max_depth) + set $etp_overlapped_heaps_cnt++ + append binary value etp-commands.bin \ + (Eterm)$etp_overlapped_heaps_p + append binary value etp-commands.bin \ +(Eterm)(&($etp_overlapped_heaps_p->mem)+$etp_overlapped_heaps_p->size) + set $etp_overlapped_heaps_p = $etp_overlapped_heaps_p->next + end + if $etp_overlapped_heaps_p + printf "process_tab[%d] %% Too many HeapFragments\n", \ + $etp_overlapped_heaps_i + end + append binary value etp-commands.bin (Eterm)0x0 + append binary value etp-commands.bin (Eterm)0x0 + end + set $etp_overlapped_heaps_i++ + if $etp_overlapped_heaps_i > $etp_overlapped_heaps_m + printf "%% %d%%...\n", $etp_overlapped_heaps_t + set $etp_overlapped_heaps_t += 10 + set $etp_overlapped_heaps_m += $etp_overlapped_heaps_q + if $etp_overlapped_heaps_r > 0 + set $etp_overlapped_heaps_m++ + set $etp_overlapped_heaps_r-- + end + end + end + etp-run +end + +document etp-overlapped-heaps +%--------------------------------------------------------------------------- +% etp-overlapped-heaps +% +% Dump all process heap addresses in process_tab[], including +% the heap fragments in binary format on the file etp-commands.bin. +% Then call etp_commands:file/1 to analyze if any heaps overlap. +% +% Requires 'erl' in the path and 'etp_commands.beam' in 'erl's search path. +%--------------------------------------------------------------------------- +end + + + +define etp-chart +# Args: Process* +# +# Non-reentrant + etp-chart-start ($arg0) + set ($arg0) = ($arg0) + etp-msgq (($arg0)->msg) + etp-stackdump ($arg0) + etp-dictdump (($arg0)->dictionary) + etp-dictdump (($arg0)->debug_dictionary) + printf "%% Dumping other process data...\n" + etp ($arg0)->seq_trace_token + etp ($arg0)->fvalue + printf "%% Dumping done.\n" + etp-chart-print +end + +document etp-chart +%--------------------------------------------------------------------------- +% etp-chart Process* +% +% Dump all process data to the file "etp-commands.bin" and then use +% the Erlang support module to print a memory chart of all terms. +%--------------------------------------------------------------------------- +end + + + +define etp-chart-start +# Args: Process* +# +# Non-reentrant + set $etp_chart = 1 + set $etp_chart_id = 0 + set $etp_chart_start_p = ($arg0) + dump binary value etp-commands.bin 'c' + append binary value etp-commands.bin 'h' + append binary value etp-commands.bin 'a' + append binary value etp-commands.bin 'r' + append binary value etp-commands.bin 't' + append binary value etp-commands.bin '\0' + append binary value etp-commands.bin (Eterm)($etp_chart_start_p->heap) + append binary value etp-commands.bin (Eterm)($etp_chart_start_p->high_water) + append binary value etp-commands.bin (Eterm)($etp_chart_start_p->hend) + append binary value etp-commands.bin (Eterm)($etp_chart_start_p->old_heap) + append binary value etp-commands.bin (Eterm)($etp_chart_start_p->old_hend) + set $etp_chart_start_cnt = 0 + set $etp_chart_start_p = $etp_chart_start_p->mbuf + while $etp_chart_start_p && ($etp_chart_start_cnt < $etp_max_depth) + set $etp_chart_start_cnt++ + append binary value etp-commands.bin (Eterm)($etp_chart_start_p->mem) + append binary value etp-commands.bin (Eterm)($etp_chart_start_p->size) + set $etp_chart_start_p = $etp_chart_start_p->next + end + append binary value etp-commands.bin (Eterm)(0) + append binary value etp-commands.bin (Eterm)(0) + if $etp_chart_start_p + printf "%% Too many HeapFragments\n" + end +end + +document etp-chart-start +%--------------------------------------------------------------------------- +% etp-chart-start Process* +% +% Dump a chart head to the file "etp-commands.bin". +%--------------------------------------------------------------------------- +end + + + +define etp-chart-entry-1 +# Args: Eterm, int depth, int words +# +# Reentrant capable + if ($arg1) == 0 + set $etp_chart_id++ + printf "#%d:", $etp_chart_id + end + append binary value etp-commands.bin ($arg0)&~0x3 + append binary value etp-commands.bin (Eterm)(($arg2)*sizeof(Eterm)) + append binary value etp-commands.bin (Eterm)$etp_chart_id + append binary value etp-commands.bin (Eterm)($arg1) +# printf "<dumped %#x %lu %lu %lu>", ($arg0)&~0x3, \ +# (Eterm)(($arg2)*sizeof(Eterm)), (Eterm)$etp_chart_id, (Eterm)($arg1) +end + + + +define etp-chart-print + set $etp_chart = 0 + etp-run +end + +document etp-chart-print +%--------------------------------------------------------------------------- +% etp-chart-print Process* +% +% Print a memory chart of the dumped data in "etp-commands.bin", and stop +% chart recording. +%--------------------------------------------------------------------------- +end + +############################################################################ +# ETS table debug +# + +define etp-ets-tables +# Args: +# +# Non-reentrant + printf "%% Dumping < %lu ETS tables\n", (unsigned long)db_max_tabs + while $etp_ets_tables_i < db_max_tabs + if (meta_main_tab[$etp_ets_tables_i].u.next_free & 3) == 0 + printf "%% %d:", $etp_ets_tables_i + etp-1 ((Eterm)(meta_main_tab[$etp_ets_tables_i].u.tb->common.id)) 0 + printf " " + etp-1 ((Eterm)(meta_main_tab[$etp_ets_tables_i].u.tb->common.owner)) 0 + printf "\n" + end + set $etp_ets_tables_i++ + end + set $etp_ets_tables_i = 0 +end + +document etp-ets-tables +%--------------------------------------------------------------------------- +% etp-ets-tables +% +% Dump all ETS table names and their indexies. +%--------------------------------------------------------------------------- +end + +define etp-ets-tabledump +# Args: int tableindex +# +# Non-reentrant + printf "%% Dumping ETS table %d:", ($arg0) + set $etp_ets_tabledump_n = 0 + set $etp_ets_tabledump_t = meta_main_tab[($arg0)].u.tb + set $etp_ets_tabledump_i = 0 + etp-1 ($etp_ets_tabledump_t->common.the_name) 0 + printf " status=%#x\n", $etp_ets_tabledump_t->common.status + if $etp_ets_tabledump_t->common.status & 0x130 + # Hash table + set $etp_ets_tabledump_h = $etp_ets_tabledump_t->hash + printf "%% nitems=%d\n", $etp_ets_tabledump_t->common.nitems + while $etp_ets_tabledump_i < $etp_ets_tabledump_h->nactive + set $etp_ets_tabledump_l = $etp_ets_tabledump_h->seg \ + [$etp_ets_tabledump_i>>8][$etp_ets_tabledump_i&0xFF] + if $etp_ets_tabledump_l + printf "%% Slot %d:\n", $etp_ets_tabledump_i + while $etp_ets_tabledump_l + if $etp_ets_tabledump_n + printf "," + else + printf "[" + end + set $etp_ets_tabledump_n++ + etp-1 ((Eterm)($etp_ets_tabledump_l->dbterm.tpl)|0x2) 0 + if $etp_ets_tabledump_l->hvalue == ((unsigned long)-1) + printf "% *\n" + else + printf "\n" + end + set $etp_ets_tabledump_l = $etp_ets_tabledump_l->next + if $etp_ets_tabledump_n >= $etp_max_depth + set $etp_ets_tabledump_l = 0 + end + end + end + set $etp_ets_tabledump_i++ + end + if $etp_ets_tabledump_n + printf "].\n" + end + else + printf "%% Not a hash table\n" + end +end + +document etp-ets-tabledump +%--------------------------------------------------------------------------- +% etp-ets-tabledump Slot +% +% Dump an ETS table with a specified slot index. +%--------------------------------------------------------------------------- +end + +############################################################################ +# Erlang support module handling +# + +define etp-run + shell make -f "${ROOTDIR:?}/erts/etc/unix/etp_commands.mk" \ + ROOTDIR="${ROOTDIR:?}" ETP_DATA="etp-commands.bin" +end + +document etp-run +%--------------------------------------------------------------------------- +% etp-run +% +% Make and run the Erlang support module on the input file +% "erl-commands.bin". The environment variable ROOTDIR must +% be set to find $ROOTDIR/erts/etc/unix/etp_commands.mk. +% +% Also, erl and erlc must be in the path. +%--------------------------------------------------------------------------- +end + +############################################################################ +# Toolbox parameter handling +# + +define etp-set-max-depth + if ($arg0) > 0 + set $etp_max_depth = ($arg0) + else + echo %%%Error: max-depth <= 0 %%%\n + end +end + +document etp-set-max-depth +%--------------------------------------------------------------------------- +% etp-set-max-depth Depth +% +% Set the max term depth to use for etp. The term dept limit +% works in both depth and width, so if you set the max depth to 10, +% an 11 element flat tuple will be truncated. +%--------------------------------------------------------------------------- +end + +define etp-set-max-string-length + if ($arg0) > 0 + set $etp_max_string_length = ($arg0) + else + echo %%%Error: max-string-length <= 0 %%%\n + end +end + +document etp-set-max-string-length +%--------------------------------------------------------------------------- +% etp-set-max-strint-length Length +% +% Set the max string length to use for ept when printing lists +% that can be shown as printable strings. Printable strings +% that are longer will be truncated, and not even checked if +% they really are printable all the way to the end. +%--------------------------------------------------------------------------- +end + +define etp-show + printf "etp-set-max-depth %d\n", $etp_max_depth + printf "etp-set-max-string-length %d\n", $etp_max_string_length +end + +document etp-show +%--------------------------------------------------------------------------- +% etp-show +% +% Show the commands needed to set all etp parameters +% to their current value. +%--------------------------------------------------------------------------- +end + +############################################################################ +# Init +# + +define etp-init + set $etp_arch64 = (sizeof(void *) == 8) + if $etp_arch64 + set $etp_nil = 0xfffffffffffffffb + else + set $etp_nil = 0xfffffffb + end + set $etp_flat = 0 + set $etp_chart_id = 0 + set $etp_chart = 0 + + set $etp_max_depth = 20 + set $etp_max_string_length = 100 + + set $etp_ets_tables_i = 0 +end + +document etp-init +%--------------------------------------------------------------------------- +% Use etp-help for a command overview and general help. +% +% To use the Erlang support module, the environment variable ROOTDIR +% must be set to the toplevel installation directory of Erlang/OTP, +% so the etp-commands file becomes: +% $ROOTDIR/erts/etc/unix/etp-commands +% Also, erl and erlc must be in the path. +%--------------------------------------------------------------------------- +end + + +etp-init +help etp-init +etp-show diff --git a/erts/etc/unix/etp_commands.erl b/erts/etc/unix/etp_commands.erl new file mode 100644 index 0000000000..66cb76edbc --- /dev/null +++ b/erts/etc/unix/etp_commands.erl @@ -0,0 +1,173 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(etp_commands). + +-export([file/1]). + +file([Fname]) -> + Result = (catch file_1(Fname)), + io:format("% ~p~n", [Result]), + init:stop(). + +file_1(Fname) -> + io:format("% Reading ~p...~n", [Fname]), + {ok,Fd} = file:open(Fname, [read,binary]), + case read_op(Fd, 128) of + "chart" -> + io:format("% Reading heap chart data...~n"), + chart_scan(Fd); + "overlapped-heaps" -> + io:format("% Reading overlapped-heaps data...~n"), + overlapped_scan(Fd) + end. + +read_op(_Fd, 0) -> + []; +read_op(Fd, N) -> + case file:read(Fd, 1) of + {ok,<<0>>} -> []; + {ok,<<C>>} -> [C|read_op(Fd, N-1)] + end. + + + +overlapped_scan(Fd) -> + overlapped_scan_1(Fd, []). + +overlapped_scan_1(Fd, R) -> + case file:read(Fd, 4*5) of + eof -> + io:format("% Analyzing overlaps...~n"), + overlapped_analyze(lists:sort(R)); + {ok,<<Id:32/native,Heap:32/native,Hend:32/native, + 0:32/native,0:32/native>>} + when Heap < Hend -> + overlapped_scan_to_0(Fd, [{{Heap,Hend},{Id,heap}}|R], Id, 1); + {ok,<<Id:32/native,Heap:32/native,Hend:32/native, + OldHeap:32/native,OldHend:32/native>>} + when Heap < Hend, OldHeap < OldHend-> + overlapped_scan_to_0(Fd, [{{Heap,Hend},{Id,heap}}, + {{OldHeap,OldHend},{Id,old_heap}}|R], + Id, 1) + end. + +overlapped_scan_to_0(Fd, R, Id, Cnt) -> + case file:read(Fd, 4*2) of + {ok,<<0:32/native,0:32/native>>} -> + overlapped_scan_1(Fd, R); + {ok,<<Heap:32/native,Hend:32/native>>} + when Heap < Hend -> + overlapped_scan_to_0(Fd, + [{{Heap,Hend},{Id,{heap_fragment,Cnt}}}|R], + Id, Cnt+1); + eof -> + io:format("% Premature end of dump: ~p~n", [Id,Cnt|R]) + end. + +overlapped_analyze([]) -> + io:format("% Oops! was that file empty?~n"); +overlapped_analyze([{{_,Hend1},_}|[{{Heap2,_},_}|_]=R]) + when Hend1 =< Heap2 -> + overlapped_analyze(R); +overlapped_analyze([{Addrs1,Tag1}|[{Addrs2,Tag2}|_]=R]) -> + io:format("% ~p overlaps ~p (~p,~p)~n", [Tag1,Tag2,Addrs1,Addrs2]), + overlapped_analyze(R); +overlapped_analyze([_]) -> + io:format("% End of overlaps~n"). + + +chart_scan(Fd) -> + {ok,<<Heap:32/native,HighWater:32/native,Hend:32/native, + OldHeap:32/native,OldHend:32/native>>} = file:read(Fd, 4*5), + chart_scan_1(Fd, + [{Heap,Heap,heap,0}, + {HighWater,HighWater,high_water,0}, + {Hend,Hend,hend,0}, + {OldHeap,OldHeap,old_heap,0}, + {OldHend,OldHend,old_hend,0}|chart_scan_hdr(Fd)]). + +chart_scan_hdr(Fd) -> + chart_scan_hdr_2(0, chart_scan_hdr_1(Fd)). + +chart_scan_hdr_1(Fd) -> + case file:read(Fd, 4*2) of + eof -> []; + {ok,<<0:32/native,0:32/native>>} -> []; + {ok,<<Start:32/native,Size:32/native>>} -> + [{Start,Size}|chart_scan_hdr_1(Fd)] + end. + +chart_scan_hdr_2(_N, []) -> []; +chart_scan_hdr_2(N, [{Start,End}|T]) when Start =< End -> + [{Start,Start,{heap_frag,N},0},{End,End,{heap_frag_end,N},0} + |chart_scan_hdr_2(N+1, T)]. + +chart_scan_1(Fd, R) -> + case file:read(Fd, 4*4) of + eof -> + io:format("% Analyzing heap chart...~n"), + chart_analyze(lists:sort(R)); + {ok, + <<Addr:32/native,Size:32/native,Id:32/native,Depth:32/native>>} -> + chart_scan_1(Fd, [{Addr,Addr+Size,Id,Depth}|R]) + end. + +%-define(raw_chart_dump, 1). +-ifdef(raw_chart_dump). + +chart_analyze([]) -> + io:format("% End of chart~n"); +chart_analyze([{S,E,Id,D}|R]) -> + io:format("% ~.16x-~.16x: ~w[~w]~n", + [S,"0x",E,"0x",Id,D]), + chart_analyze(R). + +-else. + +chart_analyze([]) -> + io:format("% ***Oops, was chart empty?***~n"); +chart_analyze([{S,_,Id,D}=X|R]) -> + io:format("% ~.16x: ~w[~w", [S,"0x",Id,D]), + chart_analyze_1(R, X). + +chart_analyze_1([{S,E,Id,D}=X|R], {S,E,Id,_}) -> + io:format(",~w", [D]), + chart_analyze_1(R, X); +chart_analyze_1([{S,E,Id,D}=X|R], {S,E,_,_}) -> + io:format("],~w[~w", [Id,D]), + chart_analyze_1(R, X); +chart_analyze_1(R, X) -> + io:format("]~n"), + chart_analyze_2(R, X). + +chart_analyze_2([], {_,E,_,_}) -> + io:format("% ~.16x: End of chart~n", [E,"0x"]); +chart_analyze_2([{S,_,_,_}|_]=R, {_,E,_,_}) -> + if E == S -> + chart_analyze(R); + E < S -> + io:format("% ~.16x:~n", [E,"0x"]), + chart_analyze(R); + true -> + io:format("% ~.16x: ***Overlap***~n", [E,"0x"]), + chart_analyze(R) + end. + +-endif. diff --git a/erts/etc/unix/etp_commands.mk b/erts/etc/unix/etp_commands.mk new file mode 100644 index 0000000000..1d9a269b68 --- /dev/null +++ b/erts/etc/unix/etp_commands.mk @@ -0,0 +1,27 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2005-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +MAKE_AND_EXECUTE_ETP_COMMANDS : $(ETP_DATA) etp_commands.beam + erl -noshell -run etp_commands file "$(ETP_DATA)" + +.PHONY : MAKE_AND_EXECUTE_ETP_COMMANDS + +etp_commands.beam : $(ROOTDIR)/erts/etc/unix/etp_commands.erl $(ROOTDIR)/erts/etc/unix/etp_commands.mk + erlc $(ROOTDIR)/erts/etc/unix/etp_commands.erl + diff --git a/erts/etc/unix/format_man_pages b/erts/etc/unix/format_man_pages new file mode 100644 index 0000000000..2c4f6eee4f --- /dev/null +++ b/erts/etc/unix/format_man_pages @@ -0,0 +1,149 @@ +#!/bin/sh +# +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Format man_pages +# + +ERL_ROOT=$1 + +echo "Formatting manual pages (this may take a while...)" + +if [ -z "$ERL_ROOT" -o ! -d "$ERL_ROOT" ] +then + echo "Install: need ERL_ROOT directory as argument" + exit 1 +fi + +if [ `echo $ERL_ROOT | awk '{ print substr($1,1,1) }'` != "/" ] +then + echo "Install: need an absolute path to ERL_ROOT" + exit 1 +fi + +# +# Fetch target system. +# +SYS=`(uname -s) 2>/dev/null` || SYS=unknown +REL=`(uname -r) 2>/dev/null` || REL=unknown +case $SYS:$REL in + SunOS:5.*) + TARGET=sunos5 ;; + Linux:*) + TARGET=linux ;; + Darwin:9.*) + TARGET=darwin ;; + OpenBSD:3.*) + TARGET=openbsd ;; + *) + TARGET="" ;; +esac + +# +# Create the 'cat' directories (probably not needed) +# + +cd $ERL_ROOT + +if [ ! -d man/cat1 ] +then + mkdir man/cat1 +fi + +if [ ! -d man/cat3 ] +then + mkdir man/cat3 +fi + +if [ ! -d man/cat4 ] +then + mkdir man/cat4 +fi + +if [ ! -d man/cat6 ] +then + mkdir man/cat6 +fi + +# +# Cleanup old formatting +# + +cd $ERL_ROOT/man + +rm -f whatis windex + +# Remove old cat files +rm -f cat*/*.[0-9]* *.txt + +# +# Create new formatted pages +# + +case :"$TARGET" in +:linux|:darwin) + # Do not build whatis database, since makewhatis can only run by root + # echo "whatis database not created, since makewhatis can only be run by root." + ## We would have run + ## /usr/sbin/makewhatis -v $ERL_ROOT/man -c $ERL_ROOT/man > /dev/null 2>&1 + + if [ ! -x /usr/bin/groff ]; then + echo "Cannot find groff - no formating of manual pages" + exit + fi + + echo "Creating cat files ..." + + # Create cat files + for dir in man* + do + cd $dir + for file in *.[0-9]* + do + if [ -f $file ]; then + name=`echo $file | sed 's/\.[^.]*$//'` + sec=`echo $file | sed 's/.*\.//'` + /usr/bin/groff -Tascii -mandoc $ERL_ROOT/man/man$sec/$file \ + > $ERL_ROOT/man/cat$sec/$file + fi + done + cd .. + done + ;; +:*) + if [ -f "/vmunix" ]; then + CATMAN=/usr/etc/catman + elif [ "$TARGET" = "openbsd" ]; then + CATMAN=/usr/sbin/catman + else + CATMAN=/usr/bin/catman + fi + + if [ "$TARGET" = "sunos5" ] + then + # Special processing of footer + rm -f /tmp/erltmac_an + sed 's/Last change://g' /usr/share/lib/tmac/an > /tmp/erltmac_an + $CATMAN -M $ERL_ROOT/man -T /tmp/erltmac_an > /dev/null 2>&1 + rm -f /tmp/erltmac_an + fi + + $CATMAN -M $ERL_ROOT/man > /dev/null 2>&1 + ;; +esac diff --git a/erts/etc/unix/makewhatis b/erts/etc/unix/makewhatis new file mode 100644 index 0000000000..047c6efdfa --- /dev/null +++ b/erts/etc/unix/makewhatis @@ -0,0 +1,327 @@ +#!/bin/sh +# makewhatis: create the whatis database +# Created: Sun Jun 14 10:49:37 1992 +# Revised: Sat Jan 8 14:12:37 1994 by [email protected] +# Revised: Sat Mar 23 17:56:18 1996 by [email protected] +# Copyright 1992, 1993, 1994 Rickard E. Faith ([email protected]) +# May be freely distributed and modified as long as copyright is retained. +# +# Wed Dec 23 13:27:50 1992: Rik Faith ([email protected]) applied changes +# based on Mitchum DSouza ([email protected]) cat patches. +# Also, cleaned up code and make it work with NET-2 doc pages. +# +# makewhatis-1.4: aeb 940802, 941007, 950417 +# Fixed so that the -c option works correctly for the cat pages +# on my machine. Fix for -u by Nan Zou ([email protected]). +# Many minor changes. +# The -s option is undocumented, and may well disappear again. +# +# Sat Mar 23 1996: Michael Hamilton ([email protected]). +# I changed the script to invoke gawk only once for each directory tree. +# This speeds things up considerably (from 30 minutes down to 1.5 minutes +# on my 486DX66). +# 960401 - aeb: slight adaptation to work correctly with cat pages. +# 960510 - added fixes by [email protected], author of mawk. +# 971012 - replaced "test -z" - it doesnt work on SunOS 4.1.3_U1. +# 980710 - be more careful with TMPFILE +# +# Note for Slackware users: "makewhatis -v -w -c" will work. + +# %ExternalCopyright% +PATH=/usr/bin:/bin + +DEFMANPATH=/usr/man +DEFCATPATH=/usr/man/preformat:/usr/man + +# Find a place for our temporary files. If security is not a concern, use +# TMPFILE=/tmp/whatis$$; TMPFILEDIR=none +# Of course makewhatis should only have the required permissions +# (for reading and writing directories like /usr/man). +# We try here to be careful (and avoid preconstructed symlinks) +# in case makewhatis is run as root, by creating a subdirectory of /tmp. +# If that fails we use $HOME. +# The code below uses test -O which doesnt work on all systems. +TMPFILE=$HOME/whatis$$ +TMPFILEDIR=/tmp/whatis$$ +if [ ! -d $TMPFILEDIR ]; then + mkdir $TMPFILEDIR + chmod 0700 $TMPFILEDIR + if [ -O $TMPFILEDIR ]; then + TMPFILE=$TMPFILEDIR/w + fi +fi + +topath=manpath + +defmanpath=$DEFMANPATH +defcatpath= + +sections="1 2 3 4 5 6 7 8 9 n l" + +for name in $* +do +if [ -n "$setsections" ]; then + setsections= + sections=$name + continue +fi +case $name in + -c) topath=catpath + defmanpath= + defcatpath=$DEFCATPATH + continue;; + -s) setsections=1 + continue;; + -u) findarg="-ctime 0" + update=1 + continue;; + -v) verbose=1 + continue;; + -w) manpath=`man --path` + continue;; + -*) echo "Usage: makewhatis [-u] [-v] [-w] [manpath] [-c [catpath]]" + echo " This will build the whatis database for the man pages" + echo " found in manpath and the cat pages found in catpath." + echo " -u: update database with new pages" + echo " -v: verbose" + echo " -w: use manpath obtained from \`man --path\`" + echo " [manpath]: man directories (default: $DEFMANPATH)" + echo " [catpath]: cat directories (default: the first existing" + echo " directory in $DEFCATPATH)" + exit;; + *) if [ -d $name ] + then + eval $topath="\$$topath":$name + else + echo "No such directory $name" + exit + fi;; +esac +done + +manpath=`echo ${manpath-$defmanpath} | tr : ' '` +if [ x"$catpath" = x ]; then + for d in `echo $defcatpath | tr : ' '` + do + if [ -d $d ]; then catpath=$d; break; fi + done +fi +catpath=`echo ${catpath} | tr : ' '` + +# first truncate all the whatis files that will be created new, +# then only update - we might visit the same directory twice +if [ x$update = x ]; then + for pages in man cat + do + eval path="\$$pages"path + for mandir in $path + do + cp /dev/null $mandir/whatis + done + done +fi + +for pages in man cat +do + export pages + eval path="\$$pages"path + for mandir in $path + do + if [ x$verbose != x ]; then + echo "about to enter $mandir" > /dev/tty + fi + if [ -s ${mandir}/whatis -a $pages = man ]; then + if [ x$verbose != x ]; then + echo skipping $mandir - we did it already > /dev/tty + fi + else + here=`pwd` + cd $mandir + for i in $sections + do + if [ -d ${pages}$i ] + then + cd ${pages}$i + section=$i + export section verbose + find . -name '*' $findarg -print | /usr/bin/gawk ' + + function readline() { + if (use_zcat) { + result = (pipe_cmd | getline); + if (result < 0) { + print "Pipe error: " pipe_cmd " " ERRNO > "/dev/stderr"; + } + } else { + result = (getline < filename); + if (result < 0) { + print "Read file error: " filename " " ERRNO > "/dev/stderr"; + } + } + return result; + } + + function closeline() { + if (use_zcat) { + return close(pipe_cmd); + } else { + return close(filename); + } + } + + function do_one() { + after = 0; insh = 0; thisjoin = 1; charct = 0; + + if (verbose) { + print "adding " filename > "/dev/tty" + } + + use_zcat = (filename ~ /\.Z$/ || filename ~ /\.z$/ || + filename ~ /\.gz$/); + match(filename, "/[^/]+$"); + progname = substr(filename, RSTART + 1, RLENGTH - 1); + if (match(progname, "\\." section "[A-Za-z]+")) { + actual_section = substr(progname, RSTART + 1, RLENGTH - 1); + } else { + actual_section = section; + } + sub(/\..*/, "", progname); + if (use_zcat) { + pipe_cmd = "zcat " filename; + } + + while (readline() > 0) { + gsub(/.\b/, ""); + if (($1 ~ /^\.[Ss][Hh]/ && $2 ~ /[Nn][Aa][Mm][Ee]/) || + (pages == "cat" && $1 ~ /^NAME/)) { + if (!insh) + insh = 1; + else { + printf "\n"; + closeline(); + return; + } + } else if (insh) { + if ($1 ~ /^\.[Ss][HhYS]/ || + (pages == "cat" && + ($1 ~ /^S[yYeE]/ || $1 ~ /^DESCRIPTION/ || + $1 ~ /^COMMAND/ || $1 ~ /^OVERVIEW/ || + $1 ~ /^STRUCTURES/ || $1 ~ /^INTRODUCTION/))) { + # end insh for Synopsis, Syntax, but also for + # DESCRIPTION (e.g., XFree86.1x), + # COMMAND (e.g., xspread.1) + # OVERVIEW (e.g., TclCommandWriting.3) + # STRUCTURES (e.g., XEvent.3x) + # INTRODUCTION (e.g., TclX.n) + printf "\n"; + closeline(); + return; + } else { # derived from Tom Christiansen perl script + if (!after && $0 ~ progname"-") { # Fix old cat pages + sub(progname"-", progname" - "); + } + gsub(/ /, " "); # Translate tabs to spaces + gsub(/ +/, " "); # Collapse spaces + gsub(/ *, */, ", "); # Fix comma spacings + sub(/^ /, ""); # Kill initial spaces + sub(/ $/, ""); # Kill trailing spaces + sub(/__+/, "_"); # Collapse underscores + if ($0 ~ /[^ ]-$/) { + sub(/-$/, ""); # Handle Hyphenations + nextjoin = 1; + } else + nextjoin = 0; + sub(/^.[IB] /, ""); # Kill bold and italics + sub(/^.Nm /, ""); # Kill bold + sub(/^.Tn /, ""); # Kill normal + sub(/^.Li /, ""); # Kill .Li + sub(/^.Dq /, ""); # Kill .Dq + sub(/^.Nd */, "- "); # Convert .Nd to dash + gsub(/\\f[PRIB0123]/, ""); # Kill font changes + gsub(/\\s[-+0-9]*/, ""); # Kill size changes + gsub(/\\&/, ""); # Kill \& + gsub(/\\\((ru|ul)/, "_"); # Translate + gsub(/\\\((mi|hy|em)/, "-"); # Translate + gsub(/\\\*\(../, ""); # Kill troff strings + sub(/^\.\\\".*/, ""); # Kill comments + gsub(/\\/, ""); # Kill all backslashes + if ($1 ~ /^\.../ || $1 == "") { + if (after && !needmore) { + printf "\n"; + thisjoin = 1; + charct = 0; + after = 0; + } + } else { + if ($0 ~ /^- /) { + sub("- ", " - "); + } else if (!thisjoin && $0 !~ /^- /) { + printf " "; + charct += 1; + } + thisjoin = nextjoin; + if ($0 !~ / - / && $0 !~ / -$/ && $0 !~ /^- /) { + printf "%s", $0; + charct += length(); + needmore = 0; + } else { + after = 1 + if ($0 ~ / - /) { + where = match( $0 , / - /); + } else if ($0 ~ / -$/) { + where = match( $0, / -$/); + } else { + where = 1; + } + if ((width = 20-charct) < 0) width=0 + printf "%-*s", width, sprintf( "%s (%s)", + substr( $0, 1, where-1 ), actual_section ); + printf "%s", substr( $0, where ) + if ($0 ~ /- *$/) { + needmore = 1; + } else { + needmore = 0; + } + } + } + } + } + } + closeline(); + } + + { # Main action - process each filename read in. + filename = $0; + do_one(); + } + ' pages=$pages section=$section verbose=$verbose + cd .. + fi + done > $TMPFILE + + cd $here + + # kludge for Slackware's /usr/man/preformat + if [ $mandir = /usr/man/preformat ] + then + mandir1=/usr/man + else + mandir1=$mandir + fi + + if [ -f ${mandir1}/whatis ] + then + cat ${mandir1}/whatis >> $TMPFILE + fi + sed '/^$/d' < $TMPFILE | sort | uniq > ${mandir1}/whatis + + chmod 644 ${mandir1}/whatis + rm $TMPFILE + fi + done +done + +# remove the dir if we created it +if [ $TMPFILE = $TMPFILEDIR/w ]; then + rmdir $TMPFILEDIR +fi diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c new file mode 100644 index 0000000000..4bb148df98 --- /dev/null +++ b/erts/etc/unix/run_erl.c @@ -0,0 +1,1298 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Module: run_erl.c + * + * This module implements a reader/writer process that opens two specified + * FIFOs, one for reading and one for writing; reads from the read FIFO + * and writes to stdout and the write FIFO. + * + ________ _________ + | |--<-- pipe.r (fifo1) --<--| | + | to_erl | | run_erl | (parent) + |________|-->-- pipe.w (fifo2) -->--|_________| + ^ master pty + | + | slave pty + ____V____ + | | + | "erl" | (child) + |_________| +*/ + + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#ifdef HAVE_WORKING_POSIX_OPENPT +#define _XOPEN_SOURCE 600 +#endif +#include <sys/types.h> +#include <sys/wait.h> +#include <sys/stat.h> +#include <sys/time.h> +#include <sys/types.h> +#include <sys/select.h> +#include <fcntl.h> +#include <unistd.h> +#include <stdio.h> +#include <stdlib.h> +#include <stdarg.h> +#include <string.h> +#include <errno.h> +#include <signal.h> +#include <dirent.h> +#include <termios.h> +#include <time.h> +#ifndef NO_SYSLOG +# include <syslog.h> +#endif +#ifdef HAVE_PTY_H +# include <pty.h> +#endif +#ifdef HAVE_UTMP_H +# include <utmp.h> +#endif +#ifdef HAVE_UTIL_H +# include <util.h> +#endif +#ifdef HAVE_SYS_IOCTL_H +# include <sys/ioctl.h> +#endif + +#include "run_erl.h" +#include "safe_string.h" /* sn_printf, strn_cpy, strn_cat, etc */ + +#ifdef O_NONBLOCK +# define DONT_BLOCK_PLEASE O_NONBLOCK +#else +# define DONT_BLOCK_PLEASE O_NDELAY +# ifndef EAGAIN +# define EAGAIN -3898734 +# endif +#endif + +#define noDEBUG + +#define DEFAULT_LOG_GENERATIONS 5 +#define LOG_MAX_GENERATIONS 1000 /* No more than 1000 log files */ +#define LOG_MIN_GENERATIONS 2 /* At least two to switch between */ +#define DEFAULT_LOG_MAXSIZE 100000 +#define LOG_MIN_MAXSIZE 1000 /* Smallast value for changing log file */ +#define LOG_STUBNAME "erlang.log." +#define LOG_PERM 0664 +#define DEFAULT_LOG_ACTIVITY_MINUTES 5 +#define DEFAULT_LOG_ALIVE_MINUTES 15 +#define DEFAULT_LOG_ALIVE_FORMAT "%a %b %e %T %Z %Y" +#define ALIVE_BUFFSIZ 256 + +#define PERM 0600 +#define STATUSFILENAME "/run_erl.log" +#define PIPE_STUBNAME "erlang.pipe" +#define PIPE_STUBLEN strlen(PIPE_STUBNAME) + +#ifndef FILENAME_MAX +#define FILENAME_MAX 250 +#endif + +#ifndef O_SYNC +#define O_SYNC 0 +#define USE_FSYNC 1 +#endif + +#define MAX(x,y) ((x) > (y) ? (x) : (y)) + +#define FILENAME_BUFSIZ FILENAME_MAX + +/* prototypes */ +static void usage(char *); +static int create_fifo(char *name, int perm); +static int open_pty_master(char **name); +static int open_pty_slave(char *name); +static void pass_on(pid_t); +static void exec_shell(char **); +static void status(const char *format,...); +static void error_logf(int priority, int line, const char *format,...); +static void catch_sigchild(int); +static int next_log(int log_num); +static int prev_log(int log_num); +static int find_next_log_num(void); +static int open_log(int log_num, int flags); +static void write_to_log(int* lfd, int* log_num, char* buf, int len); +static void daemon_init(void); +static char *simple_basename(char *path); +static void init_outbuf(void); +static int outbuf_size(void); +static void clear_outbuf(void); +static char* outbuf_first(void); +static void outbuf_delete(int bytes); +static void outbuf_append(const char* bytes, int n); +static int write_all(int fd, const char* buf, int len); +static int extract_ctrl_seq(char* buf, int len); +static void set_window_size(unsigned col, unsigned row); + + +#ifdef DEBUG +static void show_terminal_settings(struct termios *t); +#endif + +/* static data */ +static char fifo1[FILENAME_BUFSIZ], fifo2[FILENAME_BUFSIZ]; +static char statusfile[FILENAME_BUFSIZ]; +static char log_dir[FILENAME_BUFSIZ]; +static char pipename[FILENAME_BUFSIZ]; +static FILE *stdstatus = NULL; +static int log_generations = DEFAULT_LOG_GENERATIONS; +static int log_maxsize = DEFAULT_LOG_MAXSIZE; +static int log_alive_minutes = DEFAULT_LOG_ALIVE_MINUTES; +static int log_activity_minutes = DEFAULT_LOG_ACTIVITY_MINUTES; +static int log_alive_in_gmt = 0; +static char log_alive_format[ALIVE_BUFFSIZ+1]; +static int run_daemon = 0; +static char *program_name; +static int mfd; /* master pty fd */ +static unsigned protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */ + +/* + * Output buffer. + * + * outbuf_base <= outbuf_out <= outbuf_in <= outbuf_base+outbuf_total + */ +static char* outbuf_base; +static int outbuf_total; +static char* outbuf_out; +static char* outbuf_in; + +#if defined(NO_SYSCONF) || !defined(_SC_OPEN_MAX) +# if defined(OPEN_MAX) +# define HIGHEST_FILENO() OPEN_MAX +# else +# define HIGHEST_FILENO() 64 /* arbitrary value */ +# endif +#else +# define HIGHEST_FILENO() sysconf(_SC_OPEN_MAX) +#endif + + +#ifdef NO_SYSLOG +# define OPEN_SYSLOG() ((void) 0) +#else +# define OPEN_SYSLOG() openlog(simple_basename(program_name), \ + LOG_PID|LOG_CONS|LOG_NOWAIT,LOG_USER) +#endif + +#define ERROR0(Prio,Format) error_logf(Prio,__LINE__,Format"\n") +#define ERROR1(Prio,Format,A1) error_logf(Prio,__LINE__,Format"\n",A1) +#define ERROR2(Prio,Format,A1,A2) error_logf(Prio,__LINE__,Format"\n",A1,A2) + +#ifdef HAVE_STRERROR +# define ADD_ERRNO(Format) "errno=%d '%s'\n"Format"\n",errno,strerror(errno) +#else +# define ADD_ERRNO(Format) "errno=%d\n"Format"\n",errno +#endif +#define ERRNO_ERR0(Prio,Format) error_logf(Prio,__LINE__,ADD_ERRNO(Format)) +#define ERRNO_ERR1(Prio,Format,A1) error_logf(Prio,__LINE__,ADD_ERRNO(Format),A1) + + +int main(int argc, char **argv) +{ + int childpid; + int sfd; + int fd; + char *p, *ptyslave=NULL; + int i = 1; + int off_argv; + + program_name = argv[0]; + + if(argc<4) { + usage(argv[0]); + exit(1); + } + + init_outbuf(); + + if (!strcmp(argv[1],"-daemon")) { + daemon_init(); + ++i; + } + + off_argv = i; + strn_cpy(pipename, sizeof(pipename), argv[i++]); + strn_cpy(log_dir, sizeof(log_dir), argv[i]); + strn_cpy(statusfile, sizeof(statusfile), log_dir); + strn_cat(statusfile, sizeof(statusfile), STATUSFILENAME); + +#ifdef DEBUG + status("%s: pid is : %d\n", argv[0], getpid()); +#endif + + /* Get values for LOG file handling from the environment */ + if ((p = getenv("RUN_ERL_LOG_ALIVE_MINUTES"))) { + log_alive_minutes = atoi(p); + if (!log_alive_minutes) { + ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ALIVE_MINUTES is 1 " + "(current value is %s)",p); + } + log_activity_minutes = log_alive_minutes / 3; + if (!log_activity_minutes) { + ++log_activity_minutes; + } + } + if ((p = getenv("RUN_ERL_LOG_ACTIVITY_MINUTES"))) { + log_activity_minutes = atoi(p); + if (!log_activity_minutes) { + ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ACTIVITY_MINUTES is 1 " + "(current value is %s)",p); + } + } + if ((p = getenv("RUN_ERL_LOG_ALIVE_FORMAT"))) { + if (strlen(p) > ALIVE_BUFFSIZ) { + ERROR1(LOG_ERR, "RUN_ERL_LOG_ALIVE_FORMAT can contain a maximum of " + "%d characters", ALIVE_BUFFSIZ); + } + strn_cpy(log_alive_format, sizeof(log_alive_format), p); + } else { + strn_cpy(log_alive_format, sizeof(log_alive_format), DEFAULT_LOG_ALIVE_FORMAT); + } + if ((p = getenv("RUN_ERL_LOG_ALIVE_IN_UTC")) && strcmp(p,"0")) { + ++log_alive_in_gmt; + } + if ((p = getenv("RUN_ERL_LOG_GENERATIONS"))) { + log_generations = atoi(p); + if (log_generations < LOG_MIN_GENERATIONS) + ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_GENERATIONS is %d", LOG_MIN_GENERATIONS); + if (log_generations > LOG_MAX_GENERATIONS) + ERROR1(LOG_ERR,"Maximum RUN_ERL_LOG_GENERATIONS is %d", LOG_MAX_GENERATIONS); + } + + if ((p = getenv("RUN_ERL_LOG_MAXSIZE"))) { + log_maxsize = atoi(p); + if (log_maxsize < LOG_MIN_MAXSIZE) + ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_MAXSIZE is %d", LOG_MIN_MAXSIZE); + } + + /* + * Create FIFOs and open them + */ + + if(*pipename && pipename[strlen(pipename)-1] == '/') { + /* The user wishes us to find a unique pipe name in the specified */ + /* directory */ + int highest_pipe_num = 0; + DIR *dirp; + struct dirent *direntp; + + dirp = opendir(pipename); + if(!dirp) { + ERRNO_ERR1(LOG_ERR,"Can't access pipe directory '%s'.", pipename); + exit(1); + } + + /* Check the directory for existing pipes */ + + while((direntp=readdir(dirp)) != NULL) { + if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) { + int num = atoi(direntp->d_name+PIPE_STUBLEN+1); + if(num > highest_pipe_num) + highest_pipe_num = num; + } + } + closedir(dirp); + strn_catf(pipename, sizeof(pipename), "%s.%d", + PIPE_STUBNAME, highest_pipe_num+1); + } /* if */ + + /* write FIFO - is read FIFO for `to_erl' program */ + strn_cpy(fifo1, sizeof(fifo1), pipename); + strn_cat(fifo1, sizeof(fifo1), ".r"); + if (create_fifo(fifo1, PERM) < 0) { + ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for writing.", fifo1); + exit(1); + } + + /* read FIFO - is write FIFO for `to_erl' program */ + strn_cpy(fifo2, sizeof(fifo2), pipename); + strn_cat(fifo2, sizeof(fifo2), ".w"); + + /* Check that nobody is running run_erl already */ + if ((fd = open (fifo2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) { + /* Open as client succeeded -- run_erl is already running! */ + fprintf(stderr, "Erlang already running on pipe %s.\n", pipename); + close(fd); + exit(1); + } + if (create_fifo(fifo2, PERM) < 0) { + ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for reading.", fifo2); + exit(1); + } + + /* + * Open master pseudo-terminal + */ + + if ((mfd = open_pty_master(&ptyslave)) < 0) { + ERRNO_ERR0(LOG_ERR,"Could not open pty master"); + exit(1); + } + + /* + * Now create a child process + */ + + if ((childpid = fork()) < 0) { + ERRNO_ERR0(LOG_ERR,"Cannot fork"); + exit(1); + } + if (childpid == 0) { + /* Child */ + close(mfd); + /* disassociate from control terminal */ +#ifdef USE_SETPGRP_NOARGS /* SysV */ + setpgrp(); +#elif defined(USE_SETPGRP) /* BSD */ + setpgrp(0,getpid()); +#else /* POSIX */ + setsid(); +#endif + /* Open the slave pty */ + if ((sfd = open_pty_slave(ptyslave)) < 0) { + ERRNO_ERR1(LOG_ERR,"Could not open pty slave '%s'", ptyslave); + exit(1); + } + /* But sfd may be one of the stdio fd's now, and we should be unmodern and not use dup2... */ + /* easiest to dup it up... */ + while (sfd < 3) { + sfd = dup(sfd); + } + +#ifndef NO_SYSLOG + /* Before fiddling with file descriptors we make sure syslog is turned off + or "closed". In the single case where we might want it again, + we will open it again instead. Would not want syslog to + go to some other fd... */ + if (run_daemon) { + closelog(); + } +#endif + + /* Close stdio */ + close(0); + close(1); + close(2); + + if (dup(sfd) != 0 || dup(sfd) != 1 || dup(sfd) != 2) { + status("Cannot dup\n"); + } + close(sfd); + exec_shell(argv+off_argv); /* exec_shell expects argv[2] to be */ + /* the command name, so we have to */ + /* adjust. */ + } else { + /* Parent */ + /* Ignore the SIGPIPE signal, write() will return errno=EPIPE */ + struct sigaction sig_act; + sigemptyset(&sig_act.sa_mask); + sig_act.sa_flags = 0; + sig_act.sa_handler = SIG_IGN; + sigaction(SIGPIPE, &sig_act, (struct sigaction *)NULL); + + sigemptyset(&sig_act.sa_mask); + sig_act.sa_flags = SA_NOCLDSTOP; + sig_act.sa_handler = catch_sigchild; + sigaction(SIGCHLD, &sig_act, (struct sigaction *)NULL); + + /* + * read and write: enter the workloop + */ + + pass_on(childpid); + } + return 0; +} /* main() */ + +/* pass_on() + * Is the work loop of the logger. Selects on the pipe to the to_erl + * program erlang. If input arrives from to_erl it is passed on to + * erlang. + */ +static void pass_on(pid_t childpid) +{ + int len; + fd_set readfds; + fd_set writefds; + fd_set* writefds_ptr; + struct timeval timeout; + time_t last_activity; + char buf[BUFSIZ]; + char log_alive_buffer[ALIVE_BUFFSIZ+1]; + int lognum; + int rfd, wfd=0, lfd=0; + int maxfd; + int ready; + int got_some = 0; /* from to_erl */ + + /* Open the to_erl pipe for reading. + * We can't open the writing side because nobody is reading and + * we'd either hang or get an error. + */ + if ((rfd = open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0)) < 0) { + ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.", fifo2); + exit(1); + } + +#ifdef DEBUG + status("run_erl: %s opened for reading\n", fifo2); +#endif + + /* Open the log file */ + + lognum = find_next_log_num(); + lfd = open_log(lognum, O_RDWR|O_APPEND|O_CREAT|O_SYNC); + + /* Enter the work loop */ + + while (1) { + int exit_status; + maxfd = MAX(rfd, mfd); + maxfd = MAX(wfd, maxfd); + FD_ZERO(&readfds); + FD_SET(rfd, &readfds); + FD_SET(mfd, &readfds); + FD_ZERO(&writefds); + if (outbuf_size() == 0) { + writefds_ptr = NULL; + } else { + FD_SET(wfd, &writefds); + writefds_ptr = &writefds; + } + time(&last_activity); + timeout.tv_sec = log_alive_minutes*60; /* don't assume old BSD bug */ + timeout.tv_usec = 0; + ready = select(maxfd + 1, &readfds, writefds_ptr, NULL, &timeout); + if (ready < 0) { + if (errno == EINTR) { + if (waitpid(childpid, &exit_status, WNOHANG) == childpid) { + /* + * The Erlang emulator has terminated. Give us some more + * time to write out any pending data before we terminate too. + */ + alarm(5); + } + FD_ZERO(&readfds); + FD_ZERO(&writefds); + } else { + /* Some error occured */ + ERRNO_ERR0(LOG_ERR,"Error in select."); + exit(1); + } + } else { + time_t now; + + if (waitpid(childpid, &exit_status, WNOHANG) == childpid) { + alarm(5); + FD_ZERO(&readfds); + FD_ZERO(&writefds); + } + + /* Check how long time we've been inactive */ + time(&now); + if(!ready || now - last_activity > log_activity_minutes*60) { + /* Either a time out: 15 minutes without action, */ + /* or something is coming in right now, but it's a long time */ + /* since last time, so let's write a time stamp this message */ + struct tm *tmptr; + if (log_alive_in_gmt) { + tmptr = gmtime(&now); + } else { + tmptr = localtime(&now); + } + if (!strftime(log_alive_buffer, ALIVE_BUFFSIZ, log_alive_format, + tmptr)) { + strn_cpy(log_alive_buffer, sizeof(log_alive_buffer), + "(could not format time in 256 positions " + "with current format string.)"); + } + log_alive_buffer[ALIVE_BUFFSIZ] = '\0'; + + sn_printf(buf, sizeof(buf), "\n===== %s%s\n", + ready?"":"ALIVE ", log_alive_buffer); + write_to_log(&lfd, &lognum, buf, strlen(buf)); + } + } + + /* + * Write any pending output first. + */ + if (FD_ISSET(wfd, &writefds)) { + int written; + char* buf = outbuf_first(); + + len = outbuf_size(); + written = write(wfd, buf, len); + if (written < 0 && errno == EAGAIN) { + /* + * Nothing was written - this is really strange because + * select() told us we could write. Ignore. + */ + } else if (written < 0) { + /* + * A write error. Assume that to_erl has terminated. + */ + clear_outbuf(); + close(wfd); + wfd = 0; + } else { + /* Delete the written part (or all) from the buffer. */ + outbuf_delete(written); + } + } + + /* + * Read master pty and write to FIFO. + */ + if (FD_ISSET(mfd, &readfds)) { +#ifdef DEBUG + status("Pty master read; "); +#endif + if ((len = read(mfd, buf, BUFSIZ)) <= 0) { + close(rfd); + if(wfd) close(wfd); + close(mfd); + unlink(fifo1); + unlink(fifo2); + if (len < 0) { + if(errno == EIO) + ERROR0(LOG_ERR,"Erlang closed the connection."); + else + ERRNO_ERR0(LOG_ERR,"Error in reading from terminal"); + exit(1); + } + exit(0); + } + + write_to_log(&lfd, &lognum, buf, len); + + /* + * Save in the output queue. + */ + + if (wfd) { + outbuf_append(buf, len); + } + } + + /* + * Read from FIFO, write to master pty + */ + if (FD_ISSET(rfd, &readfds)) { +#ifdef DEBUG + status("FIFO read; "); +#endif + if ((len = read(rfd, buf, BUFSIZ)) < 0) { + close(rfd); + if(wfd) close(wfd); + close(mfd); + unlink(fifo1); + unlink(fifo2); + ERRNO_ERR0(LOG_ERR,"Error in reading from FIFO."); + exit(1); + } + + if(!len) { + /* to_erl closed its end of the pipe */ + close(rfd); + rfd = open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0); + if (rfd < 0) { + ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.", fifo2); + exit(1); + } + got_some = 0; /* reset for next session */ + } + else { + if(!wfd) { + /* Try to open the write pipe to to_erl. Now that we got some data + * from to_erl, to_erl should already be reading this pipe - open + * should succeed. But in case of error, we just ignore it. + */ + if ((wfd = open(fifo1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) { + status("Client expected on FIFO %s, but can't open (len=%d)\n", + fifo1, len); + close(rfd); + rfd = open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0); + if (rfd < 0) { + ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.", fifo2); + exit(1); + } + wfd = 0; + } + else { +#ifdef DEBUG + status("run_erl: %s opened for writing\n", fifo1); +#endif + } + } + + if (!got_some && wfd && buf[0] == '\022') { + char wbuf[30]; + int wlen = sn_printf(wbuf,sizeof(wbuf),"[run_erl v%u-%u]\n", + RUN_ERL_HI_VER, RUN_ERL_LO_VER); + outbuf_append(wbuf,wlen); + } + got_some = 1; + + + /* Write the message */ +#ifdef DEBUG + status("Pty master write; "); +#endif + len = extract_ctrl_seq(buf, len); + + if(len==1 && buf[0] == '\003') { + kill(childpid,SIGINT); + } + else if (len>0 && write_all(mfd, buf, len) != len) { + ERRNO_ERR0(LOG_ERR,"Error in writing to terminal."); + close(rfd); + if(wfd) close(wfd); + close(mfd); + exit(1); + } + } +#ifdef DEBUG + status("OK\n"); +#endif + } + } +} /* pass_on() */ + +static void catch_sigchild(int sig) +{ +} + +/* + * next_log: + * Returns the index number that follows the given index number. + * (Wrapping after log_generations) + */ +static int next_log(int log_num) { + return log_num>=log_generations?1:log_num+1; +} + +/* + * prev_log: + * Returns the index number that precedes the given index number. + * (Wrapping after log_generations) + */ +static int prev_log(int log_num) { + return log_num<=1?log_generations:log_num-1; +} + +/* + * find_next_log_num() + * Searches through the log directory to check which logs that already + * exist. It finds the "hole" in the sequence, and returns the index + * number for the last log in the log sequence. If there is no hole, index + * 1 is returned. + */ +static int find_next_log_num(void) { + int i, next_gen, log_gen; + DIR *dirp; + struct dirent *direntp; + int log_exists[LOG_MAX_GENERATIONS+1]; + int stub_len = strlen(LOG_STUBNAME); + + /* Initialize exiting log table */ + + for(i=log_generations; i>=0; i--) + log_exists[i] = 0; + dirp = opendir(log_dir); + if(!dirp) { + ERRNO_ERR1(LOG_ERR,"Can't access log directory '%s'", log_dir); + exit(1); + } + + /* Check the directory for existing logs */ + + while((direntp=readdir(dirp)) != NULL) { + if(strncmp(direntp->d_name,LOG_STUBNAME,stub_len)==0) { + int num = atoi(direntp->d_name+stub_len); + if(num < 1 || num > log_generations) + continue; + log_exists[num] = 1; + } + } + closedir(dirp); + + /* Find out the next available log file number */ + + next_gen = 0; + for(i=log_generations; i>=0; i--) { + if(log_exists[i]) + if(next_gen) + break; + else + ; + else + next_gen = i; + } + + /* Find out the current log file number */ + + if(next_gen) + log_gen = prev_log(next_gen); + else + log_gen = 1; + + return log_gen; +} /* find_next_log_num() */ + +/* open_log() + * Opens a log file (with given index) for writing. Writing may be + * at the end or a trucnating write, according to flags. + * A LOGGING STARTED and time stamp message is inserted into the log file + */ +static int open_log(int log_num, int flags) +{ + char buf[FILENAME_MAX]; + time_t now; + struct tm *tmptr; + char log_buffer[ALIVE_BUFFSIZ+1]; + int lfd; + + /* Remove the next log (to keep a "hole" in the log sequence) */ + sn_printf(buf, sizeof(buf), "%s/%s%d", + log_dir, LOG_STUBNAME, next_log(log_num)); + unlink(buf); + + /* Create or continue on the current log file */ + sn_printf(buf, sizeof(buf), "%s/%s%d", log_dir, LOG_STUBNAME, log_num); + if((lfd = open(buf, flags, LOG_PERM))<0){ + ERRNO_ERR1(LOG_ERR,"Can't open log file '%s'.", buf); + exit(1); + } + + /* Write a LOGGING STARTED and time stamp into the log file */ + time(&now); + if (log_alive_in_gmt) { + tmptr = gmtime(&now); + } else { + tmptr = localtime(&now); + } + if (!strftime(log_buffer, ALIVE_BUFFSIZ, log_alive_format, + tmptr)) { + strn_cpy(log_buffer, sizeof(log_buffer), + "(could not format time in 256 positions " + "with current format string.)"); + } + log_buffer[ALIVE_BUFFSIZ] = '\0'; + + sn_printf(buf, sizeof(buf), "\n=====\n===== LOGGING STARTED %s\n=====\n", + log_buffer); + if (write_all(lfd, buf, strlen(buf)) < 0) + status("Error in writing to log.\n"); + +#if USE_FSYNC + fsync(lfd); +#endif + + return lfd; +} + +/* write_to_log() + * Writes a message to a log file. If the current log file is full, + * a new log file is opened. + */ +static void write_to_log(int* lfd, int* log_num, char* buf, int len) +{ + int size; + + /* Decide if new logfile needed, and open if so */ + + size = lseek(*lfd,0,SEEK_END); + if(size+len > log_maxsize) { + close(*lfd); + *log_num = next_log(*log_num); + *lfd = open_log(*log_num, O_RDWR|O_CREAT|O_TRUNC|O_SYNC); + } + + /* Write to log file */ + + if (write_all(*lfd, buf, len) < 0) { + status("Error in writing to log.\n"); + } + +#if USE_FSYNC + fsync(*lfd); +#endif +} + +/* create_fifo() + * Creates a new fifo with the given name and permission. + */ +static int create_fifo(char *name, int perm) +{ + if ((mkfifo(name, perm) < 0) && (errno != EEXIST)) + return -1; + return 0; +} + + +/* open_pty_master() + * Find a master device, open and return fd and slave device name. + */ + +static int open_pty_master(char **ptyslave) +{ + int mfd; + +/* Use the posix_openpt if working, as this guarantees creation of the + slave device properly. */ +#ifdef HAVE_WORKING_POSIX_OPENPT + if ((mfd = posix_openpt(O_RDWR)) >= 0) { + if ((*ptyslave = ptsname(mfd)) != NULL && + grantpt(mfd) == 0 && + unlockpt(mfd) == 0) { + + return mfd; + } + close(mfd); + } + /* fallback to openpty if it exist */ +#endif + +#ifdef HAVE_OPENPTY +# ifdef PATH_MAX +# define SLAVE_SIZE PATH_MAX +# else +# define SLAVE_SIZE 1024 +# endif + { + static char slave[SLAVE_SIZE]; + int sfd; +# undef SLAVE_SIZE + + if (openpty(&mfd, &sfd, slave, NULL, NULL) == 0) { + close(sfd); + *ptyslave = slave; + return mfd; + } + } + +#elif !defined(HAVE_WORKING_POSIX_OPENPT) + /* + * The traditional way to find ptys. We only try it if neither + * posix_openpt or openpty() are available. + */ + char *major, *minor; + + static char majorchars[] = "pqrstuvwxyzabcdePQRSTUVWXYZABCDE"; + static char minorchars[] = "0123456789abcdefghijklmnopqrstuv" + "wxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_+"; + + /* In the old time the names where /dex/ptyXY where */ + /* X is in "pqrs" and Y in "0123456789abcdef" but FreeBSD */ + /* and some Linux version has extended this. */ + + /* This code could probebly be improved alot. For example look at */ + /* http://www.xcf.berkeley.edu/~ali/K0D/UNIX/PTY/code/pty.c.html */ + /* http://www.xcf.berkeley.edu/~ali/K0D/UNIX/PTY/code/upty.h.html */ + + { + /* New style devpts or devfs /dev/pty/{m,s}{0,1....} */ + + static char ptyname[] = "/dev/pty/mX"; + + for (minor = minorchars; *minor; minor++) { + ptyname[10] = *minor; + if ((mfd = open(ptyname, O_RDWR, 0)) >= 0) { + ptyname[9] = 's'; + *ptyslave = ptyname; + return mfd; + } + } + } + + { + /* Unix98 style /dev/ptym/ptyXY and /dev/pty/ttyXY */ + + static char ptyname[] = "/dev/ptym/ptyXY"; + static char ttyname[] = "/dev/pty/ttyXY"; + + for (major = majorchars; *major; major++) { + ptyname[13] = *major; + for (minor = minorchars; *minor; minor++) { + ptyname[14] = *minor; + if ((mfd = open(ptyname, O_RDWR, 0)) >= 0) { + ttyname[12] = *major; + ttyname[13] = *minor; + *ptyslave = ttyname; + return mfd; + } + } + } + } + + { + /* Old style /dev/ptyXY */ + + static char ptyname[] = "/dev/ptyXY"; + + for (major = majorchars; *major; major++) { + ptyname[8] = *major; + for (minor = minorchars; *minor; minor++) { + ptyname[9] = *minor; + if ((mfd = open(ptyname, O_RDWR, 0)) >= 0) { + ptyname[5] = 't'; + *ptyslave = ptyname; + return mfd; + } + } + } + } +#endif /* !HAVE_OPENPTY */ + return -1; +} + +static int open_pty_slave(char *name) +{ + int sfd; +#ifdef DEBUG + struct termios tty_rmode; +#endif + + if ((sfd = open(name, O_RDWR, 0)) < 0) { + return -1; + } + +#ifdef DEBUG + if (tcgetattr(sfd, &tty_rmode) , 0) { + fprintf(stderr, "Cannot get terminals current mode\n"); + exit(-1); + } + show_terminal_settings(&tty_rmode); +#endif + + return sfd; +} + +/* exec_shell() + * Executes the named command (in argv format) in a /bin/sh. IO redirection + * should already have been taken care of, and this process should be the + * child of a fork. + */ +static void exec_shell(char **argv) +{ + char *sh, **vp; + int i; + + sh = "/bin/sh"; + if ((argv[0] = strrchr(sh, '/')) != NULL) + argv[0]++; + else + argv[0] = sh; + argv[1] = "-c"; + status("Args before exec of shell:\n"); + for (vp = argv, i = 0; *vp; vp++, i++) + status("argv[%d] = %s\n", i, *vp); + if (stdstatus) { + fclose(stdstatus); + } + execv(sh, argv); + if (run_daemon) { + OPEN_SYSLOG(); + } + ERRNO_ERR0(LOG_ERR,"Could not execv"); +} + +/* status() + * Prints the arguments to a status file + * Works like printf (see vfrpintf) + */ +static void status(const char *format,...) +{ + va_list args; + time_t now; + + if (stdstatus == NULL) + stdstatus = fopen(statusfile, "w"); + if (stdstatus == NULL) + return; + now = time(NULL); + fprintf(stdstatus, "run_erl [%d] %s", (int)getpid(), ctime(&now)); + va_start(args, format); + vfprintf(stdstatus, format, args); + va_end(args); + fflush(stdstatus); +} + +static void daemon_init(void) + /* As R Stevens wants it, to a certain extent anyway... */ +{ + pid_t pid; + int i, maxfd = HIGHEST_FILENO(); + + if ((pid = fork()) != 0) + exit(0); +#if defined(USE_SETPGRP_NOARGS) + setpgrp(); +#elif defined(USE_SETPGRP) + setpgrp(0,getpid()); +#else + setsid(); /* Seems to be the case on all current platforms */ +#endif + signal(SIGHUP, SIG_IGN); + if ((pid = fork()) != 0) + exit(0); + + /* Should change working directory to "/" and change umask now, but that + would be backward incompatible */ + + for (i = 0; i < maxfd; ++i ) { + close(i); + } + + OPEN_SYSLOG(); + run_daemon = 1; +} + +/* error_logf() + * Prints the arguments to stderr or syslog + * Works like printf (see vfprintf) + */ +static void error_logf(int priority, int line, const char *format, ...) +{ + va_list args; + va_start(args, format); + +#ifndef NO_SYSLOG + if (run_daemon) { + vsyslog(priority,format,args); + } + else +#endif + { + time_t now = time(NULL); + fprintf(stderr, "run_erl:%d [%d] %s", line, (int)getpid(), ctime(&now)); + vfprintf(stderr, format, args); + } + va_end(args); +} + +static void usage(char *pname) +{ + fprintf(stderr, "Usage: %s (pipe_name|pipe_dir/) log_dir \"command [parameters ...]\"\n", pname); + fprintf(stderr, "\nYou may also set the environment variables RUN_ERL_LOG_GENERATIONS\n"); + fprintf(stderr, "and RUN_ERL_LOG_MAXSIZE to the number of log files to use and the\n"); + fprintf(stderr, "size of the log file when to switch to the next log file\n"); +} + +/* Instead of making sure basename exists, we do our own */ +static char *simple_basename(char *path) +{ + char *ptr; + for (ptr = path; *ptr != '\0'; ++ptr) { + if (*ptr == '/') { + path = ptr + 1; + } + } + return path; +} + +static void init_outbuf(void) +{ + outbuf_total = 1; + outbuf_base = malloc(BUFSIZ); + clear_outbuf(); +} + +static void clear_outbuf(void) +{ + outbuf_in = outbuf_out = outbuf_base; +} + +static int outbuf_size(void) +{ + return outbuf_in - outbuf_out; +} + +static char* outbuf_first(void) +{ + return outbuf_out; +} + +static void outbuf_delete(int bytes) +{ + outbuf_out += bytes; + if (outbuf_out >= outbuf_in) { + outbuf_in = outbuf_out = outbuf_base; + } +} + +static void outbuf_append(const char* buf, int n) +{ + if (outbuf_base+outbuf_total < outbuf_in+n) { + /* + * The new data does not fit at the end of the buffer. + * Slide down the data to the beginning of the buffer. + */ + if (outbuf_out > outbuf_base) { + int size = outbuf_in - outbuf_out; + char* p; + + outbuf_in -= outbuf_out - outbuf_base; + p = outbuf_base; + while (size-- > 0) { + *p++ = *outbuf_out++; + } + outbuf_out = outbuf_base; + } + + /* + * Allocate a larger buffer if we still cannot fit the data. + */ + if (outbuf_base+outbuf_total < outbuf_in+n) { + int size = outbuf_in - outbuf_out; + outbuf_total = size+n; + outbuf_base = realloc(outbuf_base, outbuf_total); + outbuf_out = outbuf_base; + outbuf_in = outbuf_base + size; + } + } + + /* + * Copy data to the end of the buffer. + */ + memcpy(outbuf_in, buf, n); + outbuf_in += n; +} + +/* Call write() until entire buffer has been written or error. + * Return len or -1. + */ +static int write_all(int fd, const char* buf, int len) +{ + int left = len; + int written; + for (;;) { + written = write(fd,buf,left); + if (written == left) { + return len; + } + if (written < 0) { + return -1; + } + left -= written; + buf += written; + } +} + +/* Extract any control sequences that are ment only for run_erl + * and should not be forwarded to the pty. + */ +static int extract_ctrl_seq(char* buf, int len) +{ + static const char prefix[] = "\033_"; + static const char suffix[] = "\033\\"; + char* bufend = buf + len; + char* start = buf; + char* command; + char* end; + + for (;;) { + start = find_str(start, bufend-start, prefix); + if (!start) break; + + command = start + strlen(prefix); + end = find_str(command, bufend-command, suffix); + if (end) { + unsigned col, row; + if (sscanf(command,"version=%u", &protocol_ver)==1) { + /*fprintf(stderr,"to_erl v%u\n", protocol_ver);*/ + } + else if (sscanf(command,"winsize=%u,%u", &col, &row)==2) { + set_window_size(col,row); + } + else { + ERROR2(LOG_ERR, "Ignoring unknown ctrl command '%.*s'\n", + (int)(end-command), command); + } + + /* Remove ctrl sequence from buf */ + end += strlen(suffix); + memmove(start, end, bufend-end); + bufend -= end - start; + } + else { + ERROR2(LOG_ERR, "Missing suffix in ctrl sequence '%.*s'\n", + (int)(bufend-start), start); + break; + } + } + return bufend - buf; +} + +static void set_window_size(unsigned col, unsigned row) +{ +#ifdef TIOCSWINSZ + struct winsize ws; + ws.ws_col = col; + ws.ws_row = row; + if (ioctl(mfd, TIOCSWINSZ, &ws) < 0) { + ERRNO_ERR0(LOG_ERR,"Failed to set window size"); + } +#endif +} + + +#ifdef DEBUG + +#define S(x) ((x) > 0 ? 1 : 0) + +static void show_terminal_settings(struct termios *t) +{ + printf("c_iflag:\n"); + printf("Signal interrupt on break: BRKINT %d\n", S(t->c_iflag & BRKINT)); + printf("Map CR to NL on input: ICRNL %d\n", S(t->c_iflag & ICRNL)); + printf("Ignore break condition: IGNBRK %d\n", S(t->c_iflag & IGNBRK)); + printf("Ignore CR: IGNCR %d\n", S(t->c_iflag & IGNCR)); + printf("Ignore char with par. err's: IGNPAR %d\n", S(t->c_iflag & IGNPAR)); + printf("Map NL to CR on input: INLCR %d\n", S(t->c_iflag & INLCR)); + printf("Enable input parity check: INPCK %d\n", S(t->c_iflag & INPCK)); + printf("Strip character ISTRIP %d\n", S(t->c_iflag & ISTRIP)); + printf("Enable start/stop input ctrl IXOFF %d\n", S(t->c_iflag & IXOFF)); + printf("ditto output ctrl IXON %d\n", S(t->c_iflag & IXON)); + printf("Mark parity errors PARMRK %d\n", S(t->c_iflag & PARMRK)); + printf("\n"); + printf("c_oflag:\n"); + printf("Perform output processing OPOST %d\n", S(t->c_oflag & OPOST)); + printf("\n"); + printf("c_cflag:\n"); + printf("Ignore modem status lines CLOCAL %d\n", S(t->c_cflag & CLOCAL)); + printf("\n"); + printf("c_local:\n"); + printf("Enable echo ECHO %d\n", S(t->c_lflag & ECHO)); + printf("\n"); + printf("c_cc:\n"); + printf("c_cc[VEOF] %d\n", t->c_cc[VEOF]); +} + +#endif /* DEBUG */ + + diff --git a/erts/etc/unix/run_erl.h b/erts/etc/unix/run_erl.h new file mode 100644 index 0000000000..843cda680c --- /dev/null +++ b/erts/etc/unix/run_erl.h @@ -0,0 +1,30 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * The protocol version number used between to_erl and run_erl. + */ +#define RUN_ERL_HI_VER 1 /* My preferred protocol version */ +#define RUN_ERL_LO_VER 0 /* The lowest version I accept to talk with */ + +/* Version history: + * 0: Older, without version handshake + * 1: R12B-3, version handshake + window size ctrl + */ + diff --git a/erts/etc/unix/safe_string.c b/erts/etc/unix/safe_string.c new file mode 100644 index 0000000000..a77d9c5456 --- /dev/null +++ b/erts/etc/unix/safe_string.c @@ -0,0 +1,123 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Module: safe_string.c + * + * This is a bunch of generic string operation + * that are safe regarding buffer overflow. + * + * All string functions terminate the process with an error message + * on buffer overflow. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "safe_string.h" +#include <stdio.h> +#include <string.h> +#include <stdarg.h> +#include <stdlib.h> + + +static void string_overflow_handler(const char* format, ...) +{ + va_list args; + va_start(args, format); + vfprintf(stderr,format,args); + va_end(args); + exit(1); +} + +int vsn_printf(char* dst, size_t size, const char* format, va_list args) +{ + int ret = vsnprintf(dst, size, format, args); + if (ret >= size || ret < 0) { + string_overflow_handler("Buffer truncated '%s'\n",dst); + } + return ret; +} + +int sn_printf(char* dst, size_t size, const char* format, ...) +{ + va_list args; + int ret; + va_start(args, format); + ret = vsn_printf(dst,size,format,args); + va_end(args); + return ret; +} + +int strn_cpy(char* dst, size_t size, const char* src) +{ + return sn_printf(dst,size,"%s",src); +} + +int strn_cat(char* dst, size_t size, const char* src) +{ + return strn_catf(dst,size,"%s",src); +} + +int strn_catf(char* dst, size_t size, const char* format, ...) +{ + int ret; + va_list args; +#ifdef _GNU_SOURCE + int len = strnlen(dst,size); +#else + int len = strlen(dst); +#endif + + if (len >= size) { + string_overflow_handler("Buffer already overflowed '%.*s'\n", + size, dst); + } + va_start(args, format); + ret = vsn_printf(dst+len, size-len, format, args); + va_end(args); + return len+ret; +} + +char* find_str(const char* haystack, int hsize, const char* needle) +{ + int i = 0; + int nsize = strlen(needle); + hsize -= nsize - 1; + for (i=0; i<hsize; i++) { + if (haystack[i]==needle[0] && strncmp(haystack+i,needle,nsize)==0) { + return (char*)(haystack+i); + } + } + return NULL; +} + +#ifndef HAVE_MEMMOVE +void* memmove(void *dest, const void *src, size_t n) +{ + int i; + if (src > dest) { + for (i=0; i<n; i++) ((char*)dest)[i] = ((char*)src)[i]; + } + else { + for (i=(int)(n-1); i>=0; i--) ((char*)dest)[i] = ((char*)src)[i]; + } + return dest; +} +#endif /* HAVE_MEMMOVE */ + diff --git a/erts/etc/unix/safe_string.h b/erts/etc/unix/safe_string.h new file mode 100644 index 0000000000..c70e528814 --- /dev/null +++ b/erts/etc/unix/safe_string.h @@ -0,0 +1,65 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Module: safe_string.h + * + * This is an interface to a bunch of generic string operation + * that are safe regarding buffer overflow. + * + * All string functions terminate the process with an error message + * on buffer overflow. + */ + +#include <stdio.h> +#include <stdarg.h> + +/* Like vsnprintf() + */ +int vsn_printf(char* dst, size_t size, const char* format, va_list args); + +/* Like snprintf() + */ +int sn_printf(char* dst, size_t size, const char* format, ...); + +/* Like strncpy() + * Returns length of copied string. + */ +int strn_cpy(char* dst, size_t size, const char* src); + +/* Almost like strncat() + * size is sizeof entire dst buffer. + * Returns length of resulting string. + */ +int strn_cat(char* dst, size_t size, const char* src); + +/* Combination of strncat() and snprintf() + * size is sizeof entire dst buffer. + * Returns length of resulting string. + */ +int strn_catf(char* dst, size_t size, const char* format, ...); + +/* Simular to strstr() but search size bytes of haystack + * without regard to '\0' characters. + */ +char* find_str(const char* haystack, int size, const char* needle); + +#ifndef HAVE_MEMMOVE +void* memmove(void *dest, const void *src, size_t n); +#endif + diff --git a/erts/etc/unix/setuid_socket_wrap.c b/erts/etc/unix/setuid_socket_wrap.c new file mode 100644 index 0000000000..3f0657770c --- /dev/null +++ b/erts/etc/unix/setuid_socket_wrap.c @@ -0,0 +1,259 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * setuid_socket_wrap.c + * + * ./a.out [-s [tag,][addr]:[port]]* [-d [tag,][addr]:[port]]* + * [-r [tag,]proto]* -- program args + * + * Where: -s = stream socket, -d datagram socket and -r means raw socket. + * + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifndef EXEC_PROGRAM +# define EXEC_PROGRAM "/bin/echo" +#endif + +#include <stdio.h> +#include <stdlib.h> +#include <unistd.h> +#include <string.h> +#include <ctype.h> +#include <sys/types.h> +#include <sys/socket.h> +#include <netinet/in.h> +#include <arpa/inet.h> +#include <netdb.h> + +#ifndef INADDR_NONE +#define INADDR_NONE 0xffffffff +#endif + +struct sock_list { + struct sock_list *next; + int fd; + int type; + int protocol; + struct sockaddr_in addr; + char *arg; +}; + +int parse_addr(addr, str) + struct sockaddr_in *addr; + char *str; +{ + int port = 0; + char *cp; + struct hostent *hp; + struct servent *se; + + if ((cp = strrchr(str, (int)':')) != NULL) + *cp++ = '\0'; + if (cp) { + if (!isdigit((int)cp[0])) { + if ((se = getservbyname(cp, "tcp")) != NULL) { + port = ntohs(se->s_port); + } else { + fprintf(stderr, "unknown port %s\n", cp); + return -1; + } + } else { + port = atoi(cp); + } + } + if (port < 0 || port > 0xffff) { + fprintf(stderr, "bad port number %d\n", port); + return -1; + } + + bzero(addr, sizeof(*addr)); + addr->sin_family = AF_INET; + addr->sin_port = htons(port); + if (*str == '\000') { + addr->sin_addr.s_addr = INADDR_ANY; + } else { + if ((addr->sin_addr.s_addr = inet_addr(str)) == INADDR_NONE) { + if ((hp = gethostbyname(str)) == NULL) { + fprintf(stderr, "\"%s\" unknown host or address!\n", str); + return -1; + } else { + bcopy(hp->h_addr_list[0], &addr->sin_addr.s_addr,hp->h_length); + } + } + } + return 0; +} + +struct sock_list *new_entry(type, argstr) + int type; + char *argstr; +{ + struct sock_list *sle; + char *cp; + + sle = (struct sock_list *)malloc(sizeof(struct sock_list)); + if (!sle) + return NULL; + sle->next = NULL; + sle->fd = -1; + + if ((cp = strchr(argstr, (int)',')) != NULL) { + *cp++ = '\0'; + sle->arg = argstr; + argstr = cp; + } else { + sle->arg = "-fd"; + } + sle->type = type; + switch (type) { + case SOCK_RAW: { + struct protoent *pe; + pe = getprotobyname(argstr); + if (!pe) { + fprintf(stderr, "Unknown protocol: %s\n", argstr); + free(sle); + return NULL; + } + sle->protocol = pe->p_proto; + break; + } + case SOCK_STREAM: + case SOCK_DGRAM: + sle->protocol = 0; + if (parse_addr(&sle->addr, argstr) < 0) { + free(sle); + return NULL; + } + break; + } + return sle; +} + +int open_socket(sle) + struct sock_list *sle; +{ + sle->fd = socket(AF_INET, sle->type, sle->protocol); + if (sle->fd < 0) { + perror("socket"); + return -1; + } + if (sle->type != SOCK_RAW) { +#if 0 + printf("binding fd %d to %s:%d\n", sle->fd, + inet_ntoa(sle->addr.sin_addr), ntohs(sle->addr.sin_port)); +#endif + if (bind(sle->fd, (struct sockaddr *)&sle->addr, sizeof(sle->addr))<0){ + perror("bind"); + close(sle->fd); + return -1; + } + } + return sle->fd; +} + +int main(argc, argv) + int argc; + char *argv[]; +{ + struct sock_list *sl = NULL, *sltmp = NULL; + int count = 0; + int c; + + while ((c = getopt(argc, argv, "s:d:r:")) != EOF) + switch (c) { + case 's': + sltmp = new_entry(SOCK_STREAM, optarg); + if (!sltmp) { + exit(1); + } + sltmp->next = sl; + sl = sltmp; + count++; + break; + case 'd': + sltmp = new_entry(SOCK_DGRAM, optarg); + if (!sltmp) { + exit(1); + } + sltmp->next = sl; + sl = sltmp; + count++; + break; + case 'r': + sltmp = new_entry(SOCK_RAW, optarg); + if (!sltmp) { + exit(1); + } + sltmp->next = sl; + sl = sltmp; + count++; + break; + default: + exit(1); + } + argc -= optind; + argv += optind; + + for(sltmp = sl; sltmp != NULL; sltmp = sltmp->next) + if (open_socket(sltmp) < 0) { + fprintf(stderr, "failed to create socket!\n"); + exit(1); + } + + setuid(getuid()); + + { + int i; + char **newargv; + char *run_prog = EXEC_PROGRAM; + char *run_prog_name; + + newargv = (char **)malloc((1 + 2*count + argc + 1) * sizeof(char*)); + + if ((run_prog_name = strrchr(run_prog, (int)'/')) == NULL) + run_prog_name = run_prog; + else + run_prog_name++; + + i = 0; + newargv[i++] = run_prog_name; + + for (; argc; argc--, argv++, i++) + newargv[i] = *argv; + for(sltmp = sl; sltmp != NULL; ) { + char *fd_str = (char *)malloc(8); + if (!fd_str) exit(1); + sprintf(fd_str, "%d", sltmp->fd); + if (sltmp->arg && *(sltmp->arg)) + newargv[i++] = sltmp->arg; + newargv[i++] = fd_str; + sl = sltmp; + sltmp = sltmp->next; + free(sl); + } + newargv[i] = (char *)NULL; + execv(run_prog, newargv); + perror("exec"); + exit(1); + } + exit(0); +} diff --git a/erts/etc/unix/start.src b/erts/etc/unix/start.src new file mode 100644 index 0000000000..8479be0987 --- /dev/null +++ b/erts/etc/unix/start.src @@ -0,0 +1,36 @@ +#!/bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# This program invokes the erlang emulator by calling run_erl. +# It should only be used at an embedded target system. +# It should be modified to give the correct flags to erl (via start_erl), +# e.g -mode embedded -sname XXX +# +# Usage: start [Data] +# +ROOTDIR=%FINAL_ROOTDIR% + +if [ -z "$RELDIR" ] +then + RELDIR=$ROOTDIR/releases +fi + +START_ERL_DATA=${1:-$RELDIR/start_erl.data} + +$ROOTDIR/bin/run_erl -daemon /tmp/ $ROOTDIR/log "exec $ROOTDIR/bin/start_erl $ROOTDIR $RELDIR $START_ERL_DATA" diff --git a/erts/etc/unix/start_erl.src b/erts/etc/unix/start_erl.src new file mode 100644 index 0000000000..ea8022c449 --- /dev/null +++ b/erts/etc/unix/start_erl.src @@ -0,0 +1,47 @@ +#!/bin/sh +# +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# This program is called by run_erl. It starts +# the erlang emulator and sets -boot and -config parameters. +# It should only be used at an embedded target system. +# +# Usage: start_erl RootDir RelDir DataFile [ErlFlags ...] +# +ROOTDIR=$1 +shift +RELDIR=$1 +shift +DataFile=$1 +shift + +ERTS_VSN=`awk '{print $1}' $DataFile` +VSN=`awk '{print $2}' $DataFile` + +BINDIR=$ROOTDIR/erts-$ERTS_VSN/bin +EMU=beam +PROGNAME=`echo $0 | sed 's/.*\///'` +export EMU +export ROOTDIR +export BINDIR +export PROGNAME +export RELDIR + +exec $BINDIR/erlexec -boot $RELDIR/$VSN/start -config $RELDIR/$VSN/sys ${1+"$@"} + diff --git a/erts/etc/unix/to_erl.c b/erts/etc/unix/to_erl.c new file mode 100644 index 0000000000..588d127445 --- /dev/null +++ b/erts/etc/unix/to_erl.c @@ -0,0 +1,610 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Module: to_erl.c + * + * This module implements a process that opens two specified FIFOs, one + * for reading and one for writing; reads from its stdin, and writes what + * it has read to the write FIF0; reads from the read FIFO, and writes to + * its stdout. + * + ________ _________ + | |--<-- pipe.r (fifo1) --<--| | + | to_erl | | run_erl | (parent) + |________|-->-- pipe.w (fifo2) -->--|_________| + ^ master pty + | + | slave pty + ____V____ + | | + | "erl" | (child) + |_________| + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include <sys/types.h> +#include <sys/stat.h> +#include <sys/time.h> +#include <sys/types.h> +#include <fcntl.h> +#include <unistd.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <termios.h> +#include <dirent.h> +#include <signal.h> +#include <errno.h> +#ifdef HAVE_SYS_IOCTL_H +# include <sys/ioctl.h> +#endif + +#include "run_erl.h" +#include "safe_string.h" /* strn_cpy, strn_catf, sn_printf, etc. */ + +#if defined(O_NONBLOCK) +# define DONT_BLOCK_PLEASE O_NONBLOCK +#else +# define DONT_BLOCK_PLEASE O_NDELAY +# if !defined(EAGAIN) +# define EAGAIN -3898734 +# endif +#endif + +#ifdef HAVE_STRERROR +# define STRERROR(x) strerror(x) +#else +# define STRERROR(x) "" +#endif + +#define noDEBUG + +#define PIPE_DIR "/tmp/" +#define PIPE_STUBNAME "erlang.pipe" +#define PIPE_STUBLEN strlen(PIPE_STUBNAME) + +#ifdef DEBUG +#define STATUS(s) { fprintf(stderr, (s)); fflush(stderr); } +#else +#define STATUS(s) +#endif + +#ifndef FILENAME_MAX +#define FILENAME_MAX 250 +#endif + +static struct termios tty_smode, tty_rmode; +static int tty_eof = 0; +static int recv_sig = 0; +static int protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */ + +static int write_all(int fd, const char* buf, int len); +static int window_size_seq(char* buf, size_t bufsz); +static int version_handshake(char* buf, int len, int wfd); +#ifdef DEBUG +static void show_terminal_settings(struct termios *); +#endif + +static void handle_ctrlc(int sig) +{ + /* Reinstall the handler, and signal break flag */ + signal(SIGINT,handle_ctrlc); + recv_sig = SIGINT; +} + +static void handle_sigwinch(int sig) +{ + recv_sig = SIGWINCH; +} + +static void usage(char *pname) +{ + fprintf(stderr, "Usage: %s [-h|-F] [pipe_name|pipe_dir/]\n", pname); + fprintf(stderr, "\t-h\tThis help text.\n"); + fprintf(stderr, "\t-F\tForce connection even though pipe is locked by other to_erl process.\n"); +} + +int main(int argc, char **argv) +{ + char FIFO1[FILENAME_MAX], FIFO2[FILENAME_MAX]; + int i, len, wfd, rfd, result = 0; + fd_set readfds; + char buf[BUFSIZ]; + char pipename[FILENAME_MAX]; + int pipeIx = 1; + int force_lock = 0; + int got_some = 0; + + if (argc >= 2 && argv[1][0]=='-') { + switch (argv[1][1]) { + case 'h': + usage(argv[0]); + exit(1); + case 'F': + force_lock = 1; + break; + default: + fprintf(stderr,"Invalid option '%s'\n",argv[1]); + exit(1); + } + pipeIx = 2; + } + +#ifdef DEBUG + fprintf(stderr, "%s: pid is : %d\n", argv[0], (int)getpid()); +#endif + + strn_cpy(pipename, sizeof(pipename), + (argv[pipeIx] ? argv[pipeIx] : PIPE_DIR)); + + if(*pipename && pipename[strlen(pipename)-1] == '/') { + /* The user wishes us to find a pipe name in the specified */ + /* directory */ + int highest_pipe_num = 0; + DIR *dirp; + struct dirent *direntp; + + dirp = opendir(pipename); + if(!dirp) { + fprintf(stderr, "Can't access pipe directory %s.\n", pipename); + exit(1); + } + + /* Check the directory for existing pipes */ + + while((direntp=readdir(dirp)) != NULL) { + if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) { + int num = atoi(direntp->d_name+PIPE_STUBLEN+1); + if(num > highest_pipe_num) + highest_pipe_num = num; + } + } + closedir(dirp); + strn_catf(pipename, sizeof(pipename), (highest_pipe_num?"%s.%d":"%s"), + PIPE_STUBNAME, highest_pipe_num); + } /* if */ + + /* read FIFO */ + sn_printf(FIFO1,sizeof(FIFO1),"%s.r",pipename); + /* write FIFO */ + sn_printf(FIFO2,sizeof(FIFO2),"%s.w",pipename); + + /* Check that nobody is running to_erl on this pipe already */ + if ((wfd = open (FIFO1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) { + /* Open as server succeeded -- to_erl is already running! */ + close(wfd); + fprintf(stderr, "Another to_erl process already attached to pipe " + "%s.\n", pipename); + if (force_lock) { + fprintf(stderr, "But we proceed anyway by force (-F).\n"); + } + else { + exit(1); + } + } + + if ((rfd = open (FIFO1, O_RDONLY|DONT_BLOCK_PLEASE, 0)) < 0) { +#ifdef DEBUG + fprintf(stderr, "Could not open FIFO %s for reading.\n", FIFO1); +#endif + fprintf(stderr, "No running Erlang on pipe %s.\n", pipename); + exit(1); + } +#ifdef DEBUG + fprintf(stderr, "to_erl: %s opened for reading\n", FIFO1); +#endif + + if ((wfd = open (FIFO2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) { +#ifdef DEBUG + fprintf(stderr, "Could not open FIFO %s for writing.\n", FIFO2); +#endif + fprintf(stderr, "No running Erlang on pipe %s.\n", pipename); + close(rfd); + exit(1); + } +#ifdef DEBUG + fprintf(stderr, "to_erl: %s opened for writing\n", FIFO2); +#endif + + fprintf(stderr, "Attaching to %s (^D to exit)\n\n", pipename); + + /* Set break handler to our handler */ + signal(SIGINT,handle_ctrlc); + + /* + * Save the current state of the terminal, and set raw mode. + */ + if (tcgetattr(0, &tty_rmode) , 0) { + fprintf(stderr, "Cannot get terminals current mode\n"); + exit(-1); + } + tty_smode = tty_rmode; + tty_eof = '\004'; /* Ctrl+D to exit */ +#ifdef DEBUG + show_terminal_settings(&tty_rmode); +#endif + tty_smode.c_iflag = + 1*BRKINT |/*Signal interrupt on break.*/ + 1*IGNPAR |/*Ignore characters with parity errors.*/ + 1*ISTRIP |/*Strip character.*/ + 0; + +#if 0 +0*IGNBRK |/*Ignore break condition.*/ +0*PARMRK |/*Mark parity errors.*/ +0*INPCK |/*Enable input parity check.*/ +0*INLCR |/*Map NL to CR on input.*/ +0*IGNCR |/*Ignore CR.*/ +0*ICRNL |/*Map CR to NL on input.*/ +0*IUCLC |/*Map upper-case to lower-case on input.*/ +0*IXON |/*Enable start/stop output control.*/ +0*IXANY |/*Enable any character to restart output.*/ +0*IXOFF |/*Enable start/stop input control.*/ +0*IMAXBEL|/*Echo BEL on input line too long.*/ +#endif + + tty_smode.c_oflag = + 1*OPOST |/*Post-process output.*/ + 1*ONLCR |/*Map NL to CR-NL on output.*/ +#ifdef XTABS + 1*XTABS |/*Expand tabs to spaces. (Linux)*/ +#endif +#ifdef OXTABS + 1*OXTABS |/*Expand tabs to spaces. (FreeBSD)*/ +#endif +#ifdef NL0 + 1*NL0 |/*Select newline delays*/ +#endif +#ifdef CR0 + 1*CR0 |/*Select carriage-return delays*/ +#endif +#ifdef TAB0 + 1*TAB0 |/*Select horizontal tab delays*/ +#endif +#ifdef BS0 + 1*BS0 |/*Select backspace delays*/ +#endif +#ifdef VT0 + 1*VT0 |/*Select vertical tab delays*/ +#endif +#ifdef FF0 + 1*FF0 |/*Select form feed delays*/ +#endif + 0; + +#if 0 +0*OLCUC |/*Map lower case to upper on output.*/ +0*OCRNL |/*Map CR to NL on output.*/ +0*ONOCR |/*No CR output at column 0.*/ +0*ONLRET |/*NL performs CR function.*/ +0*OFILL |/*Use fill characters for delay.*/ +0*OFDEL |/*Fill is DEL, else NULL.*/ +0*NL1 | +0*CR1 | +0*CR2 | +0*CR3 | +0*TAB1 | +0*TAB2 | +0*TAB3 |/*Expand tabs to spaces.*/ +0*BS1 | +0*VT1 | +0*FF1 | +#endif + + /* JALI: removed setting the tty_smode.c_cflag flags, since this is not */ + /* advisable if this is a *real* terminal, such as the console. In fact */ + /* this may hang the entire machine, deep, deep down (signalling break */ + /* or toggling the abort switch doesn't help) */ + + tty_smode.c_lflag = + 0; + +#if 0 +0*ISIG |/*Enable signals.*/ +0*ICANON |/*Canonical input (erase and kill processing).*/ +0*XCASE |/*Canonical upper/lower presentation.*/ +0*ECHO |/*Enable echo.*/ +0*ECHOE |/*Echo erase character as BS-SP-BS.*/ +0*ECHOK |/*Echo NL after kill character.*/ +0*ECHONL |/*Echo NL.*/ +0*NOFLSH |/*Disable flush after interrupt or quit.*/ +0*TOSTOP |/*Send SIGTTOU for background output.*/ +0*ECHOCTL|/*Echo control characters as ^char, delete as ^?.*/ +0*ECHOPRT|/*Echo erase character as character erased.*/ +0*ECHOKE |/*BS-SP-BS erase entire line on line kill.*/ +0*FLUSHO |/*Output is being flushed.*/ +0*PENDIN |/*Retype pending input at next read or input character.*/ +0*IEXTEN |/*Enable extended (implementation-defined) functions.*/ +#endif + + tty_smode.c_cc[VMIN] =0;/* Note that VMIN is the same as VEOF! */ + tty_smode.c_cc[VTIME] =0;/* Note that VTIME is the same as VEOL! */ + tty_smode.c_cc[VINTR] =3; + + tcsetattr(0, TCSANOW, &tty_smode); + +#ifdef DEBUG + show_terminal_settings(&tty_smode); +#endif + /* + * "Write a ^R to the FIFO which causes the other end to redisplay + * the input line." + * This does not seem to work as was intended in old comment above. + * However, this control character is now (R12B-3) used by run_erl + * to trigger the version handshaking between to_erl and run_erl + * at the start of every new to_erl-session. + */ + write(wfd, "\022", 1); + + /* + * read and write + */ + while (1) { + FD_ZERO(&readfds); + FD_SET(0, &readfds); + FD_SET(rfd, &readfds); + if (select(rfd + 1, &readfds, NULL, NULL, NULL) < 0) { + if (recv_sig) { + FD_ZERO(&readfds); + } + else { + fprintf(stderr, "Error in select.\n"); + result = -1; + break; + } + } + len = 0; + + /* + * Read from terminal and write to FIFO + */ + if (recv_sig) { + switch (recv_sig) { + case SIGINT: + fprintf(stderr, "[Break]\n\r"); + buf[0] = '\003'; + len = 1; + break; + case SIGWINCH: + len = window_size_seq(buf,sizeof(buf)); + break; + default: + fprintf(stderr,"Unexpected signal: %u\n",recv_sig); + } + recv_sig = 0; + } + else if (FD_ISSET(0, &readfds)) { + len = read(0, buf, sizeof(buf)); + if (len <= 0) { + close(rfd); + close(wfd); + if (len < 0) { + fprintf(stderr, "Error in reading from stdin.\n"); + result = -1; + } else { + fprintf(stderr, "[EOF]\n\r"); + } + break; + } + /* check if there is an eof character in input */ + for (i = 0; i < len && buf[i] != tty_eof; i++); + if (buf[i] == tty_eof) { + fprintf(stderr, "[Quit]\n\r"); + break; + } + } + + if (len) { +#ifdef DEBUG + write(1, buf, len); +#endif + if (write_all(wfd, buf, len) != len) { + fprintf(stderr, "Error in writing to FIFO.\n"); + close(rfd); + close(wfd); + result = -1; + break; + } + STATUS("\" OK\r\n"); + } + + /* + * Read from FIFO, write to terminal. + */ + if (FD_ISSET(rfd, &readfds)) { + STATUS("FIFO read: "); + len = read(rfd, buf, BUFSIZ); + if (len < 0 && errno == EAGAIN) { + /* + * No data this time, but the writing end of the FIFO is still open. + * Do nothing. + */ + ; + } else if (len <= 0) { + /* + * Either an error or end of file. In either case, break out + * of the loop. + */ + close(rfd); + close(wfd); + if (len < 0) { + fprintf(stderr, "Error in reading from FIFO.\n"); + result = -1; + } else + fprintf(stderr, "[End]\n\r"); + break; + } else { + if (!got_some) { + if ((len=version_handshake(buf,len,wfd)) < 0) { + close(rfd); + close(wfd); + result = -1; + break; + } + if (protocol_ver >= 1) { + /* Tell run_erl size of terminal window */ + signal(SIGWINCH, handle_sigwinch); + raise(SIGWINCH); + } + got_some = 1; + } + + /* + * We successfully read at least one character. Write what we got. + */ + STATUS("Terminal write: \""); + if (write_all(1, buf, len) != len) { + fprintf(stderr, "Error in writing to terminal.\n"); + close(rfd); + close(wfd); + result = -1; + break; + } + STATUS("\" OK\r\n"); + } + } + } + + /* + * Reset terminal characterstics + * XXX + */ + tcsetattr(0, TCSANOW, &tty_rmode); + return 0; +} + +/* Call write() until entire buffer has been written or error. + * Return len or -1. + */ +static int write_all(int fd, const char* buf, int len) +{ + int left = len; + int written; + while (left) { + written = write(fd,buf,left); + if (written < 0) { + return -1; + } + left -= written; + buf += written; + } + return len; +} + +static int window_size_seq(char* buf, size_t bufsz) +{ +#ifdef TIOCGWINSZ + struct winsize ws; + static const char prefix[] = "\033_"; + static const char suffix[] = "\033\\"; + /* This Esc sequence is called "Application Program Command" + and seems suitable to use for our own customized stuff. */ + + if (ioctl(STDIN_FILENO, TIOCGWINSZ, &ws) == 0) { + int len = sn_printf(buf, bufsz, "%swinsize=%u,%u%s", + prefix, ws.ws_col, ws.ws_row, suffix); + return len; + } +#endif /* TIOCGWINSZ */ + return 0; +} + +/* to_erl run_erl + * | | + * |---------- '\022' -------->| (session start) + * | | + * |<---- "[run_erl v1-0]" ----| (version interval) + * | | + * |--- Esc_"version=1"Esc\ -->| (common version) + * | | + */ +static int version_handshake(char* buf, int len, int wfd) +{ + unsigned re_high=0, re_low; + char *end = find_str(buf,len,"]\n"); + + if (end && sscanf(buf,"[run_erl v%u-%u",&re_high,&re_low)==2) { + char wbuf[30]; + int wlen; + + if (re_low > RUN_ERL_HI_VER || re_high < RUN_ERL_LO_VER) { + fprintf(stderr,"Incompatible versions: to_erl=v%u-%u run_erl=v%u-%u\n", + RUN_ERL_HI_VER, RUN_ERL_LO_VER, re_high, re_low); + return -1; + } + /* Choose highest common version */ + protocol_ver = re_high < RUN_ERL_HI_VER ? re_high : RUN_ERL_HI_VER; + + wlen = sn_printf(wbuf, sizeof(wbuf), "\033_version=%u\033\\", + protocol_ver); + if (write_all(wfd, wbuf, wlen) < 0) { + fprintf(stderr,"Failed to send version handshake\n"); + return -1; + } + end += 2; + len -= (end-buf); + memmove(buf,end,len); + + } + else { /* we assume old run_erl without version handshake */ + protocol_ver = 0; + } + + if (re_high != RUN_ERL_HI_VER) { + fprintf(stderr,"run_erl has different version, " + "using common protocol level %u\n", protocol_ver); + } + + return len; +} + + +#ifdef DEBUG +#define S(x) ((x) > 0 ? 1 : 0) + +static void show_terminal_settings(struct termios *t) +{ + fprintf(stderr,"c_iflag:\n"); + fprintf(stderr,"Signal interrupt on break: BRKINT %d\n", S(t->c_iflag & BRKINT)); + fprintf(stderr,"Map CR to NL on input: ICRNL %d\n", S(t->c_iflag & ICRNL)); + fprintf(stderr,"Ignore break condition: IGNBRK %d\n", S(t->c_iflag & IGNBRK)); + fprintf(stderr,"Ignore CR: IGNCR %d\n", S(t->c_iflag & IGNCR)); + fprintf(stderr,"Ignore char with par. err's: IGNPAR %d\n", S(t->c_iflag & IGNPAR)); + fprintf(stderr,"Map NL to CR on input: INLCR %d\n", S(t->c_iflag & INLCR)); + fprintf(stderr,"Enable input parity check: INPCK %d\n", S(t->c_iflag & INPCK)); + fprintf(stderr,"Strip character ISTRIP %d\n", S(t->c_iflag & ISTRIP)); + fprintf(stderr,"Enable start/stop input ctrl IXOFF %d\n", S(t->c_iflag & IXOFF)); + fprintf(stderr,"ditto output ctrl IXON %d\n", S(t->c_iflag & IXON)); + fprintf(stderr,"Mark parity errors PARMRK %d\n", S(t->c_iflag & PARMRK)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_oflag:\n"); + fprintf(stderr,"Perform output processing OPOST %d\n", S(t->c_oflag & OPOST)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_cflag:\n"); + fprintf(stderr,"Ignore modem status lines CLOCAL %d\n", S(t->c_cflag & CLOCAL)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_local:\n"); + fprintf(stderr,"Enable echo ECHO %d\n", S(t->c_lflag & ECHO)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_cc:\n"); + fprintf(stderr,"c_cc[VEOF] %d\n", t->c_cc[VEOF]); +} +#endif |