diff options
251 files changed, 13267 insertions, 7560 deletions
diff --git a/bootstrap/lib/kernel/ebin/application_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam Binary files differindex aad2c29b2b..b7081212cb 100644 --- a/bootstrap/lib/kernel/ebin/application_controller.beam +++ b/bootstrap/lib/kernel/ebin/application_controller.beam diff --git a/bootstrap/lib/kernel/ebin/file.beam b/bootstrap/lib/kernel/ebin/file.beam Binary files differindex 0c161534f9..d74d356bfb 100644 --- a/bootstrap/lib/kernel/ebin/file.beam +++ b/bootstrap/lib/kernel/ebin/file.beam diff --git a/bootstrap/lib/kernel/ebin/file_server.beam b/bootstrap/lib/kernel/ebin/file_server.beam Binary files differindex 32c6a94a25..9da86c5d44 100644 --- a/bootstrap/lib/kernel/ebin/file_server.beam +++ b/bootstrap/lib/kernel/ebin/file_server.beam diff --git a/bootstrap/lib/stdlib/ebin/c.beam b/bootstrap/lib/stdlib/ebin/c.beam Binary files differindex fad6579ed5..95eeda70bb 100644 --- a/bootstrap/lib/stdlib/ebin/c.beam +++ b/bootstrap/lib/stdlib/ebin/c.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex 7cf872d5aa..5bd32be090 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam Binary files differindex 97446a10a0..14ab68a7e1 100644 --- a/bootstrap/lib/stdlib/ebin/filelib.beam +++ b/bootstrap/lib/stdlib/ebin/filelib.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_format.beam b/bootstrap/lib/stdlib/ebin/io_lib_format.beam Binary files differindex 375e91119d..ceac63435b 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_format.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_format.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex bc3b5ec877..c007d4b306 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex 84feea2c66..c853cf37bd 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex c93fa6485f..097f9e0ab7 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/erts/autoconf/config.guess b/erts/autoconf/config.guess index 38a833903b..f475ceb413 100755 --- a/erts/autoconf/config.guess +++ b/erts/autoconf/config.guess @@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-05-17' +timestamp='2013-02-12' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -17,26 +15,22 @@ timestamp='2007-05-17' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <[email protected]>. -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. # -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# Please send patches with a ChangeLog entry to [email protected]. + me=`echo "$0" | sed -e 's,.*/,,'` @@ -56,8 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -144,7 +137,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward @@ -170,7 +163,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -180,7 +173,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -201,6 +194,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} @@ -223,7 +220,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on @@ -269,7 +266,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead @@ -295,12 +295,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo s390-ibm-zvmoe exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 + echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) + arm*:riscos:*:*|arm*:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) @@ -324,14 +324,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; - i86pc:SunOS:5.*:* | ix86xen:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -375,23 +394,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; @@ -461,8 +480,8 @@ EOF echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -475,7 +494,7 @@ EOF else echo i586-dg-dgux${UNAME_RELEASE} fi - exit ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; @@ -532,7 +551,7 @@ EOF echo rs6000-ibm-aix3.2 fi exit ;; - *:AIX:*:[45]) + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -575,52 +594,52 @@ EOF 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -640,7 +659,7 @@ EOF # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -711,22 +730,22 @@ EOF exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; @@ -750,14 +769,14 @@ EOF exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} @@ -769,40 +788,51 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in amd64) echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 + exit ;; *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - *:Interix*:[3456]*) - case ${UNAME_MACHINE} in - x86) + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) echo i586-pc-interix${UNAME_RELEASE} exit ;; - EM64T | authenticamd) + authenticamd | genuineintel | EM64T) echo x86_64-unknown-interix${UNAME_RELEASE} exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we @@ -832,20 +862,68 @@ EOF i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; - arm*:Linux:*:*) + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) - echo cris-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) - echo frv-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -856,74 +934,36 @@ EOF m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + padre:Linux:*:*) + echo sparc-unknown-linux-gnu exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level @@ -933,14 +973,17 @@ EOF *) echo hppa-unknown-linux-gnu ;; esac exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -948,81 +991,18 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - tile:Linux:*:*) - echo tile-unknown-linux-gnu + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - xtensa:Linux:*:*) - echo xtensa-unknown-linux-gnu + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both @@ -1030,11 +1010,11 @@ EOF echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) @@ -1051,7 +1031,7 @@ EOF i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) @@ -1066,7 +1046,7 @@ EOF fi exit ;; i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; @@ -1094,10 +1074,13 @@ EOF exit ;; pc:*:*:*) # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; @@ -1132,8 +1115,18 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; @@ -1146,7 +1139,7 @@ EOF rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) @@ -1166,10 +1159,10 @@ EOF echo ns32k-sni-sysv fi exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <[email protected]> - echo i586-unisys-sysv4 - exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <[email protected]> + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <[email protected]>. # How about differentiating between stratus architectures? -djm @@ -1195,11 +1188,11 @@ EOF exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; @@ -1209,6 +1202,12 @@ EOF BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; @@ -1236,6 +1235,16 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1251,7 +1260,10 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NSE-?:NONSTOP_KERNEL:*:*) + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) @@ -1296,13 +1308,13 @@ EOF echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} + echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` + UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; @@ -1317,11 +1329,14 @@ EOF i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; esac -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ @@ -1339,11 +1354,11 @@ main () #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif @@ -1477,9 +1492,9 @@ This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff --git a/erts/autoconf/config.sub b/erts/autoconf/config.sub index f43233b104..bb6edbdb47 100755 --- a/erts/autoconf/config.sub +++ b/erts/autoconf/config.sub @@ -1,44 +1,40 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-04-29' +timestamp='2013-02-12' -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# Please send patches with a ChangeLog entry to [email protected]. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -72,8 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -120,12 +115,18 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ - uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] @@ -148,10 +149,13 @@ case $os in -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray) + -apple | -axis | -knuth | -cray | -microblaze*) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -166,10 +170,10 @@ case $os in os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; @@ -214,6 +218,12 @@ case $os in -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; -lynx*) os=-lynxos ;; @@ -238,24 +248,34 @@ case $basic_machine in # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ + | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | arc \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ + | epiphany \ | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | mcore | mep \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ @@ -266,31 +286,45 @@ case $basic_machine in | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ | mt \ | msp430 \ - | nios | nios2 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | or32 \ + | open8 \ + | or1k | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ + | rl78 | rx \ | score \ - | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu | strongarm \ - | tahoe | thumb | tic4x | tic80 | tron \ - | v850 | v850e \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; @@ -300,6 +334,21 @@ case $basic_machine in basic_machine=mt-unknown ;; + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; + # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. @@ -314,29 +363,37 @@ case $basic_machine in # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ + | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* | avr32-* \ + | be32-* | be64-* \ | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ @@ -347,31 +404,41 @@ case $basic_machine in | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ - | nios-* | nios2-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ - | xstormy16-* | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -389,7 +456,7 @@ case $basic_machine in basic_machine=a29k-amd os=-udi ;; - abacus) + abacus) basic_machine=abacus-unknown ;; adobe68k) @@ -435,6 +502,10 @@ case $basic_machine in basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -443,10 +514,35 @@ case $basic_machine in basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -475,8 +571,8 @@ case $basic_machine in basic_machine=craynv-cray os=-unicosmp ;; - cr16c) - basic_machine=cr16c-unknown + cr16 | cr16-*) + basic_machine=cr16-unknown os=-elf ;; crds | unos) @@ -514,6 +610,10 @@ case $basic_machine in basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp @@ -629,7 +729,6 @@ case $basic_machine in i370-ibm* | ibm*) basic_machine=i370-ibm ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 @@ -668,6 +767,14 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -679,6 +786,13 @@ case $basic_machine in basic_machine=ns32k-utek os=-sysv ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; mingw32) basic_machine=i386-pc os=-mingw32 @@ -715,10 +829,18 @@ case $basic_machine in ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -783,6 +905,12 @@ case $basic_machine in np1) basic_machine=np1-gould ;; + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem + ;; nsr-tandem) basic_machine=nsr-tandem ;; @@ -813,6 +941,14 @@ case $basic_machine in basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -857,9 +993,10 @@ case $basic_machine in ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -884,7 +1021,11 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; - rdos) + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) basic_machine=i386-pc os=-rdos ;; @@ -953,6 +1094,9 @@ case $basic_machine in basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -1009,17 +1153,9 @@ case $basic_machine in basic_machine=t90-cray os=-unicos ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -1027,10 +1163,6 @@ case $basic_machine in tx39el) basic_machine=mipstx39el-unknown ;; - tile*) - basic_machine=tile-tilera - os=-linux-gnu - ;; toad1) basic_machine=pdp10-xkl os=-tops20 @@ -1092,6 +1224,9 @@ case $basic_machine in xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1100,6 +1235,10 @@ case $basic_machine in basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1138,7 +1277,7 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) @@ -1185,9 +1324,12 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1208,21 +1350,23 @@ case $os in # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -openbsd* | -solidbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ @@ -1230,7 +1374,7 @@ case $os in | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1269,7 +1413,7 @@ case $os in -opened*) os=-openedition ;; - -os400*) + -os400*) os=-os400 ;; -wince*) @@ -1318,7 +1462,7 @@ case $os in -sinix*) os=-sysv4 ;; - -tpf*) + -tpf*) os=-tpf ;; -triton*) @@ -1354,12 +1498,14 @@ case $os in -aros*) os=-aros ;; - -kaos*) - os=-kaos - ;; -zvmoe) os=-zvmoe ;; + -dicos*) + os=-dicos + ;; + -nacl*) + ;; -none) ;; *) @@ -1382,10 +1528,10 @@ else # system, and we'll never get to this point. case $basic_machine in - score-*) + score-*) os=-elf ;; - spu-*) + spu-*) os=-elf ;; *-acorn) @@ -1397,8 +1543,20 @@ case $basic_machine in arm*-semi) os=-aout ;; - c4x-* | tic4x-*) - os=-coff + c4x-* | tic4x-*) + os=-coff + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff ;; # This must come before the *-dec entry. pdp10-*) @@ -1418,14 +1576,11 @@ case $basic_machine in ;; m68000-sun) os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 ;; m68*-cisco) os=-aout ;; - mep-*) + mep-*) os=-elf ;; mips*-cisco) @@ -1434,6 +1589,9 @@ case $basic_machine in mips*-*) os=-elf ;; + or1k-*) + os=-elf + ;; or32-*) os=-coff ;; @@ -1452,7 +1610,7 @@ case $basic_machine in *-ibm) os=-aix ;; - *-knuth) + *-knuth) os=-mmixware ;; *-wec) @@ -1557,7 +1715,7 @@ case $basic_machine in -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1628,3 +1786,4 @@ exit # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: + diff --git a/erts/configure.in b/erts/configure.in index 1e3a607a6f..7257751068 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1923,12 +1923,21 @@ fi AC_CHECK_FUNCS([getipnodebyname getipnodebyaddr gethostbyname2]) AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlopen \ - pread pwrite writev memmove strerror strerror_r strncasecmp \ + pread pwrite memmove strerror strerror_r strncasecmp \ gethrtime localtime_r gmtime_r inet_pton mmap mremap memcpy mallopt \ sbrk _sbrk __sbrk brk _brk __brk \ flockfile fstat strlcpy strlcat setsid posix2time time2posix \ setlocale nl_langinfo poll]) +dnl writev on OS X snow leopard is broken for files > 4GB +case $host_os in + darwin10.8.0) + AC_MSG_CHECKING([for writev]) + AC_MSG_RESULT(no, not stable on OS X Snow Leopard) ;; + *) + AC_CHECK_FUNCS([writev]) ;; +esac + AC_CHECK_DECLS([posix2time, time2posix],,,[#include <time.h>]) disable_vfork=false diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index f354d68d45..5bfa518266 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -985,15 +985,12 @@ documentation of the <seealso marker="#+sbt">+sbt</seealso> flag. </p> </item> - <tag><marker id="+sws"><c>+sws default|legacy|proposal</c></marker></tag> + <tag><marker id="+sws"><c>+sws default|legacy</c></marker></tag> <item> - <p>Set scheduler wakeup strategy. Default is <c>legacy</c> (has been - used since OTP-R13B). The <c>proposal</c> strategy is the currently - proposed strategy for OTP-R16. Note that the <c>proposal</c> strategy - might change during OTP-R15. + <p> + Set scheduler wakeup strategy. Default strategy changed in erts-5.10/OTP-R16A. This strategy was previously known as <c>proposal</c> in OTP-R15. The <c>legacy</c> strategy was used as default from R13 up to and including R15. </p> - <p><em>NOTE:</em> This flag may be removed or changed at any time - without prior notice. + <p><em>NOTE:</em> This flag may be removed or changed at any time without prior notice. </p> </item> <tag><marker id="+swt"><c>+swt very_low|low|medium|high|very_high</c></marker></tag> diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index 1212c34586..636326e4e1 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -170,10 +170,13 @@ callback, the best approach is to divide the work into multiple chunks of work and trigger multiple calls to the <seealso marker="driver_entry#timeout">timeout callback</seealso> using - zero timeouts. This might, however, not always be possible, e.g. when - calling third party libraries. In this case you typically want to dispatch - the work to another thread. Information about thread primitives can be - found below.</p> + zero timeouts. The + <seealso marker="#erl_drv_consume_timeslice"><c>erl_drv_consume_timeslice()</c></seealso> + function can be useful in order to determine when to trigger such + timeout callback calls. It might, however, not always be possible to + implement it this way, e.g. when calling third party libraries. In this + case you typically want to dispatch the work to another thread. + Information about thread primitives can be found below.</p> </description> <section> @@ -1960,9 +1963,7 @@ ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len emulator thread. This enables the driver to perform time-consuming, blocking operations without blocking the emulator.</p> - <p>Erlang is by default started without an async thread pool. The - number of async threads that the runtime system should use - is specified by the + <p>The async thread pool size can be set with the <seealso marker="erl#async_thread_pool_size">+A</seealso> command line argument of <seealso marker="erl">erl(1)</seealso>. If no async thread pool is available, the call is made @@ -2807,7 +2808,6 @@ ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len <p>This function is thread-safe.</p> </desc> </func> - <func> <name><ret>int</ret><nametext>erl_drv_getenv(char *key, char *value, size_t *value_size)</nametext></name> <fsummary>Get the value of an environment variable</fsummary> @@ -2843,6 +2843,52 @@ ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len <p>This function is thread-safe.</p> </desc> </func> + <func> + <name><ret>int</ret><nametext>erl_drv_consume_timeslice(ErlDrvPort port, int percent)</nametext></name> + <fsummary>Give the runtime system a hint about how much CPU time the + current driver callback call has consumed</fsummary> + <desc> + <marker id="erl_drv_consume_timeslice"></marker> + <p>Arguments:</p> + <taglist> + <tag><c>port</c></tag> + <item>Port handle of the executing port.</item> + <tag><c>percent</c></tag> + <item>Approximate consumed fraction of a full + time-slice in percent.</item> + </taglist> + <p>Give the runtime system a hint about how much CPU time the + current driver callback call has consumed since last hint, or + since the start of the callback if no previous hint has been given. + The time is given as a fraction, in percent, of a full time-slice + that a port is allowed to execute before it should surrender the + CPU to other runnable ports or processes. Valid range is + <c>[1, 100]</c>. The scheduling time-slice is not an exact entity, + but can usually be approximated to about 1 millisecond.</p> + + <p>Note that it is up to the runtime system to determine if and + how to use this information. Implementations on some platforms + may use other means in order to determine the consumed fraction + of the time-slice. Lengthy driver callbacks should regardless of + this frequently call the <c>erl_drv_consume_timeslice()</c> + function in order to determine if it is allowed to continue + execution or not.</p> + + <p><c>erl_drv_consume_timeslice()</c> returns a non-zero value + if the time-slice has been exhausted, and zero if the callback is + allowed to continue execution. If a non-zero value is + returned the driver callback should return as soon as possible in + order for the port to be able to yield.</p> + + <p>This function is provided to better support co-operative scheduling, + improve system responsiveness, and to make it easier to prevent + misbehaviors of the VM due to a port monopolizing a scheduler thread. + It can be used when dividing length work into a number of repeated + driver callback calls without the need to use threads. Also see the + important <seealso marker="#WARNING">warning</seealso> text at the + beginning of this document.</p> + </desc> + </func> </funcs> <section> diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index f00f7b9f46..18193d1150 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -174,9 +174,11 @@ ok millisecond has passed. This can be achieved using different approaches. If you have full control over the code that are to execute in the native function, the best approach is to divide the work into multiple chunks of - work and call the native function multiple times. This might, however, - not always be possible, e.g. when calling third party libraries. In this - case you typically want to dispatch the work to another thread, return + work and call the native function multiple times. Function + <seealso marker="#enif_consume_timeslice">enif_consume_timeslice</seealso> can be + used this facilitate such work division. In some cases, however, this might not + be possible, e.g. when calling third party libraries. Then you typically want + to dispatch the work to another thread, return from the native function, and wait for the result. The thread can send the result back to the calling thread using message passing. Information about thread primitives can be found below.</p> @@ -227,8 +229,8 @@ ok bit length have no support yet.</p> </item> <tag>Resource objects</tag> - <item><p>The use of resource objects is a way to return pointers to - native data structures from a NIF in a safe way. A resource object is + <item><p>The use of resource objects is a safe way to return pointers to + native data structures from a NIF. A resource object is just a block of memory allocated with <seealso marker="#enif_alloc_resource">enif_alloc_resource</seealso>. A handle ("safe pointer") to this memory block can then be returned to Erlang by the use of @@ -581,6 +583,31 @@ typedef enum { <desc><p>Same as <seealso marker="erl_driver#erl_drv_cond_wait">erl_drv_cond_wait</seealso>. </p></desc> </func> + <func><name><ret>int</ret><nametext>enif_consume_timeslice(ErlNifEnv *env, int percent)</nametext></name> + <fsummary></fsummary> + <desc><p>Give the runtime system a hint about how much CPU time the current NIF call has consumed + since last hint, or since the start of the NIF if no previous hint has been given. + The time is given as a <c>percent</c> of the timeslice that a process is allowed to execute Erlang + code until it may be suspended to give time for other runnable processes. + The scheduling timeslice is not an exact entity, but can usually be + approximated to about 1 millisecond.</p> + <p>Note that it is up to the runtime system to determine if and how to use this information. + Implementations on some platforms may use other means in order to determine consumed + CPU time. Lengthy NIFs should regardless of this frequently call <c>enif_consume_timeslice</c> + in order to determine if it is allowed to continue execution or not.</p> + + <p>Returns 1 if the timeslice is exhausted, or 0 otherwise. If 1 is returned the NIF should return + as soon as possible in order for the process to yield.</p> + <p>Argument <c>percent</c> must be an integer between 1 and 100. This function + must only be called from a NIF-calling thread and argument <c>env</c> must be + the environment of the calling process.</p> + <p>This function is provided to better support co-operative scheduling, improve system responsiveness, + and make it easier to prevent misbehaviors of the VM due to a NIF monopolizing a scheduler thread. + It can be used to divide <seealso marker="#lengthy_work">length work</seealso> into + a number of repeated NIF-calls without the need to create threads. + See also the <seealso marker="#WARNING">warning</seealso> text at the beginning of this document.</p> + </desc> + </func> <func><name><ret>int</ret><nametext>enif_equal_tids(ErlNifTid tid1, ErlNifTid tid2)</nametext></name> <fsummary></fsummary> <desc><p>Same as <seealso marker="erl_driver#erl_drv_equal_tids">erl_drv_equal_tids</seealso>. diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 7804a7498e..06fefa8efb 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -300,6 +300,44 @@ </desc> </func> <func> + <name name="binary_to_float" arity="1"/> + <fsummary>Convert from text representation to a float</fsummary> + <desc> + <p>Returns the float whose text representation is <c><anno>Binary</anno></c>.</p> + <pre> +> <input>binary_to_float(<<"2.2017764e+0">>).</input> +2.2017764</pre> + <p>Failure: <c>badarg</c> if <c><anno>Binary</anno></c> contains a bad + representation of a float.</p> + </desc> + </func> + <func> + <name name="binary_to_integer" arity="1"/> + <fsummary>Convert from text representation to an integer</fsummary> + <desc> + <p>Returns an integer whose text representation is + <c><anno>Binary</anno></c>.</p> + <pre> +> <input>binary_to_integer(<<"123">>).</input> +123</pre> + <p>Failure: <c>badarg</c> if <c><anno>Binary</anno></c> contains a bad + representation of an integer.</p> + </desc> + </func> + <func> + <name name="binary_to_integer" arity="2"/> + <fsummary>Convert from text representation to an integer</fsummary> + <desc> + <p>Returns an integer whose text representation in base + <c><anno>Base</anno></c> is <c><anno>Binary</anno></c>.</p> + <pre> +> <input>binary_to_integer(<<"3FF">>, 16).</input> +1023</pre> + <p>Failure: <c>badarg</c> if <c><anno>Binary</anno></c> contains a bad + representation of an integer.</p> + </desc> + </func> + <func> <name name="binary_to_list" arity="1"/> <fsummary>Convert a binary to a list</fsummary> <desc> @@ -961,26 +999,38 @@ true </desc> </func> <func> - <name name="float_to_list" arity="1"/> + <name name="float_to_binary" arity="1"/> <fsummary>Text representation of a float</fsummary> <desc> - <p>Returns a string which corresponds to the text - representation of <c><anno>Float</anno></c>.</p> + <p>The same as <c>float_to_binary(<anno>Float</anno>,[{scientific,20}])</c>.</p> + </desc> + </func> + <func> + <name name="float_to_binary" arity="2"/> + <fsummary>Text representation of a float formatted using given options</fsummary> + <desc> + <p>Returns a binary which corresponds to the text + representation of <c><anno>Float</anno></c> using fixed decimal + point formatting. The <c><anno>Options</anno></c> behave in the same + way as <seealso marker="#float_to_list/2">float_to_list/2</seealso>. + </p> <pre> -> <input>float_to_list(7.0).</input> -"7.00000000000000000000e+00"</pre> +> <input>float_to_binary(7.12, [{decimals, 4}]).</input> +<<"7.1200">> +> <input>float_to_binary(7.12, [{decimals, 4}, compact]).</input> +<<"7.12">></pre> </desc> </func> <func> - <name>float_to_list(Float, Options) -> string()</name> + <name name="float_to_list" arity="1"/> + <fsummary>Text representation of a float</fsummary> + <desc> + <p>The same as <c>float_to_list(<anno>Float</anno>,[{scientific,20}])</c>.</p> + </desc> + </func> + <func> + <name name="float_to_list" arity="2"/> <fsummary>Text representation of a float formatted using given options</fsummary> - <type> - <v>Float = float()</v> - <v>Options = [Option]</v> - <v>Option = {decimals, Decimals::0..249} | - {scientific, Decimals::0..249} | - compact</v> - </type> <desc> <p>Returns a string which corresponds to the text representation of <c>Float</c> using fixed decimal point formatting. @@ -993,7 +1043,8 @@ true only meaningful together with the <c>decimals</c> option). When <c>scientific</c> option is provided, the float will be formatted using scientific notation with <c>Decimals</c> digits of precision. If - <c>Options</c> is <c>[]</c> the function behaves like <c>float_to_list/1</c>. + <c>Options</c> is <c>[]</c> the function behaves like + <c><seealso marker="#float_to_list/1">float_to_list/1</seealso></c>. </p> <pre> > <input>float_to_list(7.12, [{decimals, 4}]).</input> @@ -1429,7 +1480,28 @@ os_prompt% </pre> {one,new,two,three}</pre> </desc> </func> - + <func> + <name name="integer_to_binary" arity="1"/> + <fsummary>Text representation of an integer</fsummary> + <desc> + <p>Returns a binary which corresponds to the text + representation of <c><anno>Integer</anno></c>.</p> + <pre> +> <input>integer_to_binary(77).</input> +<<"77">></pre> + </desc> + </func> + <func> + <name name="integer_to_binary" arity="2"/> + <fsummary>Text representation of an integer</fsummary> + <desc> + <p>Returns a binary which corresponds to the text + representation of <c><anno>Integer</anno></c> in base <c><anno>Base</anno></c>.</p> + <pre> +> <input>integer_to_binary(1023, 16).</input> +<<"3FF">></pre> + </desc> + </func> <func> <name name="integer_to_list" arity="1"/> <fsummary>Text representation of an integer</fsummary> diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml index f0bde600ad..c73cdfd290 100644 --- a/erts/doc/src/erts_alloc.xml +++ b/erts/doc/src/erts_alloc.xml @@ -276,7 +276,7 @@ <item> Max cached segments. The maximum number of memory segments stored in the memory segment cache. Valid range is - 0-30. Default value is 5.</item> + 0-30. Default value is 10.</item> </taglist> <p>The following flags are available for configuration of <c>sys_alloc</c>:</p> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 42298e4824..0363f0237e 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -144,7 +144,7 @@ spawning processes, terminating processes, sending messages, etc.</item> <item>Optimizations of run queue management reducing contention.</item> - <item>Optimizations of process state changes reducing + <item>Optimizations of process internal state changes reducing contention.</item> </list> <p>These changes imply changes of the characteristics the system. Most notable: changed timing in the system.</p> @@ -403,7 +403,7 @@ </item> <item> <p> - The <seealso marker="#+stbt">+stbt</seealso> command line + The <seealso marker="erl#+stbt">+stbt</seealso> command line argument of <c>erl</c> was added. This argument can be used for trying to set scheduler bind type. Upon failure unbound schedulers will be used.</p> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 3e44bbb8db..2877e58cdf 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -20,6 +20,8 @@ include $(ERL_TOP)/make/target.mk include ../vsn.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk +-include $(TARGET)/gen_git_version.mk + ENABLE_ALLOC_TYPE_VARS = @ENABLE_ALLOC_TYPE_VARS@ HIPE_ENABLED=@HIPE_ENABLED@ @@ -196,7 +198,7 @@ else EMU_CC = @EMU_CC@ endif WFLAGS = @WFLAGS@ -CFLAGS = @STATIC_CFLAGS@ $(TYPE_FLAGS) $(FLAVOR_FLAGS) $(DEFS) $(WFLAGS) $(THR_DEFS) $(ARCHCFLAGS) +CFLAGS = @STATIC_CFLAGS@ $(TYPE_FLAGS) $(FLAVOR_FLAGS) $(DEFS) $(WFLAGS) $(THR_DEFS) $(ARCHCFLAGS) $(GIT_VSN) HCC = @HCC@ LD = @LD@ DEXPORT = @DEXPORT@ @@ -1006,6 +1008,12 @@ DEP_FLAGS=-MM $(MG_FLAG) $(CFLAGS) $(INCLUDES) -Idrivers/common -Idrivers/$(ERLA SYS_SRC=$(ALL_SYS_SRC) endif +.PHONY: $(TARGET)/gen_git_version.mk +$(TARGET)/gen_git_version.mk: +# We touch beam/erl_bif.info.c if we regenerated the git version to force a +# rebuild. + if $(gen_verbose)utils/gen_git_version $@; then touch beam/erl_bif_info.c; fi + .PHONY: depend ifdef VOID_EMULATOR depend: diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c index b69f979397..84d2d5e3ed 100644 --- a/erts/emulator/beam/atom.c +++ b/erts/emulator/beam/atom.c @@ -132,9 +132,17 @@ atom_hash(Atom* obj) byte* p = obj->name; int len = obj->len; HashValue h = 0, g; + byte v; while(len--) { - h = (h << 4) + *p++; + v = *p++; + /* latin1 clutch for r16 */ + if ((v & 0xFE) == 0xC2 && (*p & 0xC0) == 0x80) { + v = (v << 6) | (*p & 0x3F); + p++; len--; + } + /* normal hashpjw follows for v */ + h = (h << 4) + v; if ((g = h & 0xf0000000)) { h ^= (g >> 24); h ^= g; diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index f138324e1f..ce60bb9bbc 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -269,6 +269,7 @@ atom hipe_architecture atom http httph https http_response http_request http_header http_eoh http_error http_bin httph_bin atom id atom if_clause +atom ignore atom imports atom in atom in_exiting diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 73264214ce..8a8239493a 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -1081,7 +1081,21 @@ beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module) static int is_native(BeamInstr* code) { - return ((Eterm *)code[MI_FUNCTIONS])[1] != 0; + Uint i, num_functions = code[MI_NUM_FUNCTIONS]; + + /* Check NativeAdress of first real function in module + */ + for (i=0; i<num_functions; i++) { + BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i]; + Eterm name = (Eterm) func_info[3]; + + if (is_atom(name)) { + return func_info[1] != 0; + } + else ASSERT(is_nil(name)); /* ignore BIF stubs */ + } + /* Not a single non-BIF function? */ + return 0; } diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 0e9d140908..e2c3bf292f 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1070,17 +1070,6 @@ init_emulator(void) #endif /* USE_VM_PROBES */ -#ifdef USE_VM_PROBES -void -dtrace_drvport_str(ErlDrvPort drvport, char *port_buf) -{ - Port *port = erts_drvport2port(drvport, NULL); - - erts_snprintf(port_buf, DTRACE_TERM_BUF_SIZE, "#Port<%lu.%lu>", - port_channel_no(port->common.id), - port_number(port->common.id)); -} -#endif /* * process_main() is called twice: * The first call performs some initialisation, including exporting diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 46f76624a5..9c438679ea 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -39,6 +39,7 @@ #include "erl_thr_progress.h" #define ERTS_PTAB_WANT_BIF_IMPL__ #include "erl_ptab.h" +#include "erl_bits.h" static Export* flush_monitor_message_trap = NULL; static Export* set_cpu_topology_trap = NULL; @@ -2069,11 +2070,16 @@ BIF_RETTYPE send_3(BIF_ALIST_3) result = do_send(p, to, msg, suspend, &ref); if (result > 0) { ERTS_VBUMP_REDS(p, result); + if (ERTS_IS_PROC_OUT_OF_REDS(p)) + goto yield_return; BIF_RET(am_ok); } switch (result) { case 0: + /* May need to yield even though we do not bump reds here... */ + if (ERTS_IS_PROC_OUT_OF_REDS(p)) + goto yield_return; BIF_RET(am_ok); break; case SEND_TRAP: @@ -2091,10 +2097,10 @@ BIF_RETTYPE send_3(BIF_ALIST_3) } break; case SEND_YIELD_RETURN: - if (suspend) - ERTS_BIF_YIELD_RETURN(p, am_ok); - else + if (!suspend) BIF_RET(am_nosuspend); + yield_return: + ERTS_BIF_YIELD_RETURN(p, am_ok); case SEND_AWAIT_RESULT: ASSERT(is_internal_ref(ref)); BIF_TRAP3(await_port_send_result_trap, p, ref, am_nosuspend, am_ok); @@ -2133,11 +2139,16 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) if (result > 0) { ERTS_VBUMP_REDS(p, result); + if (ERTS_IS_PROC_OUT_OF_REDS(p)) + goto yield_return; BIF_RET(msg); } switch (result) { case 0: + /* May need to yield even though we do not bump reds here... */ + if (ERTS_IS_PROC_OUT_OF_REDS(p)) + goto yield_return; BIF_RET(msg); break; case SEND_TRAP: @@ -2147,6 +2158,7 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) ERTS_BIF_YIELD2(bif_export[BIF_send_2], p, to, msg); break; case SEND_YIELD_RETURN: + yield_return: ERTS_BIF_YIELD_RETURN(p, msg); case SEND_AWAIT_RESULT: ASSERT(is_internal_ref(ref)); @@ -2895,45 +2907,69 @@ BIF_RETTYPE string_to_integer_1(BIF_ALIST_1) BIF_RET(TUPLE2(hp, res, tail)); } } - BIF_RETTYPE list_to_integer_1(BIF_ALIST_1) -{ + { + /* Using do_list_to_integer is about twice as fast as using + erts_chars_to_integer because we do not have to copy the + entire list */ Eterm res; Eterm dummy; /* must be a list */ - if (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&dummy) != LTI_ALL_INTEGER) { BIF_ERROR(BIF_P,BADARG); } BIF_RET(res); } -/**********************************************************************/ +BIF_RETTYPE list_to_integer_2(BIF_ALIST_2) +{ -/* convert a float to a list of ascii characters */ + /* Bif implementation is about 50% faster than pure erlang, + and since we have erts_chars_to_integer now it is simpler + as well. This could be optmized further if we did not have to + copy the list to buf. */ + int i; + Eterm res; + char *buf = NULL; + int base; -BIF_RETTYPE float_to_list_1(BIF_ALIST_1) -{ - int i; - Uint need; - Eterm* hp; - FloatDef f; - char fbuf[30]; + i = list_length(BIF_ARG_1); + if (i < 0) + BIF_ERROR(BIF_P, BADARG); + + base = signed_val(BIF_ARG_2); + + if (base < 2 || base > 36) + BIF_ERROR(BIF_P, BADARG); + + /* Take fast path if base it 10 */ + if (base == 10) + return list_to_integer_1(BIF_P,&BIF_ARG_1); + + buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1); + + if (intlist_to_buf(BIF_ARG_1, buf, i) < 0) + goto list_to_integer_1_error; + buf[i] = '\0'; /* null terminal */ + + if ((res = erts_chars_to_integer(BIF_P,buf,i,base)) == THE_NON_VALUE) + goto list_to_integer_1_error; + + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_RET(res); + + list_to_integer_1_error: + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_ERROR(BIF_P, BADARG); - /* check the arguments */ - if (is_not_float(BIF_ARG_1)) - BIF_ERROR(BIF_P, BADARG); - GET_DOUBLE(BIF_ARG_1, f); - if ((i = sys_double_to_chars(f.fd, fbuf, sizeof(fbuf))) <= 0) - BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); - need = i*2; - hp = HAlloc(BIF_P, need); - BIF_RET(buf_to_intlist(&hp, fbuf, i, NIL)); -} + } + +/**********************************************************************/ + +static int do_float_to_charbuf(Process *p, Eterm efloat, Eterm list, + char *fbuf, int sizeof_fbuf) { -BIF_RETTYPE float_to_list_2(BIF_ALIST_2) -{ const static int arity_two = make_arityval(2); int decimals = SYS_DEFAULT_FLOAT_DECIMALS; int compact = 0; @@ -2942,16 +2978,11 @@ BIF_RETTYPE float_to_list_2(BIF_ALIST_2) FMT_FIXED, FMT_SCIENTIFIC } fmt_type = FMT_LEGACY; - Eterm list = BIF_ARG_2; Eterm arg; - int i; - Uint need; - Eterm* hp; FloatDef f; - char fbuf[256]; /* check the arguments */ - if (is_not_float(BIF_ARG_1)) + if (is_not_float(efloat)) goto badarg; for(; is_list(list); list = CDR(list_val(list))) { @@ -2963,15 +2994,14 @@ BIF_RETTYPE float_to_list_2(BIF_ALIST_2) Eterm* tp = tuple_val(arg); if (*tp == arity_two && is_small(tp[2])) { decimals = signed_val(tp[2]); - if (decimals > 0 && decimals < sizeof(fbuf) - 6 /* "X." ++ "e+YY" */) - switch (tp[1]) { - case am_decimals: - fmt_type = FMT_FIXED; - continue; - case am_scientific: - fmt_type = FMT_SCIENTIFIC; - continue; - } + switch (tp[1]) { + case am_decimals: + fmt_type = FMT_FIXED; + continue; + case am_scientific: + fmt_type = FMT_SCIENTIFIC; + continue; + } } } goto badarg; @@ -2980,22 +3010,64 @@ BIF_RETTYPE float_to_list_2(BIF_ALIST_2) goto badarg; } - GET_DOUBLE(BIF_ARG_1, f); + GET_DOUBLE(efloat, f); if (fmt_type == FMT_FIXED) { - if ((i = sys_double_to_chars_fast(f.fd, fbuf, sizeof(fbuf), - decimals, compact)) <= 0) - goto badarg; + return sys_double_to_chars_fast(f.fd, fbuf, sizeof_fbuf, + decimals, compact); } else { - if ((i = sys_double_to_chars_ext(f.fd, fbuf, sizeof(fbuf), decimals)) <= 0) - goto badarg; + return sys_double_to_chars_ext(f.fd, fbuf, sizeof_fbuf, decimals); } - need = i*2; - hp = HAlloc(BIF_P, need); - BIF_RET(buf_to_intlist(&hp, fbuf, i, NIL)); badarg: + return -1; +} + +/* convert a float to a list of ascii characters */ + +static BIF_RETTYPE do_float_to_list(Process *BIF_P, Eterm arg, Eterm opts) { + int used; + Eterm* hp; + char fbuf[256]; + + if ((used = do_float_to_charbuf(BIF_P,arg,opts,fbuf,sizeof(fbuf))) <= 0) { BIF_ERROR(BIF_P, BADARG); + } + hp = HAlloc(BIF_P, (Uint)used*2); + BIF_RET(buf_to_intlist(&hp, fbuf, (Uint)used, NIL)); +} + + +BIF_RETTYPE float_to_list_1(BIF_ALIST_1) +{ + return do_float_to_list(BIF_P,BIF_ARG_1,NIL); +} + +BIF_RETTYPE float_to_list_2(BIF_ALIST_2) +{ + return do_float_to_list(BIF_P,BIF_ARG_1,BIF_ARG_2); +} + +/* convert a float to a binary of ascii characters */ + +static BIF_RETTYPE do_float_to_binary(Process *BIF_P, Eterm arg, Eterm opts) { + int used; + char fbuf[256]; + + if ((used = do_float_to_charbuf(BIF_P,arg,opts,fbuf,sizeof(fbuf))) <= 0) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(new_binary(BIF_P, (byte*)fbuf, (Uint)used)); +} + +BIF_RETTYPE float_to_binary_1(BIF_ALIST_1) +{ + return do_float_to_binary(BIF_P,BIF_ARG_1,NIL); +} + +BIF_RETTYPE float_to_binary_2(BIF_ALIST_2) +{ + return do_float_to_binary(BIF_P,BIF_ARG_1,BIF_ARG_2); } /**********************************************************************/ @@ -3180,36 +3252,101 @@ BIF_RETTYPE string_to_float_1(BIF_ALIST_1) BIF_RET(tup); } +static BIF_RETTYPE do_charbuf_to_float(Process *BIF_P,char *buf) { + FloatDef f; + Eterm res; + Eterm* hp; + + if (sys_chars_to_double(buf, &f.fd) != 0) + BIF_ERROR(BIF_P, BADARG); + + hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT); + res = make_float(hp); + PUT_DOUBLE(f, hp); + BIF_RET(res); + +} BIF_RETTYPE list_to_float_1(BIF_ALIST_1) { int i; - FloatDef f; Eterm res; - Eterm* hp; char *buf = NULL; i = list_length(BIF_ARG_1); - if (i < 0) { - badarg: - if (buf) - erts_free(ERTS_ALC_T_TMP, (void *) buf); - BIF_ERROR(BIF_P, BADARG); - } - + if (i < 0) + BIF_ERROR(BIF_P, BADARG); + buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1); if (intlist_to_buf(BIF_ARG_1, buf, i) < 0) - goto badarg; + goto list_to_float_1_error; buf[i] = '\0'; /* null terminal */ + + if ((res = do_charbuf_to_float(BIF_P,buf)) == THE_NON_VALUE) + goto list_to_float_1_error; + + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_RET(res); + + list_to_float_1_error: + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_ERROR(BIF_P, BADARG); + +} + +BIF_RETTYPE binary_to_float_1(BIF_ALIST_1) +{ + Eterm res; + Eterm binary = BIF_ARG_1; + Sint size; + byte* bytes, *buf; + Eterm* real_bin; + Uint offs = 0; + Uint bit_offs = 0; + + if (is_not_binary(binary) || (size = binary_size(binary)) == 0) + BIF_ERROR(BIF_P, BADARG); + + /* + * Unfortunately we have to copy the binary because we have to insert + * the '\0' at the end of the binary for strtod to work + * (there is no nstrtod :( ) + */ + + buf = erts_alloc(ERTS_ALC_T_TMP, size + 1); + + real_bin = binary_val(binary); + if (*real_bin == HEADER_SUB_BIN) { + ErlSubBin* sb = (ErlSubBin *) real_bin; + if (sb->bitsize) { + goto binary_to_float_1_error; + } + offs = sb->offs; + bit_offs = sb->bitoffs; + real_bin = binary_val(sb->orig); + } + if (*real_bin == HEADER_PROC_BIN) { + bytes = ((ProcBin *) real_bin)->bytes + offs; + } else { + bytes = (byte *)(&(((ErlHeapBin *) real_bin)->data)) + offs; + } + if (bit_offs) + erts_copy_bits(bytes, bit_offs, 1, buf, 0, 1, size*8); + else + memcpy(buf, bytes, size); + + buf[size] = '\0'; + + if ((res = do_charbuf_to_float(BIF_P,(char*)buf)) == THE_NON_VALUE) + goto binary_to_float_1_error; - if (sys_chars_to_double(buf, &f.fd) != 0) - goto badarg; - hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT); - res = make_float(hp); - PUT_DOUBLE(f, hp); erts_free(ERTS_ALC_T_TMP, (void *) buf); BIF_RET(res); + + binary_to_float_1_error: + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_ERROR(BIF_P, BADARG); } /**********************************************************************/ diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index ceaf747875..51b77a95ed 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -35,6 +35,13 @@ extern Export* erts_format_cpu_topology_trap; #define BIF_ARG_2 (BIF__ARGS[1]) #define BIF_ARG_3 (BIF__ARGS[2]) +#define ERTS_IS_PROC_OUT_OF_REDS(p) \ + ((p)->fcalls > 0 \ + ? 0 \ + : (!ERTS_PROC_GET_SAVED_CALLS_BUF((p)) \ + ? (p)->fcalls == 0 \ + : ((p)->fcalls == -CONTEXT_REDS))) + #define BUMP_ALL_REDS(p) do { \ if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) \ (p)->fcalls = 0; \ diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 4aaf466008..b74dc5c3fe 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -522,6 +522,7 @@ bif erlang:nif_error/2 bif prim_file:internal_name2native/1 bif prim_file:internal_native2name/1 bif prim_file:internal_normalize_utf8/1 +bif prim_file:is_translatable/1 bif file:native_name_encoding/0 # @@ -560,6 +561,13 @@ bif erlang:prepare_loading/2 bif erlang:finish_loading/1 bif erlang:insert_element/3 bif erlang:delete_element/2 +bif erlang:binary_to_integer/1 +bif erlang:binary_to_integer/2 +bif erlang:integer_to_binary/1 +bif erlang:list_to_integer/2 +bif erlang:float_to_binary/1 +bif erlang:float_to_binary/2 +bif erlang:binary_to_float/1 # # Obsolete diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 5a5b162b9c..acfcc845e4 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1674,26 +1674,26 @@ int big_decimal_estimate(Wterm x) ** Convert a bignum into a string of decimal numbers */ -static void write_big(Wterm x, void (*write_func)(void *, char), void *arg) +static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) { Eterm* xp = big_val(x); ErtsDigit* dx = BIG_V(xp); dsize_t xl = BIG_SIZE(xp); short sign = BIG_SIGN(xp); ErtsDigit rem; + Uint n = 0; if (xl == 1 && *dx < D_DECIMAL_BASE) { rem = *dx; - if (rem == 0) - (*write_func)(arg, '0'); - else { + if (rem == 0) { + (*write_func)(arg, '0'); n++; + } else { while(rem) { - (*write_func)(arg, (rem % 10) + '0'); + (*write_func)(arg, (rem % 10) + '0'); n++; rem /= 10; } } - } - else { + } else { ErtsDigit* tmp = (ErtsDigit*) erts_alloc(ERTS_ALC_T_TMP, sizeof(ErtsDigit)*xl); dsize_t tmpl = xl; @@ -1704,15 +1704,14 @@ static void write_big(Wterm x, void (*write_func)(void *, char), void *arg) tmpl = D_div(tmp, tmpl, D_DECIMAL_BASE, tmp, &rem); if (tmpl == 1 && *tmp == 0) { while(rem) { - (*write_func)(arg, (rem % 10)+'0'); + (*write_func)(arg, (rem % 10)+'0'); n++; rem /= 10; } break; - } - else { + } else { int i = D_DECIMAL_EXP; while(i--) { - (*write_func)(arg, (rem % 10)+'0'); + (*write_func)(arg, (rem % 10)+'0'); n++; rem /= 10; } } @@ -1720,8 +1719,10 @@ static void write_big(Wterm x, void (*write_func)(void *, char), void *arg) erts_free(ERTS_ALC_T_TMP, (void *) tmp); } - if (sign) - (*write_func)(arg, '-'); + if (sign) { + (*write_func)(arg, '-'); n++; + } + return n; } struct big_list__ { @@ -1762,6 +1763,20 @@ char *erts_big_to_string(Wterm x, char *buf, Uint buf_sz) return big_str; } +/* Bignum to binary bytes + * e.g. 1 bsl 64 -> "18446744073709551616" + */ + +Uint erts_big_to_binary_bytes(Eterm x, char *buf, Uint buf_sz) +{ + char *big_str = buf + buf_sz; + Uint n; + n = write_big(x, write_string, (void *) &big_str); + ASSERT(buf <= big_str && big_str <= buf + buf_sz); + return n; +} + + /* ** Normalize a bignum given thing pointer length in digits and a sign ** patch zero if odd length @@ -2467,3 +2482,209 @@ int term_equals_2pow32(Eterm x) return 0; } } + + +#define IS_VALID_CHARACTER(CHAR,BASE) \ + (CHAR < '0' \ + || (CHAR > ('0' + BASE - 1) \ + && !(BASE > 10 \ + && ((CHAR >= 'a' && CHAR < ('a' + BASE - 10)) \ + || (CHAR >= 'A' && CHAR < ('A' + BASE - 10)))))) +#define CHARACTER_FROM_BASE(CHAR) \ + ((CHAR <= '9') ? CHAR - '0' : 10 + ((CHAR <= 'Z') ? CHAR - 'A' : CHAR - 'a')) +#define D_BASE_EXP(BASE) (d_base_exp_lookup[BASE-2]) +#define D_BASE_BASE(BASE) (d_base_base_lookup[BASE-2]) +#define LG2_LOOKUP(BASE) (lg2_lookup[base-2]) + +/* + * for i in 2..64 do + * lg2_lookup[i-2] = log2(i) + * end + * How many bits are needed to store string of size n + */ +const double lg2_lookup[] = { 1.0, 1.58496, 2, 2.32193, 2.58496, 2.80735, 3.0, + 3.16993, 3.32193, 3.45943, 3.58496, 3.70044, 3.80735, 3.90689, 4.0, + 4.08746, 4.16993, 4.24793, 4.32193, 4.39232, 4.45943, 4.52356, 4.58496, + 4.64386, 4.70044, 4.75489, 4.80735, 4.85798, 4.90689, 4.9542, 5.0, + 5.04439, 5.08746, 5.12928, 5.16993, 5.20945, 5.24793, 5.2854, 5.32193, + 5.35755, 5.39232, 5.42626, 5.45943, 5.49185, 5.52356, 5.55459, 5.58496, + 5.61471, 5.64386, 5.67243, 5.70044, 5.72792, 5.75489, 5.78136, 5.80735, + 5.83289, 5.85798, 5.88264, 5.90689, 5.93074, 5.9542, 5.97728, 6.0 }; + +/* + * for i in 2..64 do + * d_base_exp_lookup[i-2] = 31 / lg2_lookup[i-2]; + * end + * How many characters can fit in 31 bits + */ +const byte d_base_exp_lookup[] = { 31, 19, 15, 13, 11, 11, 10, 9, 9, 8, 8, 8, 8, + 7, 7, 7, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5 }; + +/* + * for i in 2..64 do + * d_base_base_lookup[i-2] = pow(i,d_base_exp_lookup[i-2]); + * end + * How much can the characters which fit in 31 bit represent + */ +const Uint d_base_base_lookup[] = { 2147483648, 1162261467, 1073741824, + 1220703125, 362797056, 1977326743, 1073741824, 387420489, 1000000000, + 214358881, 429981696, 815730721, 1475789056, 170859375, 268435456, + 410338673, 612220032, 893871739, 1280000000, 1801088541, 113379904, + 148035889, 191102976, 244140625, 308915776, 387420489, 481890304, + 594823321, 729000000, 887503681, 1073741824, 1291467969, 1544804416, + 1838265625, 60466176, 69343957, 79235168, 90224199, 102400000, + 115856201, 130691232, 147008443, 164916224, 184528125, 205962976, + 229345007, 254803968, 282475249, 312500000, 345025251, 380204032, + 418195493, 459165024, 503284375, 550731776, 601692057, 656356768, + 714924299, 777600000, 844596301, 916132832, 992436543, 1073741824 }; + +Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, + Uint size, const int base) { + Eterm res; + Sint i = 0; + int n = 0; + int neg = 0; + byte b; + Eterm *hp, *hp_end; + int m; + int lg2; + + if (size == 0) + goto bytebuf_to_integer_1_error; + + if (bytes[0] == '-') { + neg = 1; + bytes++; + size--; + + } else if (bytes[0] == '+') { + bytes++; + size--; + } + + if (size < SMALL_DIGITS && base <= 10) { + /* * + * Take shortcut if we know that all chars are '0' < b < '9' and + * fit in a small. This improves speed by about 10% over the generic + * small case. + * */ + while (size--) { + b = *bytes++; + + if (b < '0' || b > ('0'+base-1)) + goto bytebuf_to_integer_1_error; + + i = i * base + b - '0'; + } + + if (neg) + i = -i; + res = make_small(i); + goto bytebuf_to_integer_1_done; + } + + /* + * Calculate the maximum number of bits which will + * be needed to represent the binary + */ + lg2 = ((size+2)*LG2_LOOKUP(base)+1); + + if (lg2 < SMALL_BITS) { + /* Take shortcut if we know it will fit in a small. + * This improves speed by about 30%. + */ + while (size) { + b = *bytes++; + size--; + + if (IS_VALID_CHARACTER(b,base)) + goto bytebuf_to_integer_1_error; + + i = i * base + CHARACTER_FROM_BASE(b); + + } + + if (neg) + i = -i; + res = make_small(i); + goto bytebuf_to_integer_1_done; + + } + + /* Start calculating bignum */ + m = (lg2 + D_EXP-1)/D_EXP; + m = BIG_NEED_SIZE(m); + + hp = HAlloc(BIF_P, m); + hp_end = hp + m; + + if ((i = (size % D_BASE_EXP(base))) == 0) + i = D_BASE_EXP(base); + + n = size - i; + m = 0; + + while (i--) { + b = *bytes++; + + if (IS_VALID_CHARACTER(b,base)) { + HRelease(BIF_P, hp_end, hp); + goto bytebuf_to_integer_1_error; + } + + m = base * m + CHARACTER_FROM_BASE(b); + } + + res = small_to_big(m, hp); + + while (n) { + i = D_BASE_EXP(base); + n -= D_BASE_EXP(base); + m = 0; + while (i--) { + b = *bytes++; + + if (IS_VALID_CHARACTER(b,base)) { + HRelease(BIF_P, hp_end, hp); + goto bytebuf_to_integer_1_error; + } + + m = base * m + CHARACTER_FROM_BASE(b); + } + if (is_small(res)) { + res = small_to_big(signed_val(res), hp); + } + res = big_times_small(res, D_BASE_BASE(base), hp); + if (is_small(res)) { + res = small_to_big(signed_val(res), hp); + } + res = big_plus_small(res, m, hp); + } + + if (is_big(res)) /* check if small */ + res = big_plus_small(res, 0, hp); /* includes conversion to small */ + + if (neg) { + if (is_small(res)) + res = make_small(-signed_val(res)); + else { + Uint *big = big_val(res); /* point to thing */ + *big = bignum_header_neg(*big); + } + } + + if (is_big(res)) { + hp += (big_arity(res) + 1); + } + HRelease(BIF_P, hp_end, hp); + goto bytebuf_to_integer_1_done; + +bytebuf_to_integer_1_error: + return THE_NON_VALUE; + +bytebuf_to_integer_1_done: + return res; + +} diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 7eb1e5afe2..c74283b9e5 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -117,6 +117,7 @@ typedef Uint dsize_t; /* Vector size type */ int big_decimal_estimate(Wterm); Eterm erts_big_to_list(Eterm, Eterm**); char *erts_big_to_string(Wterm x, char *buf, Uint buf_sz); +Uint erts_big_to_binary_bytes(Eterm x, char *buf, Uint buf_sz); Eterm small_times(Sint, Sint, Eterm*); @@ -165,5 +166,7 @@ int term_equals_2pow32(Eterm); Eterm erts_uint64_to_big(Uint64, Eterm **); Eterm erts_sint64_to_big(Sint64, Eterm **); +Eterm erts_chars_to_integer(Process *, char*, Uint, const int); + #endif diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index dad13f1067..33abac2f3d 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -240,6 +240,98 @@ erts_bin_bytes_to_list(Eterm previous, Eterm* hp, byte* bytes, Uint size, Uint b return previous; } +BIF_RETTYPE binary_to_integer_1(BIF_ALIST_1) +{ + byte *temp_alloc = NULL; + char *bytes; + Uint size; + Eterm res; + + if ((bytes = (char*)erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc)) + == NULL ) + goto binary_to_integer_1_error; + + size = binary_size(BIF_ARG_1); + + if ((res = erts_chars_to_integer(BIF_P,bytes,size,10)) != THE_NON_VALUE) { + erts_free_aligned_binary_bytes(temp_alloc); + return res; + } + + binary_to_integer_1_error: + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE binary_to_integer_2(BIF_ALIST_2) +{ + byte *temp_alloc = NULL; + char *bytes; + Uint size; + int base; + Eterm res; + + if (!is_small(BIF_ARG_2)) + BIF_ERROR(BIF_P, BADARG); + + base = signed_val(BIF_ARG_2); + + if (base < 2 || base > 36) + BIF_ERROR(BIF_P, BADARG); + + if ((bytes = (char*)erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc)) + == NULL ) + goto binary_to_integer_2_error; + + size = binary_size(BIF_ARG_1); + + if ((res = erts_chars_to_integer(BIF_P,bytes,size,base)) != THE_NON_VALUE) { + erts_free_aligned_binary_bytes(temp_alloc); + return res; + } + + binary_to_integer_2_error: + + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(BIF_P, BADARG); + +} + +BIF_RETTYPE integer_to_binary_1(BIF_ALIST_1) +{ + Uint size; + Eterm res; + + if (is_not_integer(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + + if (is_small(BIF_ARG_1)) { + char *c; + struct Sint_buf ibuf; + + /* Enhancement: If we can calculate the buffer size exactly + * we could avoid an unnecessary copy of buffers. + * Useful if size determination is faster than a copy. + */ + c = Sint_to_buf(signed_val(BIF_ARG_1), &ibuf); + size = sys_strlen(c); + res = new_binary(BIF_P, (byte *)c, size); + } else { + byte* bytes; + Uint n = 0; + + /* Here we also have multiple copies of buffers + * due to new_binary interface + */ + size = big_decimal_estimate(BIF_ARG_1) - 1; /* remove null */ + bytes = (byte*) erts_alloc(ERTS_ALC_T_TMP, sizeof(byte)*size); + n = erts_big_to_binary_bytes(BIF_ARG_1, (char *)bytes, size); + res = new_binary(BIF_P, bytes + size - n, n); + erts_free(ERTS_ALC_T_TMP, (void *) bytes); + } + BIF_RET(res); +} BIF_RETTYPE binary_to_list_1(BIF_ALIST_1) { diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 59fe7ea418..0781665f05 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -2698,7 +2698,7 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) */ { ErlDrvSizeT disable = ERL_DRV_BUSY_MSGQ_DISABLED; - erl_drv_busy_msgq_limits((ErlDrvPort) pp, &disable, NULL); + erl_drv_busy_msgq_limits(ERTS_Port2ErlDrvPort(pp), &disable, NULL); } pp->dist_entry = dep; diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 187bc2b48b..ac7f420708 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -643,9 +643,9 @@ alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p) } static ERTS_INLINE void -alcu_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size) +alcu_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags) { - erts_mseg_dealloc_opt(allctr->alloc_no, seg, size, &allctr->mseg_opt); + erts_mseg_dealloc_opt(allctr->alloc_no, seg, size, flags, &allctr->mseg_opt); INC_CC(allctr->calls.mseg_dealloc); } @@ -2276,7 +2276,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) (void *) BLK2UMEM(old_blk), MIN(new_blk_sz, old_blk_sz) - ABLK_HDR_SZ); unlink_carrier(&allctr->sbc_list, old_crr); - alcu_mseg_dealloc(allctr, old_crr, old_crr_sz); + alcu_mseg_dealloc(allctr, old_crr, old_crr_sz, ERTS_MSEG_FLG_NONE); } else { /* Old carrier unchanged; restore stat */ @@ -2352,6 +2352,7 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk) Carrier_t *crr; #if HAVE_ERTS_MSEG Uint is_mseg = 0; + Uint mseg_flags = ERTS_MSEG_FLG_NONE; #endif if (IS_SBC_BLK(blk)) { @@ -2398,6 +2399,7 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk) is_mseg++; ASSERT(crr_sz % MSEG_UNIT_SZ == 0); STAT_MSEG_MBC_FREE(allctr, crr_sz); + mseg_flags = ERTS_MSEG_FLG_2POW; } else #endif @@ -2411,7 +2413,7 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk) #if HAVE_ERTS_MSEG if (is_mseg) { - alcu_mseg_dealloc(allctr, crr, crr_sz); + alcu_mseg_dealloc(allctr, crr, crr_sz, mseg_flags); } else #endif diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index f2ca193ace..831e29d8a2 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -612,8 +612,8 @@ long driver_async(ErlDrvPort ix, unsigned int* key, sched_id = 1; #endif - prt = erts_drvport2port(ix, NULL); - if (!prt) + prt = erts_drvport2port(ix); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index 7cea0bc2eb..1c3e955f47 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -141,7 +141,7 @@ kill_ports_driver_unloaded(DE_Handle *dh) state = erts_atomic32_read_nob(&prt->state); if (!(state & ERTS_PORT_SFLGS_DEAD) && prt->drv_ptr->handle == dh) - driver_failure_atom((ErlDrvPort) prt, "driver_unloaded"); + driver_failure_atom(ERTS_Port2ErlDrvPort(prt), "driver_unloaded"); erts_port_release(prt); } diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index a601e4fb39..8582a8954b 100755 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -69,7 +69,11 @@ static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE " [no-c-stack-objects]" #endif #ifndef OTP_RELEASE +#ifdef ERLANG_GIT_VERSION + " [source-" ERLANG_GIT_VERSION "]" +#else " [source]" +#endif #endif #ifdef ARCH_64 #if HALFWORD_HEAP diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index a9a50a10bf..e280563de1 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -408,6 +408,11 @@ EXTERN int driver_cancel_timer(ErlDrvPort port); EXTERN int driver_read_timer(ErlDrvPort port, unsigned long *time_left); /* + * Inform runtime system about lengthy work. + */ +EXTERN int erl_drv_consume_timeslice(ErlDrvPort port, int percent); + +/* * Get plain-text error message from within a driver */ EXTERN char* erl_errno_id(int error); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 223c9c4d7e..ec3e0d54cb 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -981,19 +981,64 @@ erl_start(int argc, char **argv) break; case 'f': if (!strncmp(argv[i],"-fn",3)) { + int warning_type = ERL_FILENAME_WARNING_WARNING; arg = get_arg(argv[i]+3, argv[i+1], &i); switch (*arg) { case 'u': - erts_set_user_requested_filename_encoding(ERL_FILENAME_UTF8); + switch (*(argv[i]+4)) { + case 'w': + case 0: + break; + case 'i': + warning_type = ERL_FILENAME_WARNING_IGNORE; + break; + case 'e': + warning_type = ERL_FILENAME_WARNING_ERROR; + break; + default: + erts_fprintf(stderr, "bad type of warnings for " + "wrongly coded filename: %s\n", argv[i]+4); + erts_usage(); + } + erts_set_user_requested_filename_encoding + ( + ERL_FILENAME_UTF8, + warning_type + ); break; case 'l': - erts_set_user_requested_filename_encoding(ERL_FILENAME_LATIN1); + erts_set_user_requested_filename_encoding + ( + ERL_FILENAME_LATIN1, + warning_type + ); break; case 'a': - erts_set_user_requested_filename_encoding(ERL_FILENAME_UNKNOWN); + switch (*(argv[i]+4)) { + case 'w': + case 0: + break; + case 'i': + warning_type = ERL_FILENAME_WARNING_IGNORE; + break; + case 'e': + warning_type = ERL_FILENAME_WARNING_ERROR; + break; + default: + erts_fprintf(stderr, "bad type of warnings for " + "wrongly coded filename: %s\n", argv[i]+4); + erts_usage(); + } + erts_set_user_requested_filename_encoding + ( + ERL_FILENAME_UNKNOWN, + warning_type + ); break; default: - erts_fprintf(stderr, "bad filename encoding %s, can be (l,u or a)\n", arg); + erts_fprintf(stderr, "bad filename encoding %s, can be " + "(l,u or a, optionally followed by w, " + "i or e)\n", arg); erts_usage(); } break; diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 068f904b76..d4c2b5bdcc 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1443,6 +1443,19 @@ void* enif_dlsym(void* handle, const char* symbol, return ret; } +int enif_consume_timeslice(ErlNifEnv* env, int percent) +{ + Sint reds; + + ASSERT(is_proc_bound(env) && percent >= 1 && percent <= 100); + if (percent < 1) percent = 1; + else if (percent > 100) percent = 100; + + reds = ((CONTEXT_REDS+99) / 100) * percent; + ASSERT(reds > 0 && reds <= CONTEXT_REDS); + BUMP_REDS(env->proc, reds); + return ERTS_BIF_REDS_LEFT(env->proc) == 0; +} /*************************************************************************** ** load_nif/2 ** diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 93e56332e1..62aebcab6c 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -32,10 +32,11 @@ ** 2.0: R14A ** 2.1: R14B02 "vm_variant" ** 2.2: R14B03 enif_is_exception -** 2.3: R15 enif_make_reverse_list +** 2.3: R15 enif_make_reverse_list, enif_is_number +** 2.4: R16 enif_consume_timeslice */ #define ERL_NIF_MAJOR_VERSION 2 -#define ERL_NIF_MINOR_VERSION 3 +#define ERL_NIF_MINOR_VERSION 4 #include <stdlib.h> diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index af27573433..2f841645e1 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -140,6 +140,7 @@ ERL_NIF_API_FUNC_DECL(int,enif_make_reverse_list,(ErlNifEnv*, ERL_NIF_TERM term, ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term)); ERL_NIF_API_FUNC_DECL(void*,enif_dlopen,(const char* lib, void (*err_handler)(void*,const char*), void* err_arg)); ERL_NIF_API_FUNC_DECL(void*,enif_dlsym,(void* handle, const char* symbol, void (*err_handler)(void*,const char*), void* err_arg)); +ERL_NIF_API_FUNC_DECL(int,enif_consume_timeslice,(ErlNifEnv*, int percent)); /* ** Add new entries here to keep compatibility on Windows!!! @@ -264,6 +265,7 @@ ERL_NIF_API_FUNC_DECL(void*,enif_dlsym,(void* handle, const char* symbol, void ( # define enif_is_number ERL_NIF_API_FUNC_MACRO(enif_is_number) # define enif_dlopen ERL_NIF_API_FUNC_MACRO(enif_dlopen) # define enif_dlsym ERL_NIF_API_FUNC_MACRO(enif_dlsym) +# define enif_consume_timeslice ERL_NIF_API_FUNC_MACRO(enif_consume_timeslice) /* ** Add new entries here diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h index 65b4cd0bfe..ac4f7af5a7 100644 --- a/erts/emulator/beam/erl_port.h +++ b/erts/emulator/beam/erl_port.h @@ -40,7 +40,29 @@ extern int erts_port_parallelism; typedef struct erts_driver_t_ erts_driver_t; -#define ERTS_INVALID_ERL_DRV_PORT ((ErlDrvPort) (SWord) -1) +/* + * It would have been preferred to use NULL as value of + * ERTS_INVALID_ERL_DRV_PORT. That would, however, not be + * backward compatible. In pre-R16 systems, 0 was a valid + * port handle and -1 was used as invalid handle, so we + * are stuck with it. + */ +#define ERTS_INVALID_ERL_DRV_PORT ((struct _erl_drv_port *) ((SWord) -1)) +#ifdef DEBUG +/* Make sure we use this api, and do not cast directly */ +#define ERTS_ErlDrvPort2Port(PH) \ + ((PH) == ERTS_INVALID_ERL_DRV_PORT \ + ? ERTS_INVALID_ERL_DRV_PORT \ + : ((Port *) ((PH) - 4711))) +#define ERTS_Port2ErlDrvPort(PH) \ + ((PH) == ERTS_INVALID_ERL_DRV_PORT \ + ? ERTS_INVALID_ERL_DRV_PORT \ + : ((ErlDrvPort) ((PH) + 4711))) +#else +#define ERTS_ErlDrvPort2Port(PH) ((Port *) (PH)) +#define ERTS_Port2ErlDrvPort(PH) ((ErlDrvPort) (PH)) +#endif + #define SMALL_IO_QUEUE 5 /* Number of fixed elements */ typedef struct { @@ -153,6 +175,7 @@ struct _erl_drv_port { ErlDrvPDL port_data_lock; ErtsPrtSD *psd; /* Port specific data */ + int reds; /* Only used while executing driver callbacks */ }; #define ERTS_PORT_GET_CONNECTED(PRT) \ @@ -429,16 +452,16 @@ ERTS_GLB_INLINE void erts_port_release(Port *); ERTS_GLB_INLINE Port *erts_thr_id2port_sflgs(Eterm id, Uint32 invalid_sflgs); ERTS_GLB_INLINE void erts_thr_port_release(Port *prt); #endif -ERTS_GLB_INLINE Port *erts_thr_drvport2port_raw(ErlDrvPort, int); -ERTS_GLB_INLINE Port *erts_drvport2port_raw(ErlDrvPort drvport); -ERTS_GLB_INLINE Port *erts_drvport2port(ErlDrvPort, erts_aint32_t *); -ERTS_GLB_INLINE Port *erts_drvportid2port(Eterm); +ERTS_GLB_INLINE Port *erts_thr_drvport2port(ErlDrvPort, int); +ERTS_GLB_INLINE Port *erts_drvport2port_state(ErlDrvPort, erts_aint32_t *); ERTS_GLB_INLINE Eterm erts_drvport2id(ErlDrvPort); ERTS_GLB_INLINE Uint32 erts_portid2status(Eterm); ERTS_GLB_INLINE int erts_is_port_alive(Eterm); ERTS_GLB_INLINE int erts_is_valid_tracer_port(Eterm); ERTS_GLB_INLINE int erts_port_driver_callback_epilogue(Port *, erts_aint32_t *); +#define erts_drvport2port(Prt) erts_drvport2port_state((Prt), NULL) + #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE Port *erts_pix2port(int ix) @@ -620,90 +643,72 @@ erts_thr_port_release(Port *prt) #endif -ERTS_GLB_INLINE Port* -erts_thr_drvport2port_raw(ErlDrvPort drvport, int lock_pdl) +ERTS_GLB_INLINE Port * +erts_thr_drvport2port(ErlDrvPort drvport, int lock_pdl) { + Port *prt = ERTS_ErlDrvPort2Port(drvport); + ASSERT(prt != NULL); + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return ERTS_INVALID_ERL_DRV_PORT; + + if (lock_pdl && prt->port_data_lock) + driver_pdl_lock(prt->port_data_lock); + #if ERTS_ENABLE_LOCK_CHECK - int emu_thread = erts_lc_is_emu_thr(); -#endif - if (drvport == ERTS_INVALID_ERL_DRV_PORT) - return NULL; - else { - Port *prt = (Port *) drvport; - if (lock_pdl && prt->port_data_lock) - driver_pdl_lock(prt->port_data_lock); -#if ERTS_ENABLE_LOCK_CHECK - if (!ERTS_IS_CRASH_DUMPING) { - if (emu_thread) { - ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - ERTS_LC_ASSERT(!prt->port_data_lock - || erts_lc_mtx_is_locked(&prt->port_data_lock->mtx)); - } - else { - ERTS_LC_ASSERT(prt->port_data_lock); - ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&prt->port_data_lock->mtx)); - } + if (!ERTS_IS_CRASH_DUMPING) { + if (erts_lc_is_emu_thr()) { + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + ERTS_LC_ASSERT(!prt->port_data_lock + || erts_lc_mtx_is_locked(&prt->port_data_lock->mtx)); + } + else { + ERTS_LC_ASSERT(prt->port_data_lock); + ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&prt->port_data_lock->mtx)); } -#endif - return prt; } -} +#endif -ERTS_GLB_INLINE Port* -erts_drvport2port_raw(ErlDrvPort drvport) -{ - ERTS_LC_ASSERT(erts_lc_is_emu_thr()); - if (drvport == ERTS_INVALID_ERL_DRV_PORT) - return NULL; - else { - Port *prt = (Port *) drvport; - ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) - || ERTS_IS_CRASH_DUMPING); - return prt; + if (erts_atomic32_read_nob(&prt->state) + & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) { + if (lock_pdl && prt->port_data_lock) + driver_pdl_unlock(prt->port_data_lock); + return ERTS_INVALID_ERL_DRV_PORT; } -} - -ERTS_GLB_INLINE Port* -erts_drvport2port(ErlDrvPort drvport, erts_aint32_t *statep) -{ - Port *prt = erts_drvport2port_raw(drvport); - erts_aint32_t state; - if (!prt) - return NULL; - state = erts_atomic32_read_nob(&prt->state); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - return NULL; - if (statep) - *statep = state; return prt; } -ERTS_GLB_INLINE Port* -erts_drvportid2port(Eterm id) +ERTS_GLB_INLINE Port * +erts_drvport2port_state(ErlDrvPort drvport, erts_aint32_t *statep) { - Port *prt; + Port *prt = ERTS_ErlDrvPort2Port(drvport); erts_aint32_t state; - if (is_not_internal_port(id)) - return NULL; - prt = (Port *) erts_ptab_pix2intptr_nob(&erts_port, - internal_port_index(id)); - if (!prt) - return NULL; + ASSERT(prt); + ERTS_LC_ASSERT(erts_lc_is_emu_thr()); + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return ERTS_INVALID_ERL_DRV_PORT; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) || ERTS_IS_CRASH_DUMPING); - if (prt->common.id != id) - return NULL; + /* + * This state check is only needed since a driver callback + * might terminate the port, and then call back into the + * emulator. Drivers should preferably have been forbidden + * to call into the emulator after terminating the port, + * but it has been like this for ages. Perhaps forbid this + * in some future major release? + */ state = erts_atomic32_read_nob(&prt->state); if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - return NULL; + return ERTS_INVALID_ERL_DRV_PORT; + if (statep) + *statep = state; return prt; } ERTS_GLB_INLINE Eterm erts_drvport2id(ErlDrvPort drvport) { - Port *prt = erts_drvport2port_raw(drvport); - if (!prt) + Port *prt = erts_drvport2port(drvport); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return am_undefined; else return prt->common.id; diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index dbc4a06c2d..ce045ec94e 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -685,12 +685,12 @@ enqueue_proc2port_data(Port *pp, void erl_drv_busy_msgq_limits(ErlDrvPort dport, ErlDrvSizeT *lowp, ErlDrvSizeT *highp) { - Port *pp = erts_drvport2port(dport, NULL); - ErtsPortTaskBusyPortQ *bpq = pp->sched.taskq.bpq; + Port *pp = erts_drvport2port(dport); + ErtsPortTaskBusyPortQ *bpq; int written = 0, resume_procs = 0; ErlDrvSizeT low, high; - if (!pp || !bpq) { + if (pp == ERTS_INVALID_ERL_DRV_PORT || !(bpq = pp->sched.taskq.bpq)) { if (lowp) *lowp = ERL_DRV_BUSY_MSGQ_DISABLED; if (highp) @@ -1160,6 +1160,27 @@ select_task_for_exec(Port *pp, } /* + * Cut time slice + */ + +int +erl_drv_consume_timeslice(ErlDrvPort dprt, int percent) +{ + Port *pp = erts_drvport2port(dprt); + if (pp == ERTS_INVALID_ERL_DRV_PORT) + return -1; + if (percent < 1) + percent = 1; + else if (100 < percent) + percent = 100; + pp->reds += percent*((CONTEXT_REDS+99)/100); + if (pp->reds < CONTEXT_REDS) + return 0; + pp->reds = CONTEXT_REDS; + return 1; +} + +/* * Abort a scheduled task. */ @@ -1509,7 +1530,6 @@ fail: void erts_port_task_free_port(Port *pp) { - ErtsProcList *suspended; erts_aint32_t flags; ErtsRunQueue *runq; @@ -1522,19 +1542,16 @@ erts_port_task_free_port(Port *pp) erts_port_task_sched_lock(&pp->sched); flags = erts_smp_atomic32_read_bor_relb(&pp->sched.flags, ERTS_PTS_FLG_EXIT); - suspended = pp->suspended; - pp->suspended = NULL; erts_port_task_sched_unlock(&pp->sched); erts_atomic32_read_bset_relb(&pp->state, - (ERTS_PORT_SFLG_CLOSING + (ERTS_PORT_SFLG_CONNECTED + | ERTS_PORT_SFLG_EXITING + | ERTS_PORT_SFLG_CLOSING | ERTS_PORT_SFLG_FREE), ERTS_PORT_SFLG_FREE); erts_smp_runq_unlock(runq); - if (erts_proclist_fetch(&suspended, NULL)) - erts_resume_processes(suspended); - if (!(flags & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC))) begin_port_cleanup(pp, NULL, NULL); } @@ -1554,7 +1571,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) int processing_busy_q; int res = 0; int vreds = 0; - int reds = ERTS_PORT_REDS_EXECUTE; + int reds = 0; erts_aint_t io_tasks_executed = 0; int fpe_was_unmasked; erts_aint32_t state; @@ -1599,6 +1616,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) fpe_was_unmasked = erts_block_fpe(); state = erts_atomic32_read_nob(&pp->state); + pp->reds = ERTS_PORT_REDS_EXECUTE; goto begin_handle_tasks; while (1) { @@ -1625,14 +1643,14 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) switch (ptp->type) { case ERTS_PORT_TASK_TIMEOUT: - reds += ERTS_PORT_REDS_TIMEOUT; + reds = ERTS_PORT_REDS_TIMEOUT; if (!(state & ERTS_PORT_SFLGS_DEAD)) { DTRACE_DRIVER(driver_timeout, pp); (*pp->drv_ptr->timeout)((ErlDrvData) pp->drv_data); } break; case ERTS_PORT_TASK_INPUT: - reds += ERTS_PORT_REDS_INPUT; + reds = ERTS_PORT_REDS_INPUT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_ready_input, pp); /* NOTE some windows drivers use ->ready_input for input and output */ @@ -1641,7 +1659,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) io_tasks_executed++; break; case ERTS_PORT_TASK_OUTPUT: - reds += ERTS_PORT_REDS_OUTPUT; + reds = ERTS_PORT_REDS_OUTPUT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_ready_output, pp); (*pp->drv_ptr->ready_output)((ErlDrvData) pp->drv_data, @@ -1649,7 +1667,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) io_tasks_executed++; break; case ERTS_PORT_TASK_EVENT: - reds += ERTS_PORT_REDS_EVENT; + reds = ERTS_PORT_REDS_EVENT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_event, pp); (*pp->drv_ptr->event)((ErlDrvData) pp->drv_data, @@ -1661,22 +1679,22 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) ErtsProc2PortSigData *sigdp = &ptp->u.alive.td.psig.data; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); if (!pp->sched.taskq.bpq) - reds += ptp->u.alive.td.psig.callback(pp, - state, - ERTS_PROC2PORT_SIG_EXEC, - sigdp); + reds = ptp->u.alive.td.psig.callback(pp, + state, + ERTS_PROC2PORT_SIG_EXEC, + sigdp); else { ErlDrvSizeT size = erts_proc2port_sig_command_data_size(sigdp); - reds += ptp->u.alive.td.psig.callback(pp, - state, - ERTS_PROC2PORT_SIG_EXEC, - sigdp); + reds = ptp->u.alive.td.psig.callback(pp, + state, + ERTS_PROC2PORT_SIG_EXEC, + sigdp); dequeued_proc2port_data(pp, size); } break; } case ERTS_PORT_TASK_DIST_CMD: - reds += erts_dist_command(pp, CONTEXT_REDS-reds); + reds = erts_dist_command(pp, CONTEXT_REDS - pp->reds); break; default: erl_exit(ERTS_ABORT_EXIT, @@ -1701,7 +1719,10 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) vreds += ERTS_PORT_CALLBACK_VREDS; reds += ERTS_PORT_CALLBACK_VREDS; - if (reds >= CONTEXT_REDS) + pp->reds += reds; + reds = 0; + + if (pp->reds >= CONTEXT_REDS) break; } @@ -1725,6 +1746,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) active = finalize_exec(pp, &execq, processing_busy_q); + reds = pp->reds - vreds; + erts_port_release(pp); *curr_port_pp = NULL; @@ -1770,7 +1793,6 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) res = (erts_smp_atomic_read_nob(&erts_port_task_outstanding_io_tasks) != (erts_aint_t) 0); - reds -= vreds; runq->scheduler->reductions += reds; ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); @@ -1793,10 +1815,11 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p) int i, max; ErtsPortTaskBusyCallerTable *tabp; ErtsPortTask *qs[3]; + ErtsPortTaskHandleList *free_nshp = NULL; + ErtsProcList *plp; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); - /* * Abort remaining tasks... * @@ -1935,7 +1958,42 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p) erts_smp_atomic32_read_band_nob(&pp->sched.flags, ~(ERTS_PTS_FLG_HAVE_BUSY_TASKS - |ERTS_PTS_FLG_HAVE_TASKS)); + |ERTS_PTS_FLG_HAVE_TASKS + |ERTS_PTS_FLGS_BUSY)); + + erts_port_task_sched_lock(&pp->sched); + + /* Cleanup nosuspend handles... */ + free_nshp = (pp->sched.taskq.local.busy.nosuspend + ? get_free_nosuspend_handles(pp) + : NULL); + ASSERT(!pp->sched.taskq.local.busy.nosuspend); + + /* Make sure not to leave any processes suspended on the port... */ + plp = pp->suspended; + pp->suspended = NULL; + + erts_port_task_sched_unlock(&pp->sched); + + if (free_nshp) + free_nosuspend_handles(free_nshp); + + if (erts_proclist_fetch(&plp, NULL)) { +#ifdef USE_VM_PROBES + if (DTRACE_ENABLED(process_port_unblocked)) { + DTRACE_CHARBUF(port_str, 16); + DTRACE_CHARBUF(pid_str, 16); + ErtsProcList* plp2 = plp; + + erts_snprintf(port_str, sizeof(port_str), "%T", pp->common.id); + while (plp2 != NULL) { + erts_snprintf(pid_str, sizeof(pid_str), "%T", plp2->pid); + DTRACE2(process_port_unblocked, pid_str, port_str); + } + } +#endif + erts_resume_processes(plp); + } /* * Schedule cleanup of port structure... diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index 99108af937..80982f3760 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -2573,8 +2573,20 @@ BIF_RETTYPE prim_file_internal_native2name_1(BIF_ALIST_1) case ERL_FILENAME_UTF8: bytes = erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc); if (erts_analyze_utf8(bytes,size,&err_pos,&num_chars,NULL) != ERTS_UTF8_OK) { + Eterm *hp = HAlloc(BIF_P,3); + Eterm warn_type = NIL; erts_free_aligned_binary_bytes(temp_alloc); - goto noconvert; + switch (erts_get_filename_warning_type()) { + case ERL_FILENAME_WARNING_IGNORE: + warn_type = am_ignore; + break; + case ERL_FILENAME_WARNING_ERROR: + warn_type = am_error; + break; + default: + warn_type = am_warning; + } + BIF_RET(TUPLE2(hp,am_error,warn_type)); } num_built = 0; num_eaten = 0; @@ -2607,9 +2619,8 @@ BIF_RETTYPE prim_file_internal_native2name_1(BIF_ALIST_1) erts_free_aligned_binary_bytes(temp_alloc); BIF_RET(ret); default: - goto noconvert; + break; } - noconvert: BIF_RET(BIF_ARG_1); } @@ -2646,6 +2657,52 @@ BIF_RETTYPE prim_file_internal_normalize_utf8_1(BIF_ALIST_1) BIF_RET(ret); } +BIF_RETTYPE prim_file_is_translatable_1(BIF_ALIST_1) +{ + ERTS_DECLARE_DUMMY(Eterm real_bin); + ERTS_DECLARE_DUMMY(Uint offset); + Uint size; + Uint num_chars; + Uint bitsize; + ERTS_DECLARE_DUMMY(Uint bitoffs); + byte *temp_alloc = NULL; + byte *bytes; + byte *err_pos; + int status; + + if (is_not_binary(BIF_ARG_1)) { + BIF_ERROR(BIF_P,BADARG); + } + size = binary_size(BIF_ARG_1); + ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize); + if (bitsize != 0) { + BIF_ERROR(BIF_P,BADARG); + } + if (size == 0) { + BIF_RET(am_true); + } + + /* + * If the encoding is latin1, the pathname is always translatable. + */ + switch (erts_get_native_filename_encoding()) { + case ERL_FILENAME_LATIN1: + BIF_RET(am_true); + case ERL_FILENAME_WIN_WCHAR: + if (erts_get_user_requested_filename_encoding() == ERL_FILENAME_LATIN1) { + BIF_RET(am_true); + } + } + + /* + * Check whether the binary contains legal UTF-8 sequences. + */ + bytes = erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc); + status = erts_analyze_utf8(bytes, size, &err_pos, &num_chars, NULL); + erts_free_aligned_binary_bytes(temp_alloc); + BIF_RET(status == ERTS_UTF8_OK ? am_true : am_false); +} + BIF_RETTYPE file_native_name_encoding_0(BIF_ALIST_0) { switch (erts_get_native_filename_encoding()) { diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 3ea4b24848..b73c883658 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -82,11 +82,11 @@ static void pdl_init(void); #ifdef ERTS_SMP static void driver_monitor_lock_pdl(Port *p); static void driver_monitor_unlock_pdl(Port *p); -#define DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(Port) erts_thr_drvport2port_raw((Port), 1) +#define DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(Port) erts_thr_drvport2port((Port), 1) #define DRV_MONITOR_LOCK_PDL(Port) driver_monitor_lock_pdl(Port) #define DRV_MONITOR_UNLOCK_PDL(Port) driver_monitor_unlock_pdl(Port) #else -#define DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(Port) erts_thr_drvport2port_raw((Port), 0) +#define DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(Port) erts_thr_drvport2port((Port), 0) #define DRV_MONITOR_LOCK_PDL(Port) /* nothing */ #define DRV_MONITOR_UNLOCK_PDL(Port) /* nothing */ #endif @@ -97,12 +97,10 @@ static void driver_monitor_unlock_pdl(Port *p); static ERTS_INLINE ErlIOQueue* drvport2ioq(ErlDrvPort drvport) { - Port *prt = erts_thr_drvport2port_raw(drvport, 0); - erts_aint32_t state = erts_atomic32_read_nob(&prt->state); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) + Port *prt = erts_thr_drvport2port(drvport, 0); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return NULL; - else - return &prt->ioq; + return &prt->ioq; } static ERTS_INLINE int @@ -178,6 +176,22 @@ typedef struct line_buf_context { \ dtrace_proc_str((PID), process_str); \ dtrace_port_str((PORT), port_str); + +void +dtrace_drvport_str(ErlDrvPort drvport, char *port_buf) +{ + Port *port = erts_drvport2port(drvport); + + if (port != ERTS_INVALID_ERL_DRV_PORT) + erts_snprintf(port_buf, DTRACE_TERM_BUF_SIZE, "#Port<%lu.%lu>", + port_channel_no(port->common.id), + port_number(port->common.id)); + else + erts_snprintf(port_buf, DTRACE_TERM_BUF_SIZE, "#Port<INVALID>", + port_channel_no(port->common.id), + port_number(port->common.id)); +} + #endif static ERTS_INLINE void @@ -683,7 +697,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ } #endif fpe_was_unmasked = erts_block_fpe(); - drv_data = (*driver->start)((ErlDrvPort) port, name, opts); + drv_data = (*driver->start)(ERTS_Port2ErlDrvPort(port), name, opts); if (((SWord) drv_data) == -1) error_type = -1; else if (((SWord) drv_data) == -2) { @@ -777,8 +791,8 @@ driver_create_port(ErlDrvPort creator_port_ix, /* Creating port */ if (!erts_get_scheduler_id()) return ERTS_INVALID_ERL_DRV_PORT; - creator_port = erts_drvport2port(creator_port_ix, NULL); - if (!creator_port) + creator_port = erts_drvport2port(creator_port_ix); + if (creator_port == ERTS_INVALID_ERL_DRV_PORT) return ERTS_INVALID_ERL_DRV_PORT; rp = erts_proc_lookup(pid); @@ -849,7 +863,7 @@ driver_create_port(ErlDrvPort creator_port_ix, /* Creating port */ port->drv_data = (UWord) drv_data; - return (ErlDrvPort) port; + return ERTS_Port2ErlDrvPort(port); } #ifdef ERTS_SMP @@ -1185,6 +1199,7 @@ typedef struct { int async; /* Asynchronous operation */ int pre_chk_sched_flags; /* Check sched flags before lock? */ int fpe_was_unmasked; + int reds_left_in; } ErtsTryImmDrvCallState; #define ERTS_INIT_TRY_IMM_DRV_CALL_STATE(C_P, PRT, SFLGS, PTS_FLGS, A, PRT_OP) \ @@ -1199,6 +1214,7 @@ static ERTS_INLINE ErtsTryImmDrvCallResult try_imm_drv_call(ErtsTryImmDrvCallState *sp) { ErtsTryImmDrvCallResult res; + int reds_left_in; erts_aint32_t invalid_state, invalid_sched_flags; Port *prt = sp->port; Process *c_p = sp->c_p; @@ -1232,16 +1248,24 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp) goto locked_fail; } - if (c_p) { + + if (!c_p) + reds_left_in = CONTEXT_REDS/10; + else { if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) trace_virtual_sched(c_p, am_out); if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) profile_runnable_proc(c_p, am_inactive); + reds_left_in = ERTS_BIF_REDS_LEFT(c_p); erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); } + ASSERT(0 <= reds_left_in && reds_left_in <= CONTEXT_REDS); + sp->reds_left_in = reds_left_in; + prt->reds = CONTEXT_REDS - reds_left_in; + ERTS_SMP_CHK_NO_PROC_LOCKS; if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) @@ -1262,10 +1286,12 @@ locked_fail: static ERTS_INLINE void finalize_imm_drv_call(ErtsTryImmDrvCallState *sp) { + int reds; Port *prt = sp->port; Process *c_p = sp->c_p; - erts_port_driver_callback_epilogue(prt, NULL); + reds = prt->reds; + reds += erts_port_driver_callback_epilogue(prt, NULL); erts_unblock_fpe(sp->fpe_was_unmasked); @@ -1280,6 +1306,12 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp) if (c_p) { erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + if (reds != (CONTEXT_REDS - sp->reds_left_in)) { + int bump_reds = reds - (CONTEXT_REDS - sp->reds_left_in); + ASSERT(bump_reds > 0); + BUMP_REDS(c_p, bump_reds); + } + if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) trace_virtual_sched(c_p, am_in); if (erts_system_profile_flags.runnable_procs @@ -3470,7 +3502,7 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) { ErtsLink *lnk; Eterm rreason; - erts_aint32_t state; + erts_aint32_t state, set_state_flags; ERTS_SMP_CHK_NO_PROC_LOCKS; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); @@ -3499,9 +3531,12 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) if (reason == am_normal && from != ERTS_PORT_GET_CONNECTED(p) && from != p->common.id) return 0; + set_state_flags = ERTS_PORT_SFLG_EXITING; if (send_closed) - erts_atomic32_read_bor_relb(&p->state, - ERTS_PORT_SFLG_SEND_CLOSED); + set_state_flags |= ERTS_PORT_SFLG_SEND_CLOSED; + + state = erts_atomic32_read_bor_mb(&p->state, set_state_flags); + state |= set_state_flags; if (IS_TRACED_FL(p, F_TRACE_PORTS)) { trace_port(p, am_closed, reason); @@ -3509,17 +3544,11 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) erts_trace_check_exiting(p->common.id); - /* - * Setting the port to not busy here, frees the list of pending - * processes and makes them runnable. - */ - set_busy_port((ErlDrvPort) p, 0); + set_busy_port(ERTS_Port2ErlDrvPort(p), 0); if (p->common.u.alive.reg != NULL) (void) erts_unregister_name(NULL, 0, p, p->common.u.alive.reg->name); - state = erts_atomic32_read_bor_relb(&p->state, ERTS_PORT_SFLG_EXITING); - { SweepContext sc = {p->common.id, rreason}; lnk = ERTS_P_LINKS(p); @@ -4759,8 +4788,8 @@ set_busy_port(ErlDrvPort dprt, int on) ERTS_SMP_CHK_NO_PROC_LOCKS; - prt = erts_drvport2port_raw(dprt); - if (!prt) + prt = erts_drvport2port(dprt); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return; if (on) { @@ -4859,8 +4888,8 @@ erts_port_resume_procs(Port *prt) void set_port_control_flags(ErlDrvPort port_num, int flags) { - Port *prt = erts_drvport2port_raw(port_num); - if (prt) + Port *prt = erts_drvport2port(port_num); + if (prt != ERTS_INVALID_ERL_DRV_PORT) prt->control_flags = flags; } @@ -4870,8 +4899,8 @@ int get_port_flags(ErlDrvPort ix) Port *prt; erts_aint32_t state; - prt = erts_drvport2port(ix, &state); - if (!prt) + prt = erts_drvport2port_state(ix, &state); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return 0; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); @@ -4960,7 +4989,7 @@ erts_stale_drv_select(Eterm port, int deselect) { char *type; - ErlDrvPort drv_port = (ErlDrvPort) erts_port_lookup_raw(port); + ErlDrvPort drv_port = ERTS_Port2ErlDrvPort(erts_port_lookup_raw(port)); ErtsPortNames *pnp = erts_get_port_names(port); erts_dsprintf_buf_t *dsbufp; @@ -5082,7 +5111,6 @@ ErlDrvTermData driver_mk_term_nil(void) void driver_report_exit(ErlDrvPort ix, int status) { - Port* prt = erts_drvport2port(ix, NULL); Eterm* hp; Eterm tuple; Process *rp; @@ -5091,6 +5119,10 @@ void driver_report_exit(ErlDrvPort ix, int status) ErlOffHeap *ohp; ErtsProcLocks rp_locks = 0; int scheduler = erts_get_scheduler_id() != 0; + Port* prt = erts_drvport2port(ix); + + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return; ERTS_SMP_CHK_NO_PROC_LOCKS; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); @@ -5687,8 +5719,18 @@ deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p) #ifdef ERTS_SMP ErtsThrPrgrDelayHandle dhndl = erts_thr_progress_unmanaged_delay(); #endif + erts_aint32_t state; Port *prt = erts_port_lookup_raw((Eterm) port_id); - erts_aint32_t state = erts_atomic32_read_nob(&prt->state); + if (!prt) + return -1; + state = erts_atomic32_read_nob(&prt->state); + if (state & (ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP + | ERTS_PORT_SFLG_CLOSING)) { + if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) + return -1; + else + return 0; + } if (connected_p) { #ifdef ERTS_SMP if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED) @@ -5705,9 +5747,7 @@ deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p) ERTS_SMP_LC_ASSERT(dhndl == ERTS_THR_PRGR_DHANDLE_MANAGED ? erts_lc_is_port_locked(prt) : !erts_lc_is_port_locked(prt)); - return ((state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - ? -1 - : ((state & ERTS_PORT_SFLG_CLOSING) ? 0 : 1)); + return 1; } int erl_drv_output_term(ErlDrvTermData port_id, ErlDrvTermData* data, int len) @@ -5733,14 +5773,12 @@ driver_output_term(ErlDrvPort drvport, ErlDrvTermData* data, int len) ERTS_SMP_CHK_NO_PROC_LOCKS; /* NOTE! It *not* safe to access 'drvport' from unmanaged threads. */ - prt = erts_drvport2port(drvport, &state); - if (!prt) + prt = erts_drvport2port_state(drvport, &state); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; /* invalid (dead) */ ERTS_SMP_CHK_NO_PROC_LOCKS; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - return -1; - else if (state & ERTS_PORT_SFLG_CLOSING) + if (state & ERTS_PORT_SFLG_CLOSING) return 0; return driver_deliver_term(ERTS_PORT_GET_CONNECTED(prt), data, len); @@ -5780,13 +5818,11 @@ driver_send_term(ErlDrvPort drvport, #endif { erts_aint32_t state; - Port* prt = erts_drvport2port(drvport, &state); - if (!prt) + Port* prt = erts_drvport2port_state(drvport, &state); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; /* invalid (dead) */ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - return -1; - else if (state & ERTS_PORT_SFLG_CLOSING) + if (state & ERTS_PORT_SFLG_CLOSING) return 0; } return driver_deliver_term(to, data, len); @@ -5802,11 +5838,11 @@ int driver_output_binary(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen, ErlDrvBinary* bin, ErlDrvSizeT offs, ErlDrvSizeT len) { erts_aint32_t state; - Port* prt = erts_drvport2port(ix, &state); + Port* prt = erts_drvport2port_state(ix, &state); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if (state & ERTS_PORT_SFLG_CLOSING) @@ -5837,15 +5873,14 @@ int driver_output2(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen, char* buf, ErlDrvSizeT len) { erts_aint32_t state; - Port* prt = erts_drvport2port(ix, &state); + Port* prt = erts_drvport2port_state(ix, &state); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - if (state & ERTS_PORT_SFLG_CLOSING) return 0; @@ -5902,8 +5937,8 @@ int driver_outputv(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen, if (hlen < 0) hlen = 0; - prt = erts_drvport2port(ix, &state); - if (prt == NULL) + prt = erts_drvport2port_state(ix, &state); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); @@ -6179,8 +6214,8 @@ ErlDrvPDL driver_pdl_create(ErlDrvPort dp) { ErlDrvPDL pdl; - Port *pp = erts_drvport2port(dp, NULL); - if (!pp || pp->port_data_lock) + Port *pp = erts_drvport2port(dp); + if (pp == ERTS_INVALID_ERL_DRV_PORT || pp->port_data_lock) return NULL; pdl = erts_alloc(ERTS_ALC_T_PORT_DATA_LOCK, sizeof(struct erl_drv_port_data_lock)); @@ -6638,11 +6673,11 @@ drv_cancel_timer(Port *prt) int driver_set_timer(ErlDrvPort ix, unsigned long t) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; if (prt->drv_ptr->timeout == NULL) @@ -6665,8 +6700,8 @@ int driver_set_timer(ErlDrvPort ix, unsigned long t) int driver_cancel_timer(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); - if (prt == NULL) + Port* prt = erts_drvport2port(ix); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); drv_cancel_timer(prt); @@ -6677,11 +6712,11 @@ int driver_cancel_timer(ErlDrvPort ix) int driver_read_timer(ErlDrvPort ix, unsigned long* t) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); #ifdef ERTS_SMP @@ -6757,19 +6792,13 @@ int driver_monitor_process(ErlDrvPort drvport, { Port *prt; int ret; - erts_aint32_t state; #if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif prt = DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(drvport); - - state = erts_atomic32_read_nob(&prt->state); - - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) { - DRV_MONITOR_UNLOCK_PDL(prt); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; - } /* Now (in SMP) we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ @@ -6836,19 +6865,13 @@ int driver_demonitor_process(ErlDrvPort drvport, { Port *prt; int ret; - erts_aint32_t state; #if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif prt = DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(drvport); - - state = erts_atomic32_read_nob(&prt->state); - - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) { - DRV_MONITOR_UNLOCK_PDL(prt); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; - } /* Now we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ @@ -6897,18 +6920,13 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport, { Port *prt; ErlDrvTermData ret; - erts_aint32_t state; #if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif prt = DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(drvport); - - state = erts_atomic32_read_nob(&prt->state); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) { - DRV_MONITOR_UNLOCK_PDL(prt); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return driver_term_nil; - } /* Now we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ @@ -6981,11 +6999,11 @@ static int driver_failure_term(ErlDrvPort ix, Eterm term, int eof) { erts_aint32_t state; - Port* prt = erts_drvport2port(ix, &state); + Port* prt = erts_drvport2port_state(ix, &state); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if (eof) @@ -7014,14 +7032,14 @@ driver_failure_term(ErlDrvPort ix, Eterm term, int eof) */ int driver_exit(ErlDrvPort ix, int err) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); Process* rp; ErtsLink *lnk, *rlnk = NULL; Eterm connected; ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; connected = ERTS_PORT_GET_CONNECTED(prt); @@ -7095,16 +7113,18 @@ ErlDrvTermData driver_mk_atom(char* string) ErlDrvTermData driver_mk_port(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return (ErlDrvTermData) NIL; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); return (ErlDrvTermData) prt->common.id; } ErlDrvTermData driver_connected(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return NIL; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); return ERTS_PORT_GET_CONNECTED(prt); @@ -7112,9 +7132,9 @@ ErlDrvTermData driver_connected(ErlDrvPort ix) ErlDrvTermData driver_caller(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return NIL; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); return prt->caller; @@ -7122,17 +7142,15 @@ ErlDrvTermData driver_caller(ErlDrvPort ix) int driver_lock_driver(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); DE_Handle* dh; ERTS_SMP_CHK_NO_PROC_LOCKS; - erts_smp_rwmtx_rwlock(&erts_driver_list_lock); - - if (prt == NULL) { - erts_smp_rwmtx_rwunlock(&erts_driver_list_lock); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; - } + + erts_smp_rwmtx_rwlock(&erts_driver_list_lock); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if ((dh = (DE_Handle*)prt->drv_ptr->handle ) == NULL) { @@ -7327,7 +7345,7 @@ no_event_callback(ErlDrvData drv_data, ErlDrvEvent event, ErlDrvEventData event_ { Port *prt = get_current_port(); report_missing_drv_callback(prt, "Event", "event()"); - driver_event((ErlDrvPort) prt, event, NULL); + driver_event(ERTS_Port2ErlDrvPort(prt), event, NULL); } static void @@ -7335,7 +7353,7 @@ no_ready_input_callback(ErlDrvData drv_data, ErlDrvEvent event) { Port *prt = get_current_port(); report_missing_drv_callback(prt, "Input", "ready_input()"); - driver_select((ErlDrvPort) prt, event, + driver_select(ERTS_Port2ErlDrvPort(prt), event, (ERL_DRV_READ | ERL_DRV_USE_NO_CALLBACK), 0); } @@ -7344,7 +7362,7 @@ no_ready_output_callback(ErlDrvData drv_data, ErlDrvEvent event) { Port *prt = get_current_port(); report_missing_drv_callback(prt, "Output", "ready_output()"); - driver_select((ErlDrvPort) prt, event, + driver_select(ERTS_Port2ErlDrvPort(prt), event, (ERL_DRV_WRITE | ERL_DRV_USE_NO_CALLBACK), 0); } diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 249a9c05c2..9416a91480 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -1029,10 +1029,22 @@ char* win32_errorstr(int); #define ERL_FILENAME_UTF8_MAC (3) #define ERL_FILENAME_WIN_WCHAR (4) +/************************************************************************ + * If a filename in for example list_dir is not in the right encoding, it + * will be skipped in the resulting list, but depending on a startup setting + * we will inform the user in different ways. These macros define the + * different reactions to wrongly coded filenames. In the error case an + * exception will be thrown by prim_file. + ************************************************************************/ +#define ERL_FILENAME_WARNING_WARNING (0) +#define ERL_FILENAME_WARNING_IGNORE (1) +#define ERL_FILENAME_WARNING_ERROR (2) + int erts_get_native_filename_encoding(void); /* The set function is only to be used by erl_init! */ -void erts_set_user_requested_filename_encoding(int encoding); +void erts_set_user_requested_filename_encoding(int encoding, int warning); int erts_get_user_requested_filename_encoding(void); +int erts_get_filename_warning_type(void); void erts_init_sys_common_misc(void); diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index fda6cf2e53..22328fcd11 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -1160,7 +1160,14 @@ static void invoke_read_line(void *data) /* Need more place */ ErlDrvSizeT need = (d->c.read_line.read_size >= DEFAULT_LINEBUF_SIZE) ? d->c.read_line.read_size + DEFAULT_LINEBUF_SIZE : DEFAULT_LINEBUF_SIZE; - ErlDrvBinary *newbin = driver_alloc_binary(need); + ErlDrvBinary *newbin; +#if !ALWAYS_READ_LINE_AHEAD + /* Use read_ahead size if need does not exceed it */ + if (need < (d->c.read_line.binp)->orig_size && + d->c.read_line.read_ahead) + need = (d->c.read_line.binp)->orig_size; +#endif + newbin = driver_alloc_binary(need); if (newbin == NULL) { d->result_ok = 0; d->errInfo.posix_errno = ENOMEM; @@ -2263,6 +2270,8 @@ file_stop(ErlDrvData e) desc->fd = FILE_FD_INVALID; desc->flags = 0; cq_execute(desc); + } else { + EF_FREE(desc); } } else { if (desc->fd != FILE_FD_INVALID) { diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 3be821f8f7..af1c36777f 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -503,9 +503,7 @@ static int validate_unicode(Eterm arg) { if (is_not_small(arg) || arg > make_small(0x10FFFFUL) || - (make_small(0xD800UL) <= arg && arg <= make_small(0xDFFFUL)) || - arg == make_small(0xFFFEUL) || - arg == make_small(0xFFFFUL)) + (make_small(0xD800UL) <= arg && arg <= make_small(0xDFFFUL))) return 0; return 1; } diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 474408ae7c..c16831a07d 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -481,6 +481,7 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, int on) { void (*stop_select_fn)(ErlDrvEvent, void*) = NULL; + Port *prt = erts_drvport2port(ix); Eterm id = erts_drvport2id(ix); ErtsSysFdType fd = (ErtsSysFdType) e; ErtsPollEvents ctl_events = (ErtsPollEvents) 0; @@ -491,9 +492,11 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, #ifdef USE_VM_PROBES DTRACE_CHARBUF(name, 64); #endif - - ERTS_SMP_LC_ASSERT(erts_drvport2port(ix, NULL) - && erts_lc_is_port_locked(erts_drvport2port(ix, NULL))); + + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return -1; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS if ((unsigned)fd >= (unsigned)erts_smp_atomic_read_nob(&drv_ev_state_len)) { @@ -519,9 +522,9 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, if (!on && (mode&ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) { if (IS_FD_UNKNOWN(state)) { /* fast track to stop_select callback */ - stop_select_fn = erts_drvport2port(ix, NULL)->drv_ptr->stop_select; + stop_select_fn = prt->drv_ptr->stop_select; #ifdef USE_VM_PROBES - strncpy(name, erts_drvport2port(ix, NULL)->drv_ptr->name, sizeof(name)-1); + strncpy(name, prt->drv_ptr->name, sizeof(name)-1); name[sizeof(name)-1] = '\0'; #endif ret = 0; @@ -654,14 +657,14 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, } } if ((mode & ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) { - erts_driver_t* drv_ptr = erts_drvport2port(ix, NULL)->drv_ptr; + erts_driver_t* drv_ptr = prt->drv_ptr; ASSERT(new_events==0); if (state->remove_cnt == 0 || !wake_poller) { /* Safe to close fd now as it is not in pollset or there was no need to eject fd (kernel poll) */ stop_select_fn = drv_ptr->stop_select; #ifdef USE_VM_PROBES - strncpy(name, erts_drvport2port(ix, NULL)->drv_ptr->name, sizeof(name)-1); + strncpy(name, prt->drv_ptr->name, sizeof(name)-1); name[sizeof(name)-1] = '\0'; #endif } @@ -712,9 +715,12 @@ ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix, ErtsDrvEventState *state; int do_wake = 0; int ret; + Port *prt = erts_drvport2port(ix); + + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return -1; - ERTS_SMP_LC_ASSERT(erts_drvport2port(ix, NULL) - && erts_lc_is_port_locked(erts_drvport2port(ix, NULL))); + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS if ((unsigned)fd >= (unsigned)erts_smp_atomic_read_nob(&drv_ev_state_len)) { @@ -949,7 +955,7 @@ static void print_select_op(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix, ErtsSysFdType fd, int mode, int on) { - Port *pp = erts_drvport2port(ix, NULL); + Port *pp = erts_drvport2port(ix); erts_dsprintf(dsbufp, "driver_select(%p, %d,%s%s%s%s, %d) " "by ", @@ -960,8 +966,8 @@ print_select_op(erts_dsprintf_buf_t *dsbufp, mode & ERL_DRV_USE ? " ERL_DRV_USE" : "", mode & (ERL_DRV_USE_NO_CALLBACK & ~ERL_DRV_USE) ? "_NO_CALLBACK" : "", on); - print_driver_name(dsbufp, pp->common.id); - erts_dsprintf(dsbufp, "driver %T ", pp ? pp->common.id : NIL); + print_driver_name(dsbufp, pp != ERTS_INVALID_ERL_DRV_PORT ? pp->common.id : NIL); + erts_dsprintf(dsbufp, "driver %T ", pp != ERTS_INVALID_ERL_DRV_PORT ? pp->common.id : NIL); } static void @@ -1020,8 +1026,9 @@ steal_pending_stop_select(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix, state->driver.drv_ptr = NULL; } else if ((mode & ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) { - erts_driver_t* drv_ptr = erts_drvport2port(ix, NULL)->drv_ptr; - if (drv_ptr != state->driver.drv_ptr) { + Port *prt = erts_drvport2port(ix); + erts_driver_t* drv_ptr = prt != ERTS_INVALID_ERL_DRV_PORT ? prt->drv_ptr : NULL; + if (drv_ptr && drv_ptr != state->driver.drv_ptr) { /* Some other driver wants the stop_select callback */ if (state->driver.drv_ptr->handle) { erts_ddll_dereference_driver(state->driver.drv_ptr->handle); @@ -1042,7 +1049,7 @@ static void print_event_op(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data) { - Port *pp = erts_drvport2port(ix, NULL); + Port *pp = erts_drvport2port(ix); erts_dsprintf(dsbufp, "driver_event(%p, %d, ", ix, (int) fd); if (!event_data) erts_dsprintf(dsbufp, "NULL"); @@ -1051,8 +1058,9 @@ print_event_op(erts_dsprintf_buf_t *dsbufp, (unsigned int) event_data->events, (unsigned int) event_data->revents); erts_dsprintf(dsbufp, ") by "); - print_driver_name(dsbufp, pp->common.id); - erts_dsprintf(dsbufp, "driver %T ", pp ? pp->common.id : NIL); + if (pp != ERTS_INVALID_ERL_DRV_PORT) + print_driver_name(dsbufp, pp->common.id); + erts_dsprintf(dsbufp, "driver %T ", pp != ERTS_INVALID_ERL_DRV_PORT ? pp->common.id : NIL); } static void diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index 538eea88d1..bd8ba82a5f 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -39,6 +39,7 @@ #include "erl_alloc.h" #include "big.h" #include "erl_thr_progress.h" +#include "erl_util_queue.h" #if HAVE_ERTS_MSEG @@ -175,6 +176,7 @@ struct cache_t_ { Uint size; void *seg; cache_t *next; + cache_t *prev; }; @@ -183,9 +185,9 @@ typedef struct ErtsMsegAllctr_t_ ErtsMsegAllctr_t; struct mem_kind_t { cache_t cache[MAX_CACHE_SIZE]; - cache_t *cache_unpowered; - cache_t *cache_area[CACHE_AREAS]; - cache_t *cache_free; + cache_t cache_unpowered_node; + cache_t cache_powered_node[CACHE_AREAS]; + cache_t cache_free; Sint cache_size; Uint cache_hits; @@ -516,67 +518,94 @@ do { \ #define ERTS_DBG_MK_CHK_THR_ACCESS(MK) #endif -/* NEW CACHE interface */ +/* Cache interface */ -static ERTS_INLINE cache_t *mseg_cache_alloc_descriptor(MemKind *mk) { - cache_t *c = mk->cache_free; - ERTS_DBG_MK_CHK_THR_ACCESS(mk); - if (c) - mk->cache_free = c->next; - - return c; -} - -static ERTS_INLINE void mseg_cache_free_descriptor(MemKind *mk, cache_t *c) { - ERTS_DBG_MK_CHK_THR_ACCESS(mk); - ASSERT(c); - - c->seg = NULL; +static ERTS_INLINE void mseg_cache_clear_node(cache_t *c) { + c->seg = NULL; c->size = 0; - c->next = mk->cache_free; - mk->cache_free = c; + c->next = c; + c->prev = c; } -static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size) { +static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size, Uint flags) { cache_t *c; ERTS_DBG_MK_CHK_THR_ACCESS(mk); - if (mk->cache_free && MAP_IS_ALIGNED(seg)) { - if (IS_2POW(size)) { + ASSERT(!MSEG_FLG_IS_2POW(flags) || (MSEG_FLG_IS_2POW(flags) && MAP_IS_ALIGNED(seg) && IS_2POW(size))); + + /* The idea is that sbc caching is prefered over mbc caching. + * Blocks are normally allocated in mb carriers and thus cached there. + * Large blocks has no such cache and it is up to mseg to cache them to speed things up. + */ + + if (!erts_circleq_is_empty(&(mk->cache_free))) { + + /* We have free slots, use one to cache the segment */ + + c = erts_circleq_head(&(mk->cache_free)); + erts_circleq_remove(c); + + c->seg = seg; + c->size = size; + + if (MSEG_FLG_IS_2POW(flags)) { int ix = SIZE_TO_CACHE_AREA_IDX(size); ASSERT(ix < CACHE_AREAS); ASSERT((1 << (ix + MSEG_ALIGN_BITS)) == size); - /* unlink from free cache list */ - c = mseg_cache_alloc_descriptor(mk); + erts_circleq_push_head(&(mk->cache_powered_node[ix]), c); - /* link to cache area */ - c->seg = seg; - c->size = size; - c->next = mk->cache_area[ix]; + } else + erts_circleq_push_head(&(mk->cache_unpowered_node), c); - mk->cache_area[ix] = c; - mk->cache_size++; + mk->cache_size++; + ASSERT(mk->cache_size <= mk->ma->max_cache_size); - ASSERT(mk->cache_size <= mk->ma->max_cache_size); + return 1; + } else if (!MSEG_FLG_IS_2POW(flags) && !erts_circleq_is_empty(&(mk->cache_unpowered_node))) { - return 1; - } else { - /* unlink from free cache list */ - c = mseg_cache_alloc_descriptor(mk); + /* No free slots. + * Evict oldest slot from unpowered cache so we can cache an unpowered (sbc) segment */ + + c = erts_circleq_tail(&(mk->cache_unpowered_node)); + erts_circleq_remove(c); + + mseg_destroy(mk->ma, mk, c->seg, c->size); + mseg_cache_clear_node(c); + + c->seg = seg; + c->size = size; + + erts_circleq_push_head(&(mk->cache_unpowered_node), c); + + return 1; + } else if (!MSEG_FLG_IS_2POW(flags)) { + + /* No free slots and no unpowered (sbc) slots. + * Evict smallest slot from powered cache so we can cache an unpowered (sbc) segment. + * Note: Though this is the wanted policy I don't think it is used significantly. + * This branch could probably be removed without serious impact. + */ + + int i; + + for( i = 0; i < CACHE_AREAS; i++) { + if (erts_circleq_is_empty(&(mk->cache_powered_node[i]))) + continue; + + c = erts_circleq_tail(&(mk->cache_powered_node[i])); + erts_circleq_remove(c); + + mseg_destroy(mk->ma, mk, c->seg, c->size); + mseg_cache_clear_node(c); - /* link to cache area */ c->seg = seg; c->size = size; - c->next = mk->cache_unpowered; - - mk->cache_unpowered = c; - mk->cache_size++; - ASSERT(mk->cache_size <= mk->ma->max_cache_size); + erts_circleq_push_head(&(mk->cache_unpowered_node), c); return 1; } @@ -585,90 +614,110 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size) { return 0; } -static ERTS_INLINE void *cache_get_segment(MemKind *mk, Uint *size_p) { +static ERTS_INLINE void *cache_get_segment(MemKind *mk, Uint *size_p, Uint flags) { Uint size = *size_p; ERTS_DBG_MK_CHK_THR_ACCESS(mk); - if (IS_2POW(size)) { + + if (MSEG_FLG_IS_2POW(flags)) { int i, ix = SIZE_TO_CACHE_AREA_IDX(size); void *seg; cache_t *c; Uint csize; + ASSERT(IS_2POW(size)); + for( i = ix; i < CACHE_AREAS; i++) { - if ((c = mk->cache_area[i]) == NULL) + if (erts_circleq_is_empty(&(mk->cache_powered_node[i]))) continue; + c = erts_circleq_head(&(mk->cache_powered_node[i])); + erts_circleq_remove(c); + ASSERT(IS_2POW(c->size)); + ASSERT(MAP_IS_ALIGNED(c->seg)); + + csize = c->size; + seg = c->seg; - /* unlink from cache area */ - csize = c->size; - seg = c->seg; - mk->cache_area[i] = c->next; - c->next = NULL; mk->cache_size--; mk->cache_hits++; /* link to free cache list */ - mseg_cache_free_descriptor(mk, c); + mseg_cache_clear_node(c); + erts_circleq_push_head(&(mk->cache_free), c); ASSERT(!(mk->cache_size < 0)); - /* divvy up the cache - if needed */ - while( i > ix) { - csize = csize >> 1; - /* try to cache half of it */ - if (!cache_bless_segment(mk, (char *)seg + csize, csize)) { - /* wouldn't cache .. destroy it instead */ - mseg_destroy(mk->ma, mk, (char *)seg + csize, csize); - } - i--; + if (csize != size) { + mseg_destroy(mk->ma, mk, (char *)seg + size, csize - size); } - ASSERT(csize == size); + return seg; } } - else if (mk->cache_unpowered) { + else if (!erts_circleq_is_empty(&(mk->cache_unpowered_node))) { void *seg; - cache_t *c, *pc; + cache_t *c; + cache_t *best = NULL; + Uint bdiff = 0; Uint csize; Uint bad_max_abs = mk->ma->abs_max_cache_bad_fit; Uint bad_max_rel = mk->ma->rel_max_cache_bad_fit; - c = mk->cache_unpowered; - pc = c; - - while (c) { + erts_circleq_foreach(c, &(mk->cache_unpowered_node)) { csize = c->size; - if (csize >= size && - ((csize - size)*100 < bad_max_rel*size) && - (csize - size) < bad_max_abs ) { + if (csize >= size) { + if (((csize - size)*100 < bad_max_rel*size) && (csize - size) < bad_max_abs ) { - /* unlink from cache area */ - seg = c->seg; + seg = c->seg; - if (pc == c) { - mk->cache_unpowered = c->next; - } else { - pc->next = c->next; - } + erts_circleq_remove(c); + + mk->cache_size--; + mk->cache_hits++; - c->next = NULL; - mk->cache_size--; - mk->cache_hits++; + mseg_cache_clear_node(c); + erts_circleq_push_head(&(mk->cache_free), c); - /* link to free cache list */ - mseg_cache_free_descriptor(mk, c); - *size_p = csize; + *size_p = csize; - return seg; + return seg; + + } else if (!best || (csize - size) < bdiff) { + best = c; + bdiff = csize - size; + } } + } + + /* No cached segment met our criteria, use the best one found and trim it */ + + if (best) { + + seg = best->seg; + csize = best->size; + + ASSERT(best->seg); + ASSERT(best->size > 0); + + mk->cache_hits++; + + /* Use current cache placement for remaining segment space */ + + best->seg = seg + size; + best->size = csize - size; + + ASSERT((size % GET_PAGE_SIZE) == 0); + ASSERT((best->size % GET_PAGE_SIZE) == 0); + + *size_p = size; + + return seg; - pc = c; - c = c->next; } } return NULL; @@ -679,20 +728,18 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, Uint *size_p) { * using callbacks from aux-work in the scheduler. */ -static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, cache_t **head) { +static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, cache_t *head) { cache_t *c = NULL; - c = *head; - - ASSERT( c != NULL ); - - *head = c->next; + c = erts_circleq_tail(head); + erts_circleq_remove(c); if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg); mseg_destroy(mk->ma, mk, c->seg, c->size); - mseg_cache_free_descriptor(mk, c); + mseg_cache_clear_node(c); + erts_circleq_push_head(&(mk->cache_free), c); mk->segments.current.watermark--; mk->cache_size--; @@ -702,30 +749,27 @@ static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, cache_t ** return mk->cache_size; } -static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, cache_t **head) { - cache_t *c = NULL, *next = NULL; - - c = *head; - ASSERT( c != NULL ); +static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, cache_t *head) { + cache_t *c = NULL; - while (c) { + while (!erts_circleq_is_empty(head)) { - next = c->next; + c = erts_circleq_tail(head); + erts_circleq_remove(c); if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg); mseg_destroy(mk->ma, mk, c->seg, c->size); - mseg_cache_free_descriptor(mk, c); + + mseg_cache_clear_node(c); + erts_circleq_push_head(&(mk->cache_free), c); mk->segments.current.watermark--; mk->cache_size--; - c = next; } - *head = NULL; - ASSERT( mk->cache_size >= 0 ); return mk->cache_size; @@ -743,12 +787,12 @@ static Uint mseg_check_memkind_cache(MemKind *mk) { ERTS_DBG_MK_CHK_THR_ACCESS(mk); for (i = 0; i < CACHE_AREAS; i++) { - if (mk->cache_area[i] != NULL) - return mseg_drop_one_memkind_cache_size(mk, &(mk->cache_area[i])); + if (!erts_circleq_is_empty(&(mk->cache_powered_node[i]))) + return mseg_drop_one_memkind_cache_size(mk, &(mk->cache_powered_node[i])); } - if (mk->cache_unpowered) - return mseg_drop_one_memkind_cache_size(mk, &(mk->cache_unpowered)); + if (!erts_circleq_is_empty(&(mk->cache_unpowered_node))) + return mseg_drop_one_memkind_cache_size(mk, &(mk->cache_unpowered_node)); return 0; } @@ -804,17 +848,17 @@ static void mseg_clear_memkind_cache(MemKind *mk) { /* drop pow2 caches */ for (i = 0; i < CACHE_AREAS; i++) { - if (mk->cache_area[i] == NULL) + if (erts_circleq_is_empty(&(mk->cache_powered_node[i]))) continue; - mseg_drop_memkind_cache_size(mk, &(mk->cache_area[i])); - ASSERT(mk->cache_area[i] == NULL); + mseg_drop_memkind_cache_size(mk, &(mk->cache_powered_node[i])); + ASSERT(erts_circleq_is_empty(&(mk->cache_powered_node[i]))); } /* drop varied caches */ - if(mk->cache_unpowered) - mseg_drop_memkind_cache_size(mk, &(mk->cache_unpowered)); + if (!erts_circleq_is_empty(&(mk->cache_unpowered_node))) + mseg_drop_memkind_cache_size(mk, &(mk->cache_unpowered_node)); - ASSERT(mk->cache_unpowered == NULL); + ASSERT(erts_circleq_is_empty(&(mk->cache_unpowered_node))); ASSERT(mk->cache_size == 0); } @@ -873,7 +917,7 @@ mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, Uint *size_p, ma->min_seg_size = size; #endif - if (opt->cache && mk->cache_size > 0 && (seg = cache_get_segment(mk, &size)) != NULL) + if (opt->cache && mk->cache_size > 0 && (seg = cache_get_segment(mk, &size, flags)) != NULL) goto done; if ((seg = mseg_create(ma, mk, size)) == NULL) @@ -894,14 +938,13 @@ done: static void mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, Uint size, - const ErtsMsegOpt_t *opt) + Uint flags, const ErtsMsegOpt_t *opt) { MemKind* mk = memkind(ma, opt); - ERTS_MSEG_DEALLOC_STAT(mk,size); - if (opt->cache && cache_bless_segment(mk, seg, size)) { + if (opt->cache && cache_bless_segment(mk, seg, size, flags)) { schedule_cache_check(ma); goto done; } @@ -934,7 +977,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, /* Dealloc old segment if new segment is of size 0 */ if (!(*new_size_p)) { - mseg_dealloc(ma, atype, seg, old_size, opt); + mseg_dealloc(ma, atype, seg, old_size, flags, opt); DEC_CC(ma, dealloc); return NULL; } @@ -993,7 +1036,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, else { if (!opt->preserv) { - mseg_dealloc(ma, atype, seg, old_size, opt); + mseg_dealloc(ma, atype, seg, old_size, flags, opt); new_seg = mseg_alloc(ma, atype, &new_size, flags, opt); ASSERT(MAP_IS_ALIGNED(new_seg) || !new_seg); } @@ -1020,7 +1063,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, new_size = old_size; else { sys_memcpy(((char *) new_seg), ((char *) seg), MIN(new_size, old_size)); - mseg_dealloc(ma, atype, seg, old_size, opt); + mseg_dealloc(ma, atype, seg, old_size, flags, opt); } #endif } @@ -1497,19 +1540,19 @@ erts_mseg_alloc(ErtsAlcType_t atype, Uint *size_p, Uint flags) void erts_mseg_dealloc_opt(ErtsAlcType_t atype, void *seg, - Uint size, const ErtsMsegOpt_t *opt) + Uint size, Uint flags, const ErtsMsegOpt_t *opt) { ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt); ERTS_MSEG_LOCK(ma); ERTS_DBG_MA_CHK_THR_ACCESS(ma); - mseg_dealloc(ma, atype, seg, size, opt); + mseg_dealloc(ma, atype, seg, size, flags, opt); ERTS_MSEG_UNLOCK(ma); } void -erts_mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size) +erts_mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size, Uint flags) { - erts_mseg_dealloc_opt(atype, seg, size, &erts_mseg_default_opt); + erts_mseg_dealloc_opt(atype, seg, size, flags, &erts_mseg_default_opt); } void * @@ -1556,27 +1599,28 @@ erts_mseg_unit_size(void) return MSEG_ALIGNED_SIZE; } + static void mem_kind_init(ErtsMsegAllctr_t *ma, MemKind* mk, const char* name) { int i; + /* Clear all cache headers */ + mseg_cache_clear_node(&(mk->cache_free)); + mseg_cache_clear_node(&(mk->cache_unpowered_node)); + for (i = 0; i < CACHE_AREAS; i++) { - mk->cache_area[i] = NULL; + mseg_cache_clear_node(&(mk->cache_powered_node[i])); } - mk->cache_free = NULL; + /* Populate cache free list */ ASSERT(ma->max_cache_size <= MAX_CACHE_SIZE); for (i = 0; i < ma->max_cache_size; i++) { - mk->cache[i].seg = NULL; - mk->cache[i].size = 0; - mk->cache[i].next = mk->cache_free; - mk->cache_free = &(mk->cache[i]); + mseg_cache_clear_node(&(mk->cache[i])); + erts_circleq_push_head(&(mk->cache_free), &(mk->cache[i])); } - mk->cache_unpowered = NULL; - mk->cache_size = 0; mk->cache_hits = 0; @@ -1594,9 +1638,6 @@ static void mem_kind_init(ErtsMsegAllctr_t *ma, MemKind* mk, const char* name) ma->mk_list = mk; } - - - void erts_mseg_init(ErtsMsegInit_t *init) { @@ -1721,7 +1762,7 @@ erts_mseg_test(unsigned long op, case 0x401: return (unsigned long) erts_mseg_alloc(ERTS_ALC_A_INVALID, (Uint *) a1, (Uint) 0); case 0x402: - erts_mseg_dealloc(ERTS_ALC_A_INVALID, (void *) a1, (Uint) a2); + erts_mseg_dealloc(ERTS_ALC_A_INVALID, (void *) a1, (Uint) a2, (Uint) 0); return (unsigned long) 0; case 0x403: return (unsigned long) erts_mseg_realloc(ERTS_ALC_A_INVALID, diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h index 3d0b0f0355..3cab9e18da 100644 --- a/erts/emulator/sys/common/erl_mseg.h +++ b/erts/emulator/sys/common/erl_mseg.h @@ -74,7 +74,7 @@ typedef struct { { \ 4*1024*1024, /* amcbf: Absolute max cache bad fit */ \ 20, /* rmcbf: Relative max cache bad fit */ \ - 5, /* mcs: Max cache size */ \ + 10, /* mcs: Max cache size */ \ 1000 /* cci: Cache check interval */ \ } @@ -93,11 +93,10 @@ extern const ErtsMsegOpt_t erts_mseg_default_opt; void *erts_mseg_alloc(ErtsAlcType_t, Uint *, Uint); void *erts_mseg_alloc_opt(ErtsAlcType_t, Uint *, Uint, const ErtsMsegOpt_t *); -void erts_mseg_dealloc(ErtsAlcType_t, void *, Uint); -void erts_mseg_dealloc_opt(ErtsAlcType_t, void *, Uint, const ErtsMsegOpt_t *); +void erts_mseg_dealloc(ErtsAlcType_t, void *, Uint, Uint); +void erts_mseg_dealloc_opt(ErtsAlcType_t, void *, Uint, Uint, const ErtsMsegOpt_t *); void *erts_mseg_realloc(ErtsAlcType_t, void *, Uint, Uint *, Uint); -void *erts_mseg_realloc_opt(ErtsAlcType_t, void *, Uint, Uint *, - Uint, const ErtsMsegOpt_t *); +void *erts_mseg_realloc_opt(ErtsAlcType_t, void *, Uint, Uint *, Uint, const ErtsMsegOpt_t *); void erts_mseg_clear_cache(void); void erts_mseg_cache_check(void); Uint erts_mseg_no( const ErtsMsegOpt_t *); diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c index 1bf5fa89f4..0b31c125e5 100644 --- a/erts/emulator/sys/common/erl_sys_common_misc.c +++ b/erts/emulator/sys/common/erl_sys_common_misc.c @@ -47,14 +47,16 @@ /* Written once and only once */ static int filename_encoding = ERL_FILENAME_UNKNOWN; +static int filename_warning = ERL_FILENAME_WARNING_WARNING; #if defined(__WIN32__) || defined(__DARWIN__) static int user_filename_encoding = ERL_FILENAME_UTF8; /* Default unicode on windows */ #else static int user_filename_encoding = ERL_FILENAME_LATIN1; #endif -void erts_set_user_requested_filename_encoding(int encoding) +void erts_set_user_requested_filename_encoding(int encoding, int warning) { user_filename_encoding = encoding; + filename_warning = warning; } int erts_get_user_requested_filename_encoding(void) @@ -62,6 +64,11 @@ int erts_get_user_requested_filename_encoding(void) return user_filename_encoding; } +int erts_get_filename_warning_type(void) +{ + return filename_warning; +} + void erts_init_sys_common_misc(void) { #if defined(__WIN32__) @@ -107,9 +114,9 @@ int erts_get_native_filename_encoding(void) } /* For internal use by sys_double_to_chars_fast() */ -static char* float_first_trailing_zero(char* p) +static char* find_first_trailing_zero(char* p) { - for (--p; *p == '0' && *(p-1) == '0'; --p); + for (; *(p-1) == '0'; --p); if (*(p-1) == '.') ++p; return p; } @@ -120,34 +127,83 @@ sys_double_to_chars(double fp, char *buffer, size_t buffer_size) return sys_double_to_chars_ext(fp, buffer, buffer_size, SYS_DEFAULT_FLOAT_DECIMALS); } +/* Convert float to string using fixed point notation. + * decimals must be >= 0 + * if compact != 0, the trailing 0's will be truncated + */ int -sys_double_to_chars_fast(double f, char *outbuf, int maxlen, int decimals, int compact) +sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, + int compact) { - enum { - FRAC_SIZE = 52 - , EXP_SIZE = 11 - , EXP_MASK = (1ll << EXP_SIZE) - 1 - , FRAC_MASK = (1ll << FRAC_SIZE) - 1 - , FRAC_MASK2 = (1ll << (FRAC_SIZE + 1)) - 1 - , MAX_FLOAT = 1ll << (FRAC_SIZE+1) + /* Note that some C compilers don't support "static const" propagation + * so we use a defines */ + #define SYS_DOUBLE_RND_CONST 0.55555555555555555 + #define FRAC_SIZE 52 + #define EXP_SIZE 11 + #define EXP_MASK ((1ll << EXP_SIZE) - 1) + #define MAX_DECIMALS (sizeof(cs_sys_double_pow10) \ + / sizeof(cs_sys_double_pow10[0])) + #define FRAC_MASK ((1ll << FRAC_SIZE) - 1) + #define FRAC_MASK2 ((1ll << (FRAC_SIZE + 1)) - 1) + #define MAX_FLOAT (1ll << (FRAC_SIZE+1)) + + static const double cs_sys_double_pow10[] = { + SYS_DOUBLE_RND_CONST / 1ll, + SYS_DOUBLE_RND_CONST / 10ll, + SYS_DOUBLE_RND_CONST / 100ll, + SYS_DOUBLE_RND_CONST / 1000ll, + SYS_DOUBLE_RND_CONST / 10000ll, + SYS_DOUBLE_RND_CONST / 100000ll, + SYS_DOUBLE_RND_CONST / 1000000ll, + SYS_DOUBLE_RND_CONST / 10000000ll, + SYS_DOUBLE_RND_CONST / 100000000ll, + SYS_DOUBLE_RND_CONST / 1000000000ll, + SYS_DOUBLE_RND_CONST / 10000000000ll, + SYS_DOUBLE_RND_CONST / 100000000000ll, + SYS_DOUBLE_RND_CONST / 1000000000000ll, + SYS_DOUBLE_RND_CONST / 10000000000000ll, + SYS_DOUBLE_RND_CONST / 100000000000000ll, + SYS_DOUBLE_RND_CONST / 1000000000000000ll, + SYS_DOUBLE_RND_CONST / 10000000000000000ll, + SYS_DOUBLE_RND_CONST / 100000000000000000ll, + SYS_DOUBLE_RND_CONST / 1000000000000000000ll }; - long long mantissa, int_part, int_part2, frac_part; + long long mantissa, int_part = 0, frac_part = 0; short exp; - int sign, i, n, m, max; - double absf; + int max; + int neg; + double fr; union { long long L; double F; } x; - char c, *p = outbuf; - int digit, roundup; + char *p = buffer; + + if (decimals < 0) + return -1; - x.F = f; + /* Round the number to given decimal places. The number of 5's in the + * SYS_DOUBLE_RND_CONST constant is chosen such that adding any more 5's doesn't + * change the double precision of the number, i.e.: + * 1> term_to_binary(0.55555555555555555, [{minor_version, 1}]). + * <<131,70,63,225,199,28,113,199,28,114>> + * 2> term_to_binary(0.5555555555555555555, [{minor_version, 1}]). + * <<131,70,63,225,199,28,113,199,28,114>> + */ + if (f >= 0) { + neg = 0; + fr = decimals < MAX_DECIMALS ? (f + cs_sys_double_pow10[decimals]) : f; + x.F = fr; + } else { + neg = 1; + fr = decimals < MAX_DECIMALS ? (f - cs_sys_double_pow10[decimals]) : f; + x.F = -fr; + } exp = (x.L >> FRAC_SIZE) & EXP_MASK; mantissa = x.L & FRAC_MASK; - sign = x.L >= 0 ? 1 : -1; + if (exp == EXP_MASK) { if (mantissa == 0) { - if (sign == -1) + if (neg) *p++ = '-'; *p++ = 'i'; *p++ = 'n'; @@ -158,101 +214,79 @@ sys_double_to_chars_fast(double f, char *outbuf, int maxlen, int decimals, int c *p++ = 'n'; } *p = '\0'; - return p - outbuf; + return p - buffer; } exp -= EXP_MASK >> 1; mantissa |= (1ll << FRAC_SIZE); - frac_part = 0; - int_part = 0; - absf = f * sign; - - /* Don't bother with optimizing too large numbers and decimals */ - if (absf > MAX_FLOAT || decimals > maxlen-17) { - int len = erts_snprintf(outbuf, maxlen, "%.*f", decimals, f); - if (len >= maxlen) + + /* Don't bother with optimizing too large numbers or too large precision */ + if (x.F > MAX_FLOAT || decimals >= MAX_DECIMALS) { + int len = erts_snprintf(buffer, buffer_size, "%.*f", decimals, f); + char* p = buffer + len; + if (len >= buffer_size) return -1; - p = outbuf + len; /* Delete trailing zeroes */ if (compact) - p = float_first_trailing_zero(outbuf + len); + p = find_first_trailing_zero(p); *p = '\0'; - return p - outbuf; - } - - if (exp >= FRAC_SIZE) + return p - buffer; + } else if (exp >= FRAC_SIZE) { int_part = mantissa << (exp - FRAC_SIZE); - else if (exp >= 0) { + } else if (exp >= 0) { int_part = mantissa >> (FRAC_SIZE - exp); frac_part = (mantissa << (exp + 1)) & FRAC_MASK2; - } - else /* if (exp < 0) */ + } else /* if (exp < 0) */ { frac_part = (mantissa & FRAC_MASK2) >> -(exp + 1); + } - if (int_part == 0) { - if (sign == -1) + if (!int_part) { + if (neg) *p++ = '-'; *p++ = '0'; } else { - int ret; + int ret, i, n; while (int_part != 0) { - int_part2 = int_part / 10; - *p++ = (char)(int_part - ((int_part2 << 3) + (int_part2 << 1)) + '0'); - int_part = int_part2; + long long j = int_part / 10; + *p++ = (char)(int_part - ((j << 3) + (j << 1)) + '0'); + int_part = j; } - if (sign == -1) + if (neg) *p++ = '-'; /* Reverse string */ - ret = p - outbuf; + ret = p - buffer; for (i = 0, n = ret/2; i < n; i++) { - int j = ret - i - 1; - c = outbuf[i]; - outbuf[i] = outbuf[j]; - outbuf[j] = c; + int j = ret - i - 1; + char c = buffer[i]; + buffer[i] = buffer[j]; + buffer[j] = c; } } - if (decimals != 0) + + if (decimals > 0) { + int i; *p++ = '.'; - max = maxlen - (p - outbuf) - 1 /* leave room for trailing '\0' */; - if (max > decimals) + max = buffer_size - (p - buffer) - 1 /* leave room for trailing '\0' */; + + if (decimals > max) + return -1; /* the number is not large enough to fit in the buffer */ + max = decimals; - for (m = 0; m < max; m++) { - /* frac_part *= 10; */ - frac_part = (frac_part << 3) + (frac_part << 1); - *p++ = (char)((frac_part >> (FRAC_SIZE + 1)) + '0'); - frac_part &= FRAC_MASK2; - } + for (i = 0; i < max; i++) { + /* frac_part *= 10; */ + frac_part = (frac_part << 3) + (frac_part << 1); - roundup = 0; - /* Rounding - look at the next digit */ - frac_part = (frac_part << 3) + (frac_part << 1); - digit = (frac_part >> (FRAC_SIZE + 1)); - if (digit > 5) - roundup = 1; - else if (digit == 5) { - frac_part &= FRAC_MASK2; - if (frac_part != 0) roundup = 1; - } - if (roundup) { - char d; - int pos = p - outbuf - 1; - do { - d = outbuf[pos]; - if (d == '-') break; - if (d == '.') continue; - if (++d != ':') { - outbuf[pos] = d; - break; - } - outbuf[pos] = '0'; - } while (--pos); + *p++ = (char)((frac_part >> (FRAC_SIZE + 1)) + '0'); + frac_part &= FRAC_MASK2; + } + + /* Delete trailing zeroes */ + if (compact) + p = find_first_trailing_zero(p); } - /* Delete trailing zeroes */ - if (compact && *(p - 1) == '0') - p = float_first_trailing_zero(--p); *p = '\0'; - return p - outbuf; + return p - buffer; } diff --git a/erts/emulator/sys/common/erl_util_queue.h b/erts/emulator/sys/common/erl_util_queue.h new file mode 100644 index 0000000000..47925e2264 --- /dev/null +++ b/erts/emulator/sys/common/erl_util_queue.h @@ -0,0 +1,77 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2013. 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% + */ + +#ifndef ERL_UTIL_QUEUE_H_ +#define ERL_UTIL_QUEUE_H_ + +#define erts_circleq_head(Q) ((Q)->next) +#define erts_circleq_tail(Q) ((Q)->prev) +#define erts_circleq_next(Q) ((Q)->next) +#define erts_circleq_prev(Q) ((Q)->prev) +#define erts_circleq_is_empty(Q) ((Q)->next == (void *)(Q)) + +#define erts_circleq_remove(N) \ + do { \ + (N)->next->prev = (N)->prev; \ + (N)->prev->next = (N)->next; \ + (N)->next = (N); \ + (N)->prev = (N); \ + } while(0) + +#define erts_circleq_pop_head(Q, N) \ + do { \ + (N) = (Q)->next; \ + (N)->next->prev = (N)->prev; \ + (N)->prev->next = (N)->next; \ + (N)->next = (N); \ + (N)->prev = (N); \ + } while(0) + +#define erts_circleq_pop_tail(Q, N) \ + do { \ + (N) = (Q)->prev; \ + (N)->next->prev = (N)->prev; \ + (N)->prev->next = (N)->next; \ + (N)->next = (N); \ + (N)->prev = (N); \ + } while(0) + +#define erts_circleq_push_head(Q, N) \ + do { \ + (N)->next = (Q)->next; \ + (N)->prev = (void *)(Q); \ + (Q)->next->prev = (N); \ + (Q)->next = (N); \ + } while(0) + +#define erts_circleq_push_tail(Q, N) \ + do { \ + (N)->prev = (Q)->prev; \ + (N)->next = (void *)(Q); \ + (Q)->prev->next = (N); \ + (Q)->prev = (N); \ + } while(0) + +#define erts_circleq_foreach(V, Q) \ + for ((V) = (Q)->next; (V) != (const void *)(Q); (V) = (V)->next) + +#define erts_circleq_foreach_reverse(V, Q) \ + for ((V) = (Q)->prev; (V) != (const void *)(Q); (V) = (V)->prev) + +#endif diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 0b96eded76..dbc163bac1 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -1211,8 +1211,8 @@ static int set_driver_data(ErlDrvPort port_num, report_exit_list = report_exit; } - prt = erts_drvport2port(port_num, NULL); - if (prt) + prt = erts_drvport2port(port_num); + if (prt != ERTS_INVALID_ERL_DRV_PORT) prt->os_pid = pid; if (read_write & DO_READ) { @@ -2650,7 +2650,7 @@ report_exit_status(ErtsSysReportExit *rep, int status) if (rep->ifd >= 0) { driver_data[rep->ifd].alive = 0; driver_data[rep->ifd].status = status; - (void) driver_select((ErlDrvPort) pp, + (void) driver_select(ERTS_Port2ErlDrvPort(pp), rep->ifd, (ERL_DRV_READ|ERL_DRV_USE), 1); @@ -2658,7 +2658,7 @@ report_exit_status(ErtsSysReportExit *rep, int status) if (rep->ofd >= 0) { driver_data[rep->ofd].alive = 0; driver_data[rep->ofd].status = status; - (void) driver_select((ErlDrvPort) pp, + (void) driver_select(ERTS_Port2ErlDrvPort(pp), rep->ofd, (ERL_DRV_WRITE|ERL_DRV_USE), 1); diff --git a/erts/emulator/sys/win32/erl_win_dyn_driver.h b/erts/emulator/sys/win32/erl_win_dyn_driver.h index ae3228ff28..a7c53c904d 100644 --- a/erts/emulator/sys/win32/erl_win_dyn_driver.h +++ b/erts/emulator/sys/win32/erl_win_dyn_driver.h @@ -37,6 +37,7 @@ WDD_TYPEDEF(int, driver_failure_posix,(ErlDrvPort, int)); WDD_TYPEDEF(int, driver_failure,(ErlDrvPort, int)); WDD_TYPEDEF(int, driver_exit, (ErlDrvPort, int)); WDD_TYPEDEF(int, driver_failure_eof, (ErlDrvPort)); +WDD_TYPEDEF(void, erl_drv_busy_msgq_limits, (ErlDrvPort, ErlDrvSizeT *, ErlDrvSizeT *)); WDD_TYPEDEF(int, driver_select, (ErlDrvPort, ErlDrvEvent, int, int)); WDD_TYPEDEF(int, driver_event, (ErlDrvPort, ErlDrvEvent,ErlDrvEventData)); WDD_TYPEDEF(int, driver_output, (ErlDrvPort, char *, ErlDrvSizeT)); @@ -47,6 +48,7 @@ WDD_TYPEDEF(ErlDrvSizeT, driver_vec_to_buf, (ErlIOVec *, char *, ErlDrvSizeT)); WDD_TYPEDEF(int, driver_set_timer, (ErlDrvPort, unsigned long)); WDD_TYPEDEF(int, driver_cancel_timer, (ErlDrvPort)); WDD_TYPEDEF(int, driver_read_timer, (ErlDrvPort, unsigned long *)); +WDD_TYPEDEF(int, erl_drv_consume_timeslice, (ErlDrvPort, int)); WDD_TYPEDEF(char *, erl_errno_id, (int)); WDD_TYPEDEF(void, set_busy_port, (ErlDrvPort, int)); WDD_TYPEDEF(void, set_port_control_flags, (ErlDrvPort, int)); @@ -152,6 +154,7 @@ typedef struct { WDD_FTYPE(driver_failure) *driver_failure; WDD_FTYPE(driver_exit) *driver_exit; WDD_FTYPE(driver_failure_eof) *driver_failure_eof; + WDD_FTYPE(erl_drv_busy_msgq_limits) *erl_drv_busy_msgq_limits; WDD_FTYPE(driver_select) *driver_select; WDD_FTYPE(driver_event) *driver_event; WDD_FTYPE(driver_output) *driver_output; @@ -162,6 +165,7 @@ typedef struct { WDD_FTYPE(driver_set_timer) *driver_set_timer; WDD_FTYPE(driver_cancel_timer) *driver_cancel_timer; WDD_FTYPE(driver_read_timer) *driver_read_timer; + WDD_FTYPE(erl_drv_consume_timeslice) *erl_drv_consume_timeslice; WDD_FTYPE(erl_errno_id) *erl_errno_id; WDD_FTYPE(set_busy_port)* set_busy_port; WDD_FTYPE(set_port_control_flags) *set_port_control_flags; @@ -261,6 +265,7 @@ extern TWinDynDriverCallbacks WinDynDriverCallbacks; #define driver_failure (WinDynDriverCallbacks.driver_failure) #define driver_exit (WinDynDriverCallbacks.driver_exit) #define driver_failure_eof (WinDynDriverCallbacks.driver_failure_eof) +#define erl_drv_busy_msgq_limits (WinDynDriverCallbacks.erl_drv_busy_msgq_limits) #define driver_select (WinDynDriverCallbacks.driver_select) #define driver_event (WinDynDriverCallbacks.driver_event) #define driver_output (WinDynDriverCallbacks.driver_output) @@ -271,6 +276,7 @@ extern TWinDynDriverCallbacks WinDynDriverCallbacks; #define driver_set_timer (WinDynDriverCallbacks.driver_set_timer) #define driver_cancel_timer (WinDynDriverCallbacks.driver_cancel_timer) #define driver_read_timer (WinDynDriverCallbacks.driver_read_timer) +#define erl_drv_consume_timeslice (WinDynDriverCallbacks.erl_drv_consume_timeslice) #define erl_errno_id (WinDynDriverCallbacks.erl_errno_id) #define set_busy_port (WinDynDriverCallbacks.set_busy_port) #define set_port_control_flags (WinDynDriverCallbacks.set_port_control_flags) @@ -394,6 +400,7 @@ do { \ ((W).driver_failure) = driver_failure; \ ((W).driver_exit) = driver_exit; \ ((W).driver_failure_eof) = driver_failure_eof; \ +((W).erl_drv_busy_msgq_limits) = erl_drv_busy_msgq_limits;\ ((W).driver_select) = driver_select; \ ((W).driver_event) = driver_event; \ ((W).driver_output) = driver_output; \ @@ -404,6 +411,7 @@ do { \ ((W).driver_set_timer) = driver_set_timer; \ ((W).driver_cancel_timer) = driver_cancel_timer; \ ((W).driver_read_timer) = driver_read_timer; \ +((W).erl_drv_consume_timeslice) = erl_drv_consume_timeslice;\ ((W).erl_errno_id) = erl_errno_id; \ ((W).set_busy_port) = set_busy_port; \ ((W).set_port_control_flags) = set_port_control_flags; \ diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 1cd9072cea..19dffd0ea4 100755 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -57,11 +57,13 @@ extern void _dosmaperr(DWORD); #define __argv e_argv #endif +typedef struct driver_data DriverData; + static void init_console(); static int get_and_remove_option(int* argc, char** argv, const char* option); static char *get_and_remove_option2(int *argc, char **argv, const char *option); -static int init_async_io(struct async_io* aio, int use_threads); +static int init_async_io(DriverData *dp, struct async_io* aio, int use_threads); static void release_async_io(struct async_io* aio, ErlDrvPort); static void async_read_file(struct async_io* aio, LPVOID buf, DWORD numToRead); static int async_write_file(struct async_io* aio, LPVOID buf, DWORD numToWrite); @@ -96,7 +98,7 @@ static erts_smp_atomic_t pipe_creation_counter; static int driver_write(long, HANDLE, byte*, int); static int create_file_thread(struct async_io* aio, int mode); #ifdef ERTS_SMP -static void close_active_handle(ErlDrvPort, HANDLE handle); +static void close_active_handle(DriverData *, HANDLE handle); static DWORD WINAPI threaded_handle_closer(LPVOID param); #endif static DWORD WINAPI threaded_reader(LPVOID param); @@ -440,6 +442,8 @@ typedef struct async_io { DWORD bytesTransferred; /* Bytes read or write in the last operation. * Valid only when DF_OVR_READY is set. */ + DriverData *dp; /* Pointer to driver data struct which + this struct is part of */ } AsyncIo; @@ -458,7 +462,7 @@ static BOOL (WINAPI *fpSetHandleInformation)(HANDLE,DWORD,DWORD); * none of the file handles. */ -typedef struct driver_data { +struct driver_data { int totalNeeded; /* Total number of bytes needed to fill * up the packet header or packet. */ int bytesInBuffer; /* Number of bytes read so far in @@ -476,7 +480,8 @@ typedef struct driver_data { AsyncIo in; /* Control block for overlapped reading. */ AsyncIo out; /* Control block for overlapped writing. */ int report_exit; /* Do report exit status for the port */ -} DriverData; + erts_atomic32_t refc; /* References to this struct */ +}; /* Driver interfaces */ static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); @@ -581,6 +586,26 @@ struct erl_drv_entry vanilla_driver_entry = { stop_select }; +static ERTS_INLINE void +refer_driver_data(DriverData *dp) +{ +#ifdef DEBUG + erts_aint32_t refc = erts_atomic32_inc_read_nob(&dp->refc); + ASSERT(refc > 1); +#else + erts_atomic32_inc_nob(&dp->refc); +#endif +} + +static ERTS_INLINE void +unrefer_driver_data(DriverData *dp) +{ + erts_aint32_t refc = erts_atomic32_dec_read_mb(&dp->refc); + ASSERT(refc >= 0); + if (refc == 0) + driver_free(dp); +} + /* * Initialises a DriverData structure. * @@ -604,6 +629,7 @@ new_driver_data(ErlDrvPort port_num, int packet_bytes, int wait_objs_required, i * any more, since driver_select() can't fail. */ + erts_atomic32_init_nob(&dp->refc, 1); dp->bytesInBuffer = 0; dp->totalNeeded = packet_bytes; dp->inBufSize = PORT_BUFSIZ; @@ -616,9 +642,9 @@ new_driver_data(ErlDrvPort port_num, int packet_bytes, int wait_objs_required, i dp->port_num = port_num; dp->packet_bytes = packet_bytes; dp->port_pid = INVALID_HANDLE_VALUE; - if (init_async_io(&dp->in, use_threads) == -1) + if (init_async_io(dp, &dp->in, use_threads) == -1) goto async_io_error1; - if (init_async_io(&dp->out, use_threads) == -1) + if (init_async_io(dp, &dp->out, use_threads) == -1) goto async_io_error2; return dp; @@ -662,7 +688,7 @@ release_driver_data(DriverData* dp) dp->in.fd = INVALID_HANDLE_VALUE; DEBUGF(("Waiting for the in event thingie")); if (WaitForSingleObject(dp->in.ov.hEvent,timeout) == WAIT_TIMEOUT) { - close_active_handle(dp->port_num, dp->in.ov.hEvent); + close_active_handle(dp, dp->in.ov.hEvent); dp->in.ov.hEvent = NULL; timeout = 0; } @@ -673,7 +699,7 @@ release_driver_data(DriverData* dp) dp->out.fd = INVALID_HANDLE_VALUE; DEBUGF(("Waiting for the out event thingie")); if (WaitForSingleObject(dp->out.ov.hEvent,timeout) == WAIT_TIMEOUT) { - close_active_handle(dp->port_num, dp->out.ov.hEvent); + close_active_handle(dp, dp->out.ov.hEvent); dp->out.ov.hEvent = NULL; } DEBUGF(("...done\n")); @@ -719,7 +745,7 @@ release_driver_data(DriverData* dp) * the exit thread. */ - driver_free(dp); + unrefer_driver_data(dp); } #ifdef ERTS_SMP @@ -727,11 +753,12 @@ release_driver_data(DriverData* dp) struct handles_to_be_closed { HANDLE handles[MAXIMUM_WAIT_OBJECTS]; unsigned cnt; + DriverData *dp; }; static struct handles_to_be_closed* htbc_curr = NULL; CRITICAL_SECTION htbc_lock; -static void close_active_handle(ErlDrvPort port_num, HANDLE handle) +static void close_active_handle(DriverData *dp, HANDLE handle) { struct handles_to_be_closed* htbc; int i; @@ -745,11 +772,14 @@ static void close_active_handle(ErlDrvPort port_num, HANDLE handle) sizeof(*htbc)); htbc->handles[0] = CreateAutoEvent(FALSE); htbc->cnt = 1; + htbc->dp = dp; + refer_driver_data(dp); /* Need to keep driver data until we have + closed the event; outstanding operation + might write into it.. */ thread = (HANDLE *) _beginthreadex(NULL, 0, threaded_handle_closer, htbc, 0, &tid); CloseHandle(thread); } htbc->handles[htbc->cnt++] = handle; - driver_select(port_num, (ErlDrvEvent)handle, ERL_DRV_USE_NO_CALLBACK, 0); SetEvent(htbc->handles[0]); htbc_curr = htbc; LeaveCriticalSection(&htbc_lock); @@ -798,6 +828,7 @@ threaded_handle_closer(LPVOID param) } LeaveCriticalSection(&htbc_lock); CloseHandle(htbc->handles[0]); + unrefer_driver_data(htbc->dp); erts_free(ERTS_ALC_T_DRV_TAB, htbc); DEBUGF(("threaded_handle_closer %p terminating\r\n", htbc)); return 0; @@ -864,8 +895,9 @@ reuse_driver_data(DriverData *dp, HANDLE ifd, HANDLE ofd, int read_write, ErlDrv */ static int -init_async_io(AsyncIo* aio, int use_threads) +init_async_io(DriverData *dp, AsyncIo* aio, int use_threads) { + aio->dp = dp; aio->flags = 0; aio->thread = (HANDLE) -1; aio->fd = INVALID_HANDLE_VALUE; @@ -884,6 +916,8 @@ init_async_io(AsyncIo* aio, int use_threads) if (aio->ov.hEvent == NULL) return -1; if (use_threads) { + OV_BUFFER_PTR(aio) = NULL; + OV_NUM_TO_READ(aio) = 0; aio->ioAllowed = CreateAutoEvent(FALSE); if (aio->ioAllowed == NULL) return -1; @@ -914,12 +948,8 @@ release_async_io(AsyncIo* aio, ErlDrvPort port_num) CloseHandle(aio->fd); aio->fd = INVALID_HANDLE_VALUE; - if (aio->ov.hEvent != NULL) { - (void) driver_select(port_num, - (ErlDrvEvent)aio->ov.hEvent, - ERL_DRV_USE, 0); - /* was CloseHandle(aio->ov.hEvent); */ - } + if (aio->ov.hEvent != NULL) + CloseHandle(aio->ov.hEvent); aio->ov.hEvent = NULL; @@ -1260,9 +1290,9 @@ spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) retval = set_driver_data(dp, hFromChild, hToChild, opts->read_write, opts->exit_status); if (retval != ERL_DRV_ERROR_GENERAL && retval != ERL_DRV_ERROR_ERRNO) { - Port *prt = erts_drvport2port_raw(port_num); + Port *prt = erts_drvport2port(port_num); /* We assume that this cannot generate a negative number */ - ASSERT(prt); + ASSERT(prt != ERTS_INVALID_ERL_DRV_PORT); prt->os_pid = (SWord) pid; } } @@ -1287,12 +1317,15 @@ create_file_thread(AsyncIo* aio, int mode) { DWORD tid; /* Id for thread. */ + refer_driver_data(aio->dp); aio->thread = (HANDLE) _beginthreadex(NULL, 0, (mode & DO_WRITE) ? threaded_writer : threaded_reader, aio, 0, &tid); - - return aio->thread != (HANDLE) -1; + if (aio->thread != (HANDLE) -1) + return 1; + unrefer_driver_data(aio->dp); + return 0; } /* @@ -2078,6 +2111,7 @@ threaded_reader(LPVOID param) if (aio->flags & DF_EXIT_THREAD) break; } + unrefer_driver_data(aio->dp); return 0; } @@ -2157,6 +2191,7 @@ threaded_writer(LPVOID param) } CloseHandle(aio->fd); aio->fd = INVALID_HANDLE_VALUE; + unrefer_driver_data(aio->dp); return 0; } @@ -2297,6 +2332,7 @@ static void fd_stop(ErlDrvData data) (void) driver_select(dp->port_num, (ErlDrvEvent)dp->out.ov.hEvent, ERL_DRV_WRITE, 0); + ASSERT(dp->out.flushEvent); SetEvent(dp->out.flushEvent); WaitForSingleObject(dp->out.flushReplyEvent, INFINITE); } @@ -2349,12 +2385,12 @@ stop(ErlDrvData data) if (dp->in.ov.hEvent != NULL) { (void) driver_select(dp->port_num, (ErlDrvEvent)dp->in.ov.hEvent, - ERL_DRV_READ, 0); + ERL_DRV_READ|ERL_DRV_USE_NO_CALLBACK, 0); } if (dp->out.ov.hEvent != NULL) { (void) driver_select(dp->port_num, (ErlDrvEvent)dp->out.ov.hEvent, - ERL_DRV_WRITE, 0); + ERL_DRV_WRITE|ERL_DRV_USE_NO_CALLBACK, 0); } if (dp->out.thread == (HANDLE) -1 && dp->in.thread == (HANDLE) -1) { @@ -2366,6 +2402,8 @@ stop(ErlDrvData data) */ HANDLE thread; DWORD tid; + + /* threaded_exiter implicitly takes over refc from us... */ thread = (HANDLE *) _beginthreadex(NULL, 0, threaded_exiter, dp, 0, &tid); CloseHandle(thread); } diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index dae36fed8f..dfba7d098f 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -78,7 +78,8 @@ otp_9302/1, thr_free_drv/1, async_blast/1, - thr_msg_blast/1]). + thr_msg_blast/1, + consume_timeslice/1]). -export([bin_prefix/2]). @@ -149,7 +150,8 @@ all() -> otp_9302, thr_free_drv, async_blast, - thr_msg_blast]. + thr_msg_blast, + consume_timeslice]. groups() -> [{timer, [], @@ -2073,10 +2075,329 @@ thr_msg_blast(Config) when is_list(Config) -> Res end. +consume_timeslice(Config) when is_list(Config) -> + %% + %% Verify that erl_drv_consume_timeslice() works. + %% + %% The first four cases expect that the command signal is + %% delivered immediately, i.e., isn't scheduled. Since there + %% are no conflicts these signals should normally be delivered + %% immediately. However some builds and configurations may + %% schedule these ops anyway, in these cases we do not verify + %% scheduling counts. + %% + %% When signal is delivered immediately we must take into account + %% that process and port are "virtualy" scheduled out and in + %% in the trace generated. + %% + %% Port ! {_, {command, _}, and port_command() differs. The send + %% instruction needs to check if the caller is out of reductions + %% at the end of the instruction, since no erlang function call + %% is involved. Otherwise, a sequence of send instructions would + %% not be scheduled out even when out of reductions. port_commond() + %% doesn't do that since it will always (since R16A) be called via + %% the erlang wrappers in the erlang module. + %% + %% The last two cases tests scheduled operations. We create + %% a conflict by executing at the same time on different + %% schedulers. When only one scheduler we enable parallelism on + %% the port instead. + %% + + Path = ?config(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, consume_timeslice_drv), + Port = open_port({spawn, consume_timeslice_drv}, [{parallelism, false}]), + + Parent = self(), + Go = make_ref(), + + "enabled" = port_control(Port, $E, ""), + Proc1 = spawn_link(fun () -> + receive Go -> ok end, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}} + end), + receive after 100 -> ok end, + count_pp_sched_start(), + Proc1 ! Go, + wait_command_msgs(Port, 10), + [{Port, Sprt1}, {Proc1, Sproc1}] = count_pp_sched_stop([Port, Proc1]), + case Sprt1 of + 10 -> + true = in_range(5, Sproc1-10, 7); + _ -> + case erlang:system_info(lock_checking) of + true -> ?t:format("Ignore bad sched count due to lock checking", []); + false -> ?t:fail({unexpected_sched_counts, Sprt1, Sproc1}) + end + end, + + "disabled" = port_control(Port, $D, ""), + Proc2 = spawn_link(fun () -> + receive Go -> ok end, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}} + end), + receive after 100 -> ok end, + count_pp_sched_start(), + Proc2 ! Go, + wait_command_msgs(Port, 10), + [{Port, Sprt2}, {Proc2, Sproc2}] = count_pp_sched_stop([Port, Proc2]), + case Sprt2 of + 10 -> + true = in_range(1, Sproc2-10, 2); + _ -> + case erlang:system_info(lock_checking) of + true -> ?t:format("Ignore bad sched count due to lock checking", []); + false -> ?t:fail({unexpected_sched_counts, Sprt2, Sproc2}) + end + end, + + "enabled" = port_control(Port, $E, ""), + Proc3 = spawn_link(fun () -> + receive Go -> ok end, + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, "") + end), + count_pp_sched_start(), + Proc3 ! Go, + wait_command_msgs(Port, 10), + [{Port, Sprt3}, {Proc3, Sproc3}] = count_pp_sched_stop([Port, Proc3]), + case Sprt3 of + 10 -> + true = in_range(5, Sproc3-10, 7); + _ -> + case erlang:system_info(lock_checking) of + true -> ?t:format("Ignore bad sched count due to lock checking", []); + false -> ?t:fail({unexpected_sched_counts, Sprt3, Sproc3}) + end + end, + + "disabled" = port_control(Port, $D, ""), + Proc4 = spawn_link(fun () -> + receive Go -> ok end, + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, "") + end), + count_pp_sched_start(), + Proc4 ! Go, + wait_command_msgs(Port, 10), + [{Port, Sprt4}, {Proc4, Sproc4}] = count_pp_sched_stop([Port, Proc4]), + case Sprt4 of + 10 -> + true = in_range(1, Sproc4-10, 2); + _ -> + case erlang:system_info(lock_checking) of + true -> ?t:format("Ignore bad sched count due to lock checking", []); + false -> ?t:fail({unexpected_sched_counts, Sprt4, Sproc4}) + end + end, + + SOnl = erlang:system_info(schedulers_online), + %% If only one scheduler use port with parallelism set to true, + %% in order to trigger scheduling of command signals + Port2 = case SOnl of + 1 -> + Port ! {self(), close}, + receive {Port, closed} -> ok end, + open_port({spawn, consume_timeslice_drv}, + [{parallelism, true}]); + _ -> + process_flag(scheduler, 1), + 1 = erlang:system_info(scheduler_id), + Port + end, + count_pp_sched_start(), + "enabled" = port_control(Port2, $E, ""), + W5 = case SOnl of + 1 -> + false; + _ -> + W1= spawn_opt(fun () -> + 2 = erlang:system_info(scheduler_id), + "sleeped" = port_control(Port2, $S, "") + end, [link,{scheduler,2}]), + receive after 100 -> ok end, + W1 + end, + Proc5 = spawn_opt(fun () -> + receive Go -> ok end, + 1 = erlang:system_info(scheduler_id), + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}} + end, [link,{scheduler,1}]), + receive after 100 -> ok end, + Proc5 ! Go, + wait_procs_exit([W5, Proc5]), + wait_command_msgs(Port2, 10), + [{Port2, Sprt5}, {Proc5, Sproc5}] = count_pp_sched_stop([Port2, Proc5]), + true = in_range(2, Sproc5, 3), + true = in_range(7, Sprt5, 20), + + count_pp_sched_start(), + "disabled" = port_control(Port2, $D, ""), + W6 = case SOnl of + 1 -> + false; + _ -> + W2= spawn_opt(fun () -> + 2 = erlang:system_info(scheduler_id), + "sleeped" = port_control(Port2, $S, "") + end, [link,{scheduler,2}]), + receive after 100 -> ok end, + W2 + end, + Proc6 = spawn_opt(fun () -> + receive Go -> ok end, + 1 = erlang:system_info(scheduler_id), + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}} + end, [link,{scheduler,1}]), + receive after 100 -> ok end, + Proc6 ! Go, + wait_procs_exit([W6, Proc6]), + wait_command_msgs(Port2, 10), + [{Port2, Sprt6}, {Proc6, Sproc6}] = count_pp_sched_stop([Port2, Proc6]), + true = in_range(2, Sproc6, 3), + true = in_range(3, Sprt6, 6), + + process_flag(scheduler, 0), + + Port2 ! {self(), close}, + receive {Port2, closed} -> ok end, + ok. + +wait_command_msgs(_, 0) -> + ok; +wait_command_msgs(Port, N) -> + receive + {Port, command} -> + wait_command_msgs(Port, N-1) + end. + +in_range(Low, Val, High) when is_integer(Low), + is_integer(Val), + is_integer(High), + Low =< Val, + Val =< High -> + true; +in_range(Low, Val, High) when is_integer(Low), + is_integer(Val), + is_integer(High) -> + false. + +count_pp_sched_start() -> + erlang:trace(all, true, [running_procs, running_ports, {tracer, self()}]), + ok. + +count_pp_sched_stop(Ps) -> + Td = erlang:trace_delivered(all), + erlang:trace(all, false, [running_procs, running_ports, {tracer, self()}]), + PNs = lists:map(fun (P) -> {P, 0} end, Ps), + receive {trace_delivered, all, Td} -> ok end, + Res = count_proc_sched(Ps, PNs), + ?t:format("Scheduling counts: ~p~n", [Res]), + erlang:display({scheduling_counts, Res}), + Res. + +do_inc_pn(_P, []) -> + throw(undefined); +do_inc_pn(P, [{P,N}|PNs]) -> + [{P,N+1}|PNs]; +do_inc_pn(P, [PN|PNs]) -> + [PN|do_inc_pn(P, PNs)]. + +inc_pn(P, PNs) -> + try + do_inc_pn(P, PNs) + catch + throw:undefined -> PNs + end. + +count_proc_sched(Ps, PNs) -> + receive + TT when element(1, TT) == trace, element(3, TT) == in -> +% erlang:display(TT), + count_proc_sched(Ps, inc_pn(element(2, TT), PNs)); + TT when element(1, TT) == trace, element(3, TT) == out -> + count_proc_sched(Ps, PNs) + after 0 -> + PNs + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Utilities %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%flush_msgs() -> +% receive +% M -> +% erlang:display(M), +% flush_msgs() +% after 0 -> +% ok +% end. + +wait_procs_exit([]) -> + ok; +wait_procs_exit([P|Ps]) when is_pid(P) -> + Mon = erlang:monitor(process, P), + receive + {'DOWN', Mon, process, P, _} -> + wait_procs_exit(Ps) + end; +wait_procs_exit([_|Ps]) -> + wait_procs_exit(Ps). + get_port_msg(Port, Timeout) -> receive {Port, What} -> diff --git a/erts/emulator/test/driver_SUITE_data/Makefile.src b/erts/emulator/test/driver_SUITE_data/Makefile.src index b667dff6b6..1fedd72200 100644 --- a/erts/emulator/test/driver_SUITE_data/Makefile.src +++ b/erts/emulator/test/driver_SUITE_data/Makefile.src @@ -15,7 +15,8 @@ MISC_DRVS = outputv_drv@dll@ \ otp_9302_drv@dll@ \ thr_free_drv@dll@ \ async_blast_drv@dll@ \ - thr_msg_blast_drv@dll@ + thr_msg_blast_drv@dll@ \ + consume_timeslice_drv@dll@ SYS_INFO_DRVS = sys_info_base_drv@dll@ \ sys_info_prev_drv@dll@ \ diff --git a/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c b/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c new file mode 100644 index 0000000000..6b0c4cf37d --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c @@ -0,0 +1,172 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2012. 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% + */ + +#include "erl_driver.h" +#ifdef __WIN32__ +#include <windows.h> +#else +#include <unistd.h> +#endif +#include <stdio.h> +#include <string.h> + +static void stop(ErlDrvData drv_data); +static ErlDrvData start(ErlDrvPort port, + char *command); +static void output(ErlDrvData drv_data, + char *buf, ErlDrvSizeT len); +static ErlDrvSSizeT control(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen); + +static ErlDrvEntry consume_timeslice_drv_entry = { + NULL /* init */, + start, + stop, + output, + NULL /* ready_input */, + NULL /* ready_output */, + "consume_timeslice_drv", + NULL /* finish */, + NULL /* handle */, + control, + NULL /* timeout */, + NULL /* outputv */, + NULL /* ready_async */, + NULL /* flush */, + NULL /* call */, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +typedef struct { + ErlDrvPort port; + ErlDrvTermData tport; + ErlDrvTermData cmd_msg[6]; + int consume_timeslice; +} consume_timeslice_data_t; + + +DRIVER_INIT(consume_timeslice_drv) +{ + return &consume_timeslice_drv_entry; +} + +static void stop(ErlDrvData drv_data) +{ + driver_free((void *) drv_data); +} + +static ErlDrvData start(ErlDrvPort port, + char *command) +{ + consume_timeslice_data_t *ctsd; + + ctsd = driver_alloc(sizeof(consume_timeslice_data_t)); + if (!ctsd) + return ERL_DRV_ERROR_GENERAL; + + ctsd->port = port; + ctsd->tport = driver_mk_port(port); + ctsd->consume_timeslice = 0; + + ctsd->cmd_msg[0] = ERL_DRV_PORT; + ctsd->cmd_msg[1] = ctsd->tport; + ctsd->cmd_msg[2] = ERL_DRV_ATOM; + ctsd->cmd_msg[3] = driver_mk_atom("command"); + ctsd->cmd_msg[4] = ERL_DRV_TUPLE; + ctsd->cmd_msg[5] = (ErlDrvTermData) 2; + + return (ErlDrvData) ctsd; +} + +static void output(ErlDrvData drv_data, + char *buf, ErlDrvSizeT len) +{ + consume_timeslice_data_t *ctsd = (consume_timeslice_data_t *) drv_data; + int res; + + if (ctsd->consume_timeslice) { + int res = erl_drv_consume_timeslice(ctsd->port, 50); + if (res < 0) { + driver_failure_atom(ctsd->port, "erl_drv_consume_timeslice() failed"); + return; + } + } + + res = erl_drv_output_term(ctsd->tport, + ctsd->cmd_msg, + sizeof(ctsd->cmd_msg)/sizeof(ErlDrvTermData)); + if (res <= 0) { + driver_failure_atom(ctsd->port, "erl_drv_output_term() failed"); + return; + } +} +static ErlDrvSSizeT control(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen) +{ + consume_timeslice_data_t *ctsd = (consume_timeslice_data_t *) drv_data; + int res; + char *res_str; + ErlDrvSSizeT res_len; + + switch (command) { + case 'E': + ctsd->consume_timeslice = 1; + res_str = "enabled"; + break; + case 'D': + ctsd->consume_timeslice = 0; + res_str = "disabled"; + break; + case 'S': +#ifdef __WIN32__ + Sleep((DWORD) 1000); +#else + sleep(1); +#endif + res_str = "sleeped"; + break; + default: + res_str = "what?"; + break; + } + + res_len = strlen(res_str); + if (res_len > rlen) { + char *abuf = driver_alloc(sizeof(char)*res_len); + if (!abuf) { + driver_failure_atom(ctsd->port, "driver_alloc() failed"); + return 0; + } + *rbuf = abuf; + } + + memcpy((void *) *rbuf, (void *) res_str, res_len); + + return res_len; +} diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl index 830ed91da9..e34050cd07 100644 --- a/erts/emulator/test/hash_SUITE.erl +++ b/erts/emulator/test/hash_SUITE.erl @@ -1,3 +1,4 @@ +%% -*- coding: utf-8 -*- %% %% %CopyrightBegin% %% @@ -75,7 +76,7 @@ config(priv_dir,_) -> test_phash2/1,otp_5292/1,bit_level_binaries/1,otp_7127/1, end_per_testcase/2,init_per_testcase/2]). init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(test_server:minutes(10)), + Dog=test_server:timetrap(test_server:minutes(10)), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> @@ -169,24 +170,24 @@ otp_7127(Config) when is_list(Config) -> %% define -DSTANDALONE when compiling. %% basic_test() -> - ?line 685556714 = erlang:phash({a,b,c},16#FFFFFFFF), - ?line 14468079 = erlang:hash({a,b,c},16#7FFFFFF), - ?line 37442646 = erlang:phash([a,b,c,{1,2,3},c:pid(0,2,3), + 685556714 = erlang:phash({a,b,c},16#FFFFFFFF), + 14468079 = erlang:hash({a,b,c},16#7FFFFFF), + 37442646 = erlang:phash([a,b,c,{1,2,3},c:pid(0,2,3), 16#77777777777777],16#FFFFFFFF), - ?line Comment = case erlang:hash([a,b,c,{1,2,3},c:pid(0,2,3), + Comment = case erlang:hash([a,b,c,{1,2,3},c:pid(0,2,3), 16#77777777777777],16#7FFFFFF) of 102727602 -> - ?line big = erlang:system_info(endian), + big = erlang:system_info(endian), "Big endian machine"; 105818829 -> - ?line little = erlang:system_info(endian), + little = erlang:system_info(endian), "Little endian machine" end, ExternalReference = <<131,114,0,3,100,0,13,110,111,110,111,100,101,64, 110,111,104,111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0>>, - ?line 1113403635 = erlang:phash(binary_to_term(ExternalReference), + 1113403635 = erlang:phash(binary_to_term(ExternalReference), 16#FFFFFFFF), - ?line 123 = erlang:hash(binary_to_term(ExternalReference), + 123 = erlang:hash(binary_to_term(ExternalReference), 16#7FFFFFF), ExternalFun = <<131,117,0,0,0,3,103,100,0,13,110,111,110,111,100,101,64, 110,111,104,111,115,116,0,0,0,38,0,0,0,0,0,100,0,8,101, @@ -204,9 +205,9 @@ basic_test() -> 104,101,108,108,100,0,10,108,111,99,97,108,95,102,117, 110,99,108,0,0,0,1,103,100,0,13,110,111,110,111,100,101, 64,110,111,104,111,115,116,0,0,0,22,0,0,0,0,0,106>>, - ?line 170987488 = erlang:phash(binary_to_term(ExternalFun), + 170987488 = erlang:phash(binary_to_term(ExternalFun), 16#FFFFFFFF), - ?line 124460689 = erlang:hash(binary_to_term(ExternalFun), + 124460689 = erlang:hash(binary_to_term(ExternalFun), 16#7FFFFFF), case (catch erlang:phash(1,0)) of {'EXIT',{badarg, _}} -> @@ -237,23 +238,23 @@ range_test() -> spread_test(N) -> - ?line test_fun(N,{erlang,phash},16#50000000000,fun(X) -> + test_fun(N,{erlang,phash},16#50000000000,fun(X) -> X end), - ?line test_fun(N,{erlang,phash},0,fun(X) -> + test_fun(N,{erlang,phash},0,fun(X) -> X end), - ?line test_fun(N,{erlang,phash},16#123456789ABCDEF123456789ABCDEF,fun(X) -> + test_fun(N,{erlang,phash},16#123456789ABCDEF123456789ABCDEF,fun(X) -> X end), - ?line test_fun(N,{erlang,phash},16#50000000000,fun(X) -> + test_fun(N,{erlang,phash},16#50000000000,fun(X) -> integer_to_list(X) end), - ?line test_fun(N,{erlang,phash},16#50000000000,fun(X) -> + test_fun(N,{erlang,phash},16#50000000000,fun(X) -> integer_to_bytelist(X,[]) end), - ?line test_fun(N,{erlang,phash},16#50000000000,fun(X) -> - integer_to_binary(X) + test_fun(N,{erlang,phash},16#50000000000,fun(X) -> + integer_to_binary_value(X) end). @@ -265,14 +266,14 @@ cmp_test(N) -> do_cmp_hashes(0,_) -> ok; do_cmp_hashes(N,Steps) -> - ?line R0 = random:uniform(1 bsl Steps - 1) + random:uniform(16#FFFFFFFF), - ?line R = case random:uniform(2) of + R0 = random:uniform(1 bsl Steps - 1) + random:uniform(16#FFFFFFFF), + R = case random:uniform(2) of 1 -> R0; _ -> -R0 end, - ?line NSteps = case N rem 10 of + NSteps = case N rem 10 of 0 -> case (Steps + 8) rem 1024 of 0 -> @@ -283,9 +284,9 @@ do_cmp_hashes(N,Steps) -> _ -> Steps end, - ?line X = erlang:phash(R,16#FFFFFFFF), - ?line Y = make_hash(R,16#FFFFFFFF), - ?line case X =:= Y of + X = erlang:phash(R,16#FFFFFFFF), + Y = make_hash(R,16#FFFFFFFF), + case X =:= Y of true -> do_cmp_hashes(N - 1, NSteps); _ -> @@ -363,6 +364,15 @@ phash2_test() -> %% (cannot use block_hash due to compatibility issues...) {abc,26499}, {abd,26500}, + {'åäö', 62518}, + %% 81 runes as an atom, 'ᚠᚡᚢᚣᚤᚥᚦᚧᚨᚩᚪᚫᚬᚭᚮᚯᚰᚱᚲᚳᚴᚵᚶᚷᚸᚹᚺᚻᚼᚽᚾᚿᛀᛁᛂᛃᛄᛅᛆᛇᛈᛉᛊᛋᛌᛍᛎᛏᛐᛑᛒᛓᛔᛕᛖᛗᛘᛙᛚᛛᛜᛝᛞᛟᛠᛡᛢᛣᛤᛥᛦᛧᛨᛩᛪ᛫᛬᛭ᛮᛯᛰ' + {erlang:binary_to_term(<<131, 118, 0, 243, (unicode:characters_to_binary(lists:seq(5792, 5872)))/binary >>), 241561024}, + %% åäö dynamic + {erlang:binary_to_term(<<131, 118, 0, 6, 195, 165, 195, 164, 195, 182>>),62518}, + %% the atom '゙゚゛゜ゝゞゟ゠ァアィイゥウェエォオカガキギクグケゲコゴサザシジスズ' + {erlang:binary_to_term(<<131, 118, 0, 102, (unicode:characters_to_binary(lists:seq(12441, 12542)))/binary>>), 246053818}, + %% the atom, '😃' + {erlang:binary_to_term(<<131, 118, 0, 4, 240, 159, 152, 131>>), 1026307}, %% small {0,3175731469}, @@ -469,8 +479,8 @@ phash2_test() -> SpecFun = fun(S) -> sofs:no_elements(S) > 1 end, F = sofs:relation_to_family(sofs:converse(sofs:relation(L))), D = sofs:to_external(sofs:family_specification(SpecFun, F)), - ?line [] = D, - ?line [] = [{E,H,H2} || {E,H} <- L, (H2 = erlang:phash2(E, Max)) =/= H], + [] = D, + [] = [{E,H,H2} || {E,H} <- L, (H2 = erlang:phash2(E, Max)) =/= H], ok. -ifdef(FALSE). @@ -497,17 +507,17 @@ otp_5292_test() -> end, S2 = md5([md5(hash_int(S, E, PH)) || {Start, N, Sz} <- d(), {S, E} <- int(Start, N, Sz)]), - ?line Comment = case S1 of + Comment = case S1 of <<4,248,208,156,200,131,7,1,173,13,239,173,112,81,16,174>> -> - ?line big = erlang:system_info(endian), + big = erlang:system_info(endian), "Big endian machine"; <<180,28,33,231,239,184,71,125,76,47,227,241,78,184,176,233>> -> - ?line little = erlang:system_info(endian), + little = erlang:system_info(endian), "Little endian machine" end, - ?line <<124,81,198,121,174,233,19,137,10,83,33,80,226,111,238,99>> = S2, - ?line 2 = erlang:hash(1, (1 bsl 27) -1), - ?line {'EXIT', _} = (catch erlang:hash(1, (1 bsl 27))), + <<124,81,198,121,174,233,19,137,10,83,33,80,226,111,238,99>> = S2, + 2 = erlang:hash(1, (1 bsl 27) -1), + {'EXIT', _} = (catch erlang:hash(1, (1 bsl 27))), {comment, Comment}. d() -> @@ -528,21 +538,21 @@ md5(T) -> erlang:md5(term_to_binary(T)). bit_level_binaries() -> - ?line [3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] = + [3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] = bit_level_all_different(fun erlang:hash/2), - ?line [3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] = + [3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] = bit_level_all_different(fun erlang:phash/2), - ?line [102233154,19716,102133857,4532024,123369135,24565730,109558721|_] = + [102233154,19716,102133857,4532024,123369135,24565730,109558721|_] = bit_level_all_different(fun erlang:phash2/2), - ?line 13233341 = test_hash_phash(<<42:7>>, 16#7FFFFFF), - ?line 79121243 = test_hash_phash(<<99:7>>, 16#7FFFFFF), - ?line 95517726 = test_hash_phash(<<16#378ABF73:31>>, 16#7FFFFFF), + 13233341 = test_hash_phash(<<42:7>>, 16#7FFFFFF), + 79121243 = test_hash_phash(<<99:7>>, 16#7FFFFFF), + 95517726 = test_hash_phash(<<16#378ABF73:31>>, 16#7FFFFFF), - ?line 64409098 = test_phash2(<<99:7>>, 16#7FFFFFF), - ?line 55555814 = test_phash2(<<123,19:2>>, 16#7FFFFFF), - ?line 83868582 = test_phash2(<<123,45,6:3>>, 16#7FFFFFF), - ?line 2123204 = test_phash2(<<123,45,7:3>>, 16#7FFFFFF), + 64409098 = test_phash2(<<99:7>>, 16#7FFFFFF), + 55555814 = test_phash2(<<123,19:2>>, 16#7FFFFFF), + 83868582 = test_phash2(<<123,45,6:3>>, 16#7FFFFFF), + 2123204 = test_phash2(<<123,45,7:3>>, 16#7FFFFFF), ok. @@ -579,7 +589,7 @@ test_phash2(Bitstr, Rem) -> otp_7127_test() -> %% Used to return 2589127136. - ?line 38990304 = erlang:phash2(<<"Scott9">>), + 38990304 = erlang:phash2(<<"Scott9">>), ok. %% @@ -711,7 +721,7 @@ collect_hits() -> init_table(), N. -integer_to_binary(N) -> +integer_to_binary_value(N) -> list_to_binary(lists:reverse(integer_to_bytelist(N,[]))). integer_to_bytelist(0,Acc) -> diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 6bd7361612..0a9d997c3b 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -36,7 +36,7 @@ threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1, is_checks/1, get_length/1, make_atom/1, make_string/1, reverse_list_test/1, - otp_9668/1 + otp_9668/1, consume_timeslice/1 ]). -export([many_args_100/100]). @@ -63,7 +63,7 @@ all() -> resource_takeover, threading, send, send2, send3, send_threaded, neg, is_checks, get_length, make_atom, make_string,reverse_list_test, - otp_9668 + otp_9668, consume_timeslice ]. groups() -> @@ -1259,6 +1259,108 @@ otp_9668(Config) -> ?line verify_tmpmem(TmpMem), ok. +consume_timeslice(Config) when is_list(Config) -> + CONTEXT_REDS = 2000, + Me = self(), + Go = make_ref(), + RedDiff = make_ref(), + Done = make_ref(), + DummyMFA = {?MODULE,dummy_call,1}, + P = spawn(fun () -> + receive Go -> ok end, + {reductions, R1} = process_info(self(), reductions), + 1 = consume_timeslice_nif(100, false), + dummy_call(111), + 0 = consume_timeslice_nif(90, false), + dummy_call(222), + 1 = consume_timeslice_nif(10, false), + dummy_call(333), + 0 = consume_timeslice_nif(25, false), + 0 = consume_timeslice_nif(25, false), + 0 = consume_timeslice_nif(25, false), + 1 = consume_timeslice_nif(25, false), + 0 = consume_timeslice_nif(25, false), + + ok = case consume_timeslice_nif(1, true) of + Cnt when Cnt > 70, Cnt < 80 -> ok; + Other -> Other + end, + dummy_call(444), + + {reductions, R2} = process_info(self(), reductions), + Me ! {RedDiff, R2 - R1}, + exit(Done) + end), + erlang:yield(), + + erlang:trace_pattern(DummyMFA, [], [local]), + ?line 1 = erlang:trace(P, true, [call, running, procs, {tracer, self()}]), + + P ! Go, + + %% receive Go -> ok end, + ?line {trace, P, in, _} = next_tmsg(P), + + %% consume_timeslice_nif(100), + %% dummy_call(111) + ?line {trace, P, out, _} = next_tmsg(P), + ?line {trace, P, in, _} = next_tmsg(P), + ?line {trace, P, call, {?MODULE,dummy_call,[111]}} = next_tmsg(P), + + %% consume_timeslice_nif(90), + %% dummy_call(222) + ?line {trace, P, call, {?MODULE,dummy_call,[222]}} = next_tmsg(P), + + %% consume_timeslice_nif(10), + %% dummy_call(333) + ?line {trace, P, out, _} = next_tmsg(P), + ?line {trace, P, in, _} = next_tmsg(P), + ?line {trace, P, call, {?MODULE,dummy_call,[333]}} = next_tmsg(P), + + %% 25,25,25,25, 25 + ?line {trace, P, out, {?MODULE,consume_timeslice_nif,2}} = next_tmsg(P), + ?line {trace, P, in, {?MODULE,consume_timeslice_nif,2}} = next_tmsg(P), + + %% consume_timeslice(1,true) + %% dummy_call(444) + ?line {trace, P, out, DummyMFA} = next_tmsg(P), + ?line {trace, P, in, DummyMFA} = next_tmsg(P), + ?line {trace, P, call, {?MODULE,dummy_call,[444]}} = next_tmsg(P), + + %% exit(Done) + ?line {trace, P, exit, Done} = next_tmsg(P), + + ExpReds = (100 + 90 + 10 + 25*5 + 75) * CONTEXT_REDS div 100, + receive + {RedDiff, Reductions} when Reductions < (ExpReds + 10), Reductions > (ExpReds - 10) -> + io:format("Reductions = ~p~n", [Reductions]), + ok; + {RedDiff, Reductions} -> + ?t:fail({unexpected_reduction_count, Reductions}) + end, + + none = next_msg(P), + + ok. + +next_msg(Pid) -> + receive + M -> M + after 100 -> + none + end. + +next_tmsg(Pid) -> + receive TMsg when is_tuple(TMsg), + element(1, TMsg) == trace, + element(2, TMsg) == Pid -> + TMsg + after 100 -> + none + end. + +dummy_call(_) -> + ok. tmpmem() -> case erlang:system_info({allocator,temp_alloc}) of @@ -1370,6 +1472,7 @@ reverse_list(_) -> ?nif_stub. echo_int(_) -> ?nif_stub. type_sizes() -> ?nif_stub. otp_9668_nif(_) -> ?nif_stub. +consume_timeslice_nif(_,_) -> ?nif_stub. nif_stub_error(Line) -> exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 03092fef5e..2504d24b51 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1456,6 +1456,27 @@ static ERL_NIF_TERM otp_9668_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar return atom_ok; } +static ERL_NIF_TERM consume_timeslice_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int percent; + char atom[10]; + int do_repeat; + + if (!enif_get_int(env, argv[0], &percent) || + !enif_get_atom(env, argv[1], atom, sizeof(atom), ERL_NIF_LATIN1)) { + return enif_make_badarg(env); + } + if (strcmp(atom , "true") == 0) { + int cnt = 1; + while (enif_consume_timeslice(env, percent) == 0 && cnt < 200) + cnt++; + return enif_make_int(env, cnt); + } + else { + return enif_make_int(env, enif_consume_timeslice(env, percent)); + } +} + static ErlNifFunc nif_funcs[] = { {"lib_version", 0, lib_version}, @@ -1504,7 +1525,8 @@ static ErlNifFunc nif_funcs[] = {"reverse_list",1, reverse_list}, {"echo_int", 1, echo_int}, {"type_sizes", 0, type_sizes}, - {"otp_9668_nif", 1, otp_9668_nif} + {"otp_9668_nif", 1, otp_9668_nif}, + {"consume_timeslice_nif", 2, consume_timeslice_nif} }; ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload) diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index bf33c337ee..b92a0e2059 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -31,24 +31,28 @@ %% list_to_integer/1 %% round/1 %% trunc/1 - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, t_abs/1, t_float/1, - t_float_to_list/1, t_integer_to_list/1, - t_list_to_integer/1, - t_list_to_float_safe/1, t_list_to_float_risky/1, - t_round/1, t_trunc/1]). +%% integer_to_binary/1 +%% integer_to_binary/2 +%% binary_to_integer/1 + +-export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, t_abs/1, t_float/1, + t_float_to_string/1, t_integer_to_string/1, + t_string_to_integer/1, + t_string_to_float_safe/1, t_string_to_float_risky/1, + t_round/1, t_trunc/1 + ]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [t_abs, t_float, t_float_to_list, t_integer_to_list, - {group, t_list_to_float}, t_list_to_integer, t_round, + [t_abs, t_float, t_float_to_string, t_integer_to_string, + {group, t_string_to_float}, t_string_to_integer, t_round, t_trunc]. groups() -> - [{t_list_to_float, [], - [t_list_to_float_safe, t_list_to_float_risky]}]. + [{t_string_to_float, [], + [t_string_to_float_safe, t_string_to_float_risky]}]. init_per_suite(Config) -> Config. @@ -65,257 +69,382 @@ end_per_group(_GroupName, Config) -> t_abs(Config) when is_list(Config) -> %% Floats. - ?line 5.5 = abs(id(5.5)), - ?line 0.0 = abs(id(0.0)), - ?line 100.0 = abs(id(-100.0)), + 5.5 = abs(id(5.5)), + 0.0 = abs(id(0.0)), + 100.0 = abs(id(-100.0)), %% Integers. - ?line 5 = abs(id(5)), - ?line 0 = abs(id(0)), - ?line 100 = abs(id(-100)), + 5 = abs(id(5)), + 0 = abs(id(0)), + 100 = abs(id(-100)), %% The largest smallnum. OTP-3190. - ?line X = id((1 bsl 27) - 1), - ?line X = abs(X), - ?line X = abs(X-1)+1, - ?line X = abs(X+1)-1, - ?line X = abs(-X), - ?line X = abs(-X-1)-1, - ?line X = abs(-X+1)+1, + X = id((1 bsl 27) - 1), + X = abs(X), + X = abs(X-1)+1, + X = abs(X+1)-1, + X = abs(-X), + X = abs(-X-1)-1, + X = abs(-X+1)+1, %% Bignums. BigNum = id(13984792374983749), - ?line BigNum = abs(BigNum), - ?line BigNum = abs(-BigNum), + BigNum = abs(BigNum), + BigNum = abs(-BigNum), ok. t_float(Config) when is_list(Config) -> - ?line 0.0 = float(id(0)), - ?line 2.5 = float(id(2.5)), - ?line 0.0 = float(id(0.0)), - ?line -100.55 = float(id(-100.55)), - ?line 42.0 = float(id(42)), - ?line -100.0 = float(id(-100)), + 0.0 = float(id(0)), + 2.5 = float(id(2.5)), + 0.0 = float(id(0.0)), + -100.55 = float(id(-100.55)), + 42.0 = float(id(42)), + -100.0 = float(id(-100)), %% Bignums. - ?line 4294967305.0 = float(id(4294967305)), - ?line -4294967305.0 = float(id(-4294967305)), + 4294967305.0 = float(id(4294967305)), + -4294967305.0 = float(id(-4294967305)), %% Extremly big bignums. - ?line Big = id(list_to_integer(id(lists:duplicate(2000, $1)))), - ?line {'EXIT', {badarg, _}} = (catch float(Big)), - - %% Invalid types and lists. - ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id(atom))), - ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id(123))), - ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id([$1,[$2]]))), - ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id("1.2"))), - ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id("a"))), - ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id(""))), + Big = id(list_to_integer(id(lists:duplicate(2000, $1)))), + {'EXIT', {badarg, _}} = (catch float(Big)), + ok. -%% Tests float_to_list/1, float_to_list/2. - -t_float_to_list(Config) when is_list(Config) -> - test_ftl("0.0e+0", 0.0), - test_ftl("2.5e+1", 25.0), - test_ftl("2.5e+0", 2.5), - test_ftl("2.5e-1", 0.25), - test_ftl("-3.5e+17", -350.0e15), - "1.00000000000000000000e+00" = float_to_list(1.0), - "1.00000000000000000000e+00" = float_to_list(1.0, []), - "-1.00000000000000000000e+00" = float_to_list(-1.0, []), - "-1.00000000000000000000" = float_to_list(-1.0, [{decimals, 20}]), - {'EXIT', {badarg, _}} = (catch float_to_list(1.0, [{decimals, -1}])), - {'EXIT', {badarg, _}} = (catch float_to_list(1.0, [{decimals, 250}])), - {'EXIT', {badarg, _}} = (catch float_to_list(1.0e+300, [{decimals, 1}])), - "1.0e+300" = float_to_list(1.0e+300, [{scientific, 1}]), - "1.0" = float_to_list(1.0, [{decimals, 249}, compact]), - Expected = "1." ++ string:copies("0", 249) ++ "e+00", - Expected = float_to_list(1.0, [{scientific, 249}, compact]), +%% Tests float_to_list/1, float_to_list/2, float_to_binary/1, float_to_binary/2 + +t_float_to_string(Config) when is_list(Config) -> + test_fts("0.00000000000000000000e+00", 0.0), + test_fts("2.50000000000000000000e+01", 25.0), + test_fts("2.50000000000000000000e+00", 2.5), + test_fts("2.50000000000000000000e-01", 0.25), + test_fts("-3.50000000000000000000e+17", -350.0e15), + test_fts("1.00000000000000000000e+00",1.0), + test_fts("1.00000000000000000000e+00",1.0, []), + test_fts("-1.00000000000000000000e+00",-1.0, []), + test_fts("-1.00000000000000000000",-1.0, [{decimals, 20}]), + {'EXIT', {badarg, _}} = (catch float_to_list(1.0, [{decimals, -1}])), + {'EXIT', {badarg, _}} = (catch float_to_list(1.0, [{decimals, 254}])), + {'EXIT', {badarg, _}} = (catch float_to_list(1.0, [{scientific, 250}])), + {'EXIT', {badarg, _}} = (catch float_to_list(1.0e+300, [{decimals, 1}])), + {'EXIT', {badarg, _}} = (catch float_to_binary(1.0, [{decimals, -1}])), + {'EXIT', {badarg, _}} = (catch float_to_binary(1.0, [{decimals, 254}])), + {'EXIT', {badarg, _}} = (catch float_to_binary(1.0, [{scientific, 250}])), + {'EXIT', {badarg, _}} = (catch float_to_binary(1.0e+300, [{decimals, 1}])), + test_fts("1.0e+300",1.0e+300, [{scientific, 1}]), + test_fts("1.0",1.0, [{decimals, 249}, compact]), + test_fts("1",1.0,[{decimals,0}]), + test_fts("2",1.9,[{decimals,0}]), + test_fts("123456789012345680.0",123456789012345678.0, + [{decimals, 236}, compact]), + {'EXIT', {badarg, _}} = (catch float_to_list( + 123456789012345678.0, [{decimals, 237}])), + {'EXIT', {badarg, _}} = (catch float_to_binary( + 123456789012345678.0, [{decimals, 237}])), + test_fts("1." ++ string:copies("0", 249) ++ "e+00", + 1.0, [{scientific, 249}, compact]), X1 = float_to_list(1.0), X2 = float_to_list(1.0, [{scientific, 20}]), X1 = X2, - "1.000e+00" = float_to_list(1.0, [{scientific, 3}]), - "1.000" = float_to_list(1.0, [{decimals, 3}]), - "1.0" = float_to_list(1.0, [{decimals, 3}, compact]), - "1.12" = float_to_list(1.123, [{decimals, 2}]), - "1.123" = float_to_list(1.123, [{decimals, 3}]), - "1.123" = float_to_list(1.123, [{decimals, 3}, compact]), - "1.1230" = float_to_list(1.123, [{decimals, 4}]), - "1.12300" = float_to_list(1.123, [{decimals, 5}]), - "1.123" = float_to_list(1.123, [{decimals, 5}, compact]), - "1.1234" = float_to_list(1.1234,[{decimals, 6}, compact]), + + Y1 = float_to_binary(1.0), + Y2 = float_to_binary(1.0, [{scientific, 20}]), + Y1 = Y2, + + test_fts("1.000e+00",1.0, [{scientific, 3}]), + test_fts("1.000",1.0, [{decimals, 3}]), + test_fts("1.0",1.0, [{decimals, 1}]), + test_fts("1.0",1.0, [{decimals, 3}, compact]), + test_fts("1.12",1.123, [{decimals, 2}]), + test_fts("1.123",1.123, [{decimals, 3}]), + test_fts("1.123",1.123, [{decimals, 3}, compact]), + test_fts("1.1230",1.123, [{decimals, 4}]), + test_fts("1.12300",1.123, [{decimals, 5}]), + test_fts("1.123",1.123, [{decimals, 5}, compact]), + test_fts("1.1234",1.1234,[{decimals, 6}, compact]), + test_fts("1.01",1.005, [{decimals, 2}]), + test_fts("-1.01",-1.005,[{decimals, 2}]), + test_fts("0.999",0.999, [{decimals, 3}]), + test_fts("-0.999",-0.999,[{decimals, 3}]), + test_fts("1.0",0.999, [{decimals, 2}, compact]), + test_fts("-1.0",-0.999,[{decimals, 2}, compact]), + test_fts("0.5",0.5, [{decimals, 1}]), + test_fts("-0.5",-0.5, [{decimals, 1}]), "2.333333" = erlang:float_to_list(7/3, [{decimals, 6}, compact]), "2.333333" = erlang:float_to_list(7/3, [{decimals, 6}]), - "0.00000000000000000000e+00" = float_to_list(0.0, [compact]), - "0.0" = float_to_list(0.0, [{decimals, 10}, compact]), - "123000000000000000000.0" = float_to_list(1.23e20, [{decimals, 10}, compact]), - "1.2300000000e+20" = float_to_list(1.23e20, [{scientific, 10}, compact]), - "1.23000000000000000000e+20" = float_to_list(1.23e20, []), + <<"2.333333">> = erlang:float_to_binary(7/3, [{decimals, 6}, compact]), + <<"2.333333">> = erlang:float_to_binary(7/3, [{decimals, 6}]), + test_fts("0.00000000000000000000e+00",0.0, [compact]), + test_fts("0.0",0.0, [{decimals, 10}, compact]), + test_fts("123000000000000000000.0",1.23e20, [{decimals, 10}, compact]), + test_fts("1.2300000000e+20",1.23e20, [{scientific, 10}, compact]), + test_fts("1.23000000000000000000e+20",1.23e20, []), ok. -test_ftl(Expect, Float) -> - %% No ?line on the next line -- we want the line number from t_float_to_list. - Expect = remove_zeros(lists:reverse(float_to_list(Float)), []). - -%% Removes any non-significant zeros in a floating point number. -%% Example: 2.500000e+01 -> 2.5e+1 - -remove_zeros([$+, $e|Rest], [$0, X|Result]) -> - remove_zeros([$+, $e|Rest], [X|Result]); -remove_zeros([$-, $e|Rest], [$0, X|Result]) -> - remove_zeros([$-, $e|Rest], [X|Result]); -remove_zeros([$0, $.|Rest], [$e|Result]) -> - remove_zeros(Rest, [$., $0, $e|Result]); -remove_zeros([$0|Rest], [$e|Result]) -> - remove_zeros(Rest, [$e|Result]); -remove_zeros([Char|Rest], Result) -> - remove_zeros(Rest, [Char|Result]); -remove_zeros([], Result) -> - Result. - -%% Tests integer_to_list/1. - -t_integer_to_list(Config) when is_list(Config) -> - ?line "0" = integer_to_list(id(0)), - ?line "42" = integer_to_list(id(42)), - ?line "-42" = integer_to_list(id(-42)), - ?line "32768" = integer_to_list(id(32768)), - ?line "268435455" = integer_to_list(id(268435455)), - ?line "-268435455" = integer_to_list(id(-268435455)), - ?line "123456932798748738738" = integer_to_list(id(123456932798748738738)), - ?line Big_List = id(lists:duplicate(2000, id($1))), - ?line Big = list_to_integer(Big_List), - ?line Big_List = integer_to_list(Big), - ok. +test_fts(Expect, Float) -> + Expect = float_to_list(Float), + BinExpect = list_to_binary(Expect), + BinExpect = float_to_binary(Float). -%% Tests list_to_float/1. +test_fts(Expect, Float, Args) -> + Expect = float_to_list(Float,Args), + BinExpect = list_to_binary(Expect), + BinExpect = float_to_binary(Float,Args). -t_list_to_float_safe(Config) when is_list(Config) -> - ?line 0.0 = list_to_float(id("0.0")), - ?line 0.0 = list_to_float(id("-0.0")), - ?line 0.5 = list_to_float(id("0.5")), - ?line -0.5 = list_to_float(id("-0.5")), - ?line 100.0 = list_to_float(id("1.0e2")), - ?line 127.5 = list_to_float(id("127.5")), - ?line -199.5 = list_to_float(id("-199.5")), +%% Tests list_to_float/1. - ?line {'EXIT',{badarg,_}} = (catch list_to_float(id("0"))), - ?line {'EXIT',{badarg,_}} = (catch list_to_float(id("0..0"))), - ?line {'EXIT',{badarg,_}} = (catch list_to_float(id("0e12"))), - ?line {'EXIT',{badarg,_}} = (catch list_to_float(id("--0.0"))), +t_string_to_float_safe(Config) when is_list(Config) -> + test_stf(0.0,"0.0"), + test_stf(0.0,"-0.0"), + test_stf(0.5,"0.5"), + test_stf(-0.5,"-0.5"), + test_stf(100.0,"1.0e2"), + test_stf(127.5,"127.5"), + test_stf(-199.5,"-199.5"), + + {'EXIT',{badarg,_}} = (catch list_to_float(id("0"))), + {'EXIT',{badarg,_}} = (catch list_to_float(id("0..0"))), + {'EXIT',{badarg,_}} = (catch list_to_float(id("0e12"))), + {'EXIT',{badarg,_}} = (catch list_to_float(id("--0.0"))), + {'EXIT',{badarg,_}} = (catch binary_to_float(id(<<"0">>))), + {'EXIT',{badarg,_}} = (catch binary_to_float(id(<<"0..0">>))), + {'EXIT',{badarg,_}} = (catch binary_to_float(id(<<"0e12">>))), + {'EXIT',{badarg,_}} = (catch binary_to_float(id(<<"--0.0">>))), + + UBin = <<0:3,(id(<<"0.0">>))/binary,0:5>>, + <<_:3,UnAlignedBin:3/binary,0:5>> = id(UBin), + 0.0 = binary_to_float(UnAlignedBin), + + ABin = <<0:8,(id(<<"1.0">>))/binary,0:8>>, + <<_:8,AlignedBin:3/binary,0:8>> = id(ABin), + 1.0 = binary_to_float(AlignedBin), ok. %% This might crash the emulator... %% (Known to crash the Unix version of Erlang 4.4.1) -t_list_to_float_risky(Config) when is_list(Config) -> - ?line Many_Ones = lists:duplicate(25000, id($1)), - ?line id(list_to_float("2."++Many_Ones)), - ?line {'EXIT', {badarg, _}} = (catch list_to_float("2"++Many_Ones)), - ok. - -%% Tests list_to_integer/1. +t_string_to_float_risky(Config) when is_list(Config) -> + Many_Ones = lists:duplicate(25000, id($1)), + id(list_to_float("2."++Many_Ones)), + {'EXIT', {badarg, _}} = (catch list_to_float("2"++Many_Ones)), -t_list_to_integer(Config) when is_list(Config) -> - ?line 0 = list_to_integer(id("0")), - ?line 0 = list_to_integer(id("00")), - ?line 0 = list_to_integer(id("-0")), - ?line 1 = list_to_integer(id("1")), - ?line -1 = list_to_integer(id("-1")), - ?line 42 = list_to_integer(id("42")), - ?line -12 = list_to_integer(id("-12")), - ?line 32768 = list_to_integer(id("32768")), - ?line 268435455 = list_to_integer(id("268435455")), - ?line -268435455 = list_to_integer(id("-268435455")), - - %% Bignums. - ?line 123456932798748738738 = list_to_integer(id("123456932798748738738")), - ?line id(list_to_integer(lists:duplicate(2000, id($1)))), + id(binary_to_float(list_to_binary("2."++Many_Ones))), + {'EXIT', {badarg, _}} = (catch binary_to_float( + list_to_binary("2"++Many_Ones))), ok. +test_stf(Expect,List) -> + Expect = list_to_float(List), + Bin = list_to_binary(List), + Expect = binary_to_float(Bin). + %% Tests round/1. t_round(Config) when is_list(Config) -> - ?line 0 = round(id(0.0)), - ?line 0 = round(id(0.4)), - ?line 1 = round(id(0.5)), - ?line 0 = round(id(-0.4)), - ?line -1 = round(id(-0.5)), - ?line 255 = round(id(255.3)), - ?line 256 = round(id(255.6)), - ?line -1033 = round(id(-1033.3)), - ?line -1034 = round(id(-1033.6)), + 0 = round(id(0.0)), + 0 = round(id(0.4)), + 1 = round(id(0.5)), + 0 = round(id(-0.4)), + -1 = round(id(-0.5)), + 255 = round(id(255.3)), + 256 = round(id(255.6)), + -1033 = round(id(-1033.3)), + -1034 = round(id(-1033.6)), % OTP-3722: - ?line X = id((1 bsl 27) - 1), - ?line MX = -X, - ?line MXm1 = -X-1, - ?line MXp1 = -X+1, - ?line F = id(X + 0.0), - ?line X = round(F), - ?line X = round(F+1)-1, - ?line X = round(F-1)+1, - ?line MX = round(-F), - ?line MXm1 = round(-F-1), - ?line MXp1 = round(-F+1), - - ?line X = round(F+0.1), - ?line X = round(F+1+0.1)-1, - ?line X = round(F-1+0.1)+1, - ?line MX = round(-F+0.1), - ?line MXm1 = round(-F-1+0.1), - ?line MXp1 = round(-F+1+0.1), - - ?line X = round(F-0.1), - ?line X = round(F+1-0.1)-1, - ?line X = round(F-1-0.1)+1, - ?line MX = round(-F-0.1), - ?line MXm1 = round(-F-1-0.1), - ?line MXp1 = round(-F+1-0.1), - - ?line 0.5 = abs(round(F+0.5)-(F+0.5)), - ?line 0.5 = abs(round(F-0.5)-(F-0.5)), - ?line 0.5 = abs(round(-F-0.5)-(-F-0.5)), - ?line 0.5 = abs(round(-F+0.5)-(-F+0.5)), + X = id((1 bsl 27) - 1), + MX = -X, + MXm1 = -X-1, + MXp1 = -X+1, + F = id(X + 0.0), + X = round(F), + X = round(F+1)-1, + X = round(F-1)+1, + MX = round(-F), + MXm1 = round(-F-1), + MXp1 = round(-F+1), + + X = round(F+0.1), + X = round(F+1+0.1)-1, + X = round(F-1+0.1)+1, + MX = round(-F+0.1), + MXm1 = round(-F-1+0.1), + MXp1 = round(-F+1+0.1), + + X = round(F-0.1), + X = round(F+1-0.1)-1, + X = round(F-1-0.1)+1, + MX = round(-F-0.1), + MXm1 = round(-F-1-0.1), + MXp1 = round(-F+1-0.1), + + 0.5 = abs(round(F+0.5)-(F+0.5)), + 0.5 = abs(round(F-0.5)-(F-0.5)), + 0.5 = abs(round(-F-0.5)-(-F-0.5)), + 0.5 = abs(round(-F+0.5)-(-F+0.5)), %% Bignums. - ?line 4294967296 = round(id(4294967296.1)), - ?line 4294967297 = round(id(4294967296.9)), - ?line -4294967296 = -round(id(4294967296.1)), - ?line -4294967297 = -round(id(4294967296.9)), + 4294967296 = round(id(4294967296.1)), + 4294967297 = round(id(4294967296.9)), + -4294967296 = -round(id(4294967296.1)), + -4294967297 = -round(id(4294967296.9)), ok. t_trunc(Config) when is_list(Config) -> - ?line 0 = trunc(id(0.0)), - ?line 5 = trunc(id(5.3333)), - ?line -10 = trunc(id(-10.978987)), + 0 = trunc(id(0.0)), + 5 = trunc(id(5.3333)), + -10 = trunc(id(-10.978987)), % The largest smallnum, converted to float (OTP-3722): - ?line X = id((1 bsl 27) - 1), - ?line F = id(X + 0.0), + X = id((1 bsl 27) - 1), + F = id(X + 0.0), io:format("X = ~p/~w/~w, F = ~p/~w/~w, trunc(F) = ~p/~w/~w~n", [X, X, binary_to_list(term_to_binary(X)), F, F, binary_to_list(term_to_binary(F)), trunc(F), trunc(F), binary_to_list(term_to_binary(trunc(F)))]), - ?line X = trunc(F), - ?line X = trunc(F+1)-1, - ?line X = trunc(F-1)+1, - ?line X = -trunc(-F), - ?line X = -trunc(-F-1)-1, - ?line X = -trunc(-F+1)+1, + X = trunc(F), + X = trunc(F+1)-1, + X = trunc(F-1)+1, + X = -trunc(-F), + X = -trunc(-F-1)-1, + X = -trunc(-F+1)+1, %% Bignums. - ?line 4294967305 = trunc(id(4294967305.7)), - ?line -4294967305 = trunc(id(-4294967305.7)), + 4294967305 = trunc(id(4294967305.7)), + -4294967305 = trunc(id(-4294967305.7)), ok. + +%% Tests integer_to_binary/1. + +t_integer_to_string(Config) when is_list(Config) -> + test_its("0",0), + test_its("42",42), + test_its("-42",-42), + test_its("32768",32768), + test_its("268435455",268435455), + test_its("-268435455",-268435455), + test_its("123456932798748738738",123456932798748738738), + + %% 1 bsl 33, just beyond 32 bit + test_its("8589934592",8589934592), + test_its("-8589934592",-8589934592), + %% 1 bsl 65, just beyond 64 bit + test_its("36893488147419103232",36893488147419103232), + test_its("-36893488147419103232",-36893488147419103232), + + %% Bignums. + BigBin = id(list_to_binary(lists:duplicate(2000, id($1)))), + Big = erlang:binary_to_integer(BigBin), + BigBin = erlang:integer_to_binary(Big), + + %% Invalid types + lists:foreach(fun(Value) -> + {'EXIT', {badarg, _}} = + (catch erlang:integer_to_binary(Value)), + {'EXIT', {badarg, _}} = + (catch erlang:integer_to_list(Value)) + end,[atom,1.2,0.0,[$1,[$2]]]), + + ok. + +test_its(List,Int) -> + Int = list_to_integer(List), + Int = binary_to_integer(list_to_binary(List)). + +%% Tests binary_to_integer/1. + +t_string_to_integer(Config) when is_list(Config) -> + 0 = erlang:binary_to_integer(id(<<"00">>)), + 0 = erlang:binary_to_integer(id(<<"-0">>)), + 0 = erlang:binary_to_integer(id(<<"+0">>)), + + test_sti(0), + test_sti(1), + test_sti(-1), + test_sti(42), + test_sti(-12), + test_sti(32768), + test_sti(268435455), + test_sti(-268435455), + + %% 1 bsl 28 - 1, just before 32 bit bignum + test_sti(1 bsl 28 - 1), + %% 1 bsl 28, just beyond 32 bit small + test_sti(1 bsl 28), + %% 1 bsl 33, just beyond 32 bit + test_sti(1 bsl 33), + %% 1 bsl 60 - 1, just before 64 bit bignum + test_sti(1 bsl 60 - 1), + %% 1 bsl 60, just beyond 64 bit small + test_sti(1 bsl 60), + %% 1 bsl 65, just beyond 64 bit + test_sti(1 bsl 65), + %% Bignums. + test_sti(123456932798748738738,16), + test_sti(list_to_integer(lists:duplicate(2000, $1))), + + %% unalign string + Str = <<"10">>, + UnalignStr = <<0:3, (id(Str))/binary, 0:5>>, + <<_:3, SomeStr:2/binary, _:5>> = id(UnalignStr), + 10 = erlang:binary_to_integer(SomeStr), + + %% Invalid types + lists:foreach(fun(Value) -> + {'EXIT', {badarg, _}} = + (catch binary_to_integer(Value)), + {'EXIT', {badarg, _}} = + (catch erlang:list_to_integer(Value)) + end,[atom,1.2,0.0,[$1,[$2]]]), + + % Default base error cases + lists:foreach(fun(Value) -> + {'EXIT', {badarg, _}} = + (catch erlang:binary_to_integer( + list_to_binary(Value))), + {'EXIT', {badarg, _}} = + (catch erlang:list_to_integer(Value)) + end,["1.0"," 1"," -1",""]), + + % Custom base error cases + lists:foreach(fun({Value,Base}) -> + {'EXIT', {badarg, _}} = + (catch binary_to_integer( + list_to_binary(Value),Base)), + {'EXIT', {badarg, _}} = + (catch erlang:list_to_integer(Value,Base)) + end,[{" 1",1},{" 1",37},{"2",2},{"C",11}, + {"1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111z",16}, + {"1z111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111",16}, + {"111z11111111",16}]), + + ok. + +test_sti(Num) -> + [begin + io:format("Testing ~p:~p",[Num,Base]), + test_sti(Num,Base) + end|| Base <- lists:seq(2,36)]. + +test_sti(Num,Base) -> + Num = list_to_integer(int2list(Num,Base),Base), + Num = -1*list_to_integer(int2list(Num*-1,Base),Base), + Num = binary_to_integer(int2bin(Num,Base),Base), + Num = -1*binary_to_integer(int2bin(Num*-1,Base),Base). + % Calling this function (which is not supposed to be inlined) prevents % the compiler from calculating the answer, so we don't test the compiler % instead of the newest runtime system. id(X) -> X. + +%% Uses the printing library to to integer_to_binary conversions. +int2bin(Int,Base) when Base < 37 -> + iolist_to_binary(int2list(Int,Base)). + +int2list(Int,Base) when Base < 37 -> + lists:flatten(io_lib:format("~."++integer_to_list(Base)++"B",[Int])). diff --git a/erts/emulator/utils/gen_git_version b/erts/emulator/utils/gen_git_version new file mode 100755 index 0000000000..ef06a4b8e2 --- /dev/null +++ b/erts/emulator/utils/gen_git_version @@ -0,0 +1,39 @@ +#!/bin/sh + +OUTPUT_FILE=$1 + +if command -v git 2>&1 >/dev/null && + test -d $ERL_TOP/.git -o -f $ERL_TOP/.git +then + VSN=`git describe --match "OTP_R[0-9][0-9][A-B]*" HEAD` + case "$VSN" in + OTP_R*-g*) + VSN=`echo $VSN | sed -e 's/.*-g\\(.*\\)/\\1/g'` ;; + *) VSN="na" ;; + esac +else + VSN="na" +fi + + +# Only update the file if there has been a change to +# the version number. +if test -r $OUTPUT_FILE +then + VC=`sed -n -e 's/^.*"\\\\"\\(.*\\)\\\\"".*/\\1/p' < $OUTPUT_FILE` +else + VC=unset +fi + +if test "$VSN" != "$VC" +then + echo "# Automatically generated by $0 - DO NOT EDIT." > $OUTPUT_FILE + if test "$VSN" = "na" + then + echo "# GIT_VSN=-DERLANG_GIT_VERSION=\"\\\"$VSN\\\"\"" >> $OUTPUT_FILE + else + echo "GIT_VSN=-DERLANG_GIT_VERSION=\"\\\"$VSN\\\"\"" >> $OUTPUT_FILE + fi + exit 0 +fi +exit 1
\ No newline at end of file diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h index aef31e282a..6c006b3f07 100644 --- a/erts/include/internal/ethread.h +++ b/erts/include/internal/ethread.h @@ -59,10 +59,6 @@ # undef ETHR_TRY_INLINE_FUNCS #endif -#if !defined(ETHR_DISABLE_NATIVE_IMPLS) && (defined(PURIFY)||defined(VALGRIND)) -# define ETHR_DISABLE_NATIVE_IMPLS -#endif - /* Assume 64-byte cache line size */ #define ETHR_CACHE_LINE_SIZE 64 #define ETHR_CACHE_LINE_MASK (ETHR_CACHE_LINE_SIZE - 1) @@ -413,7 +409,11 @@ extern ethr_runtime_t ethr_runtime__; # endif #endif -#include "ethr_optimized_fallbacks.h" +#ifdef VALGRIND /* mutex as fallback for spinlock for VALGRIND */ +# undef ETHR_HAVE_NATIVE_SPINLOCKS +#else +# include "ethr_optimized_fallbacks.h" +#endif typedef struct { void *(*thread_create_prepare_func)(void); diff --git a/erts/lib_src/common/erl_printf_format.c b/erts/lib_src/common/erl_printf_format.c index 384b1b1ad7..00df3f068f 100644 --- a/erts/lib_src/common/erl_printf_format.c +++ b/erts/lib_src/common/erl_printf_format.c @@ -335,7 +335,7 @@ static int fmt_double(fmtfn_t fn,void*arg,double val, int fi = 0; char format_str[7]; char sbuf[32]; - char *bufp; + char *bufp = sbuf; double dexp; int exp; size_t max_size = 1; @@ -425,12 +425,12 @@ static int fmt_double(fmtfn_t fn,void*arg,double val, max_size++; /* '\0' */ - if (max_size < sizeof(sbuf)) - bufp = sbuf; - else { + if (max_size >= sizeof(sbuf)) { bufp = (char *) malloc(sizeof(char)*max_size); if (!bufp) { res = -ENOMEM; + /* Make sure not to trigger free */ + bufp = sbuf; goto out; } } @@ -448,10 +448,10 @@ static int fmt_double(fmtfn_t fn,void*arg,double val, res = fmt_fld(fn, arg, bufp, size, 0, width, 0, new_fmt, count); + out: if (bufp != sbuf) free((void *) bufp); - out: if (erts_printf_unblock_fpe) (*erts_printf_unblock_fpe)(fpe_was_unmasked); return res; diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex f8c2df3a5a..4a3af265c1 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 5b288ecc5c..50e87b3550 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex ca93edbe25..b64fe522e8 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl index d36fdeba3f..7490954f2d 100644 --- a/erts/preloaded/src/erl_prim_loader.erl +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -149,8 +149,18 @@ start_it("inet", Id, Pid, Hosts) -> start_it("efile", Id, Pid, _Hosts) -> process_flag(trap_exit, true), - {ok, Port} = prim_file:open([binary]), - init_ack(Pid), + {ok, Port} = prim_file:start(), + %% Check that we started in a valid directory. + case prim_file:get_cwd(Port) of + {error, _} -> + %% At this point in the startup, we have no error_logger at all. + Report = "Invalid current directory or invalid filename " + "mode: loader cannot read current directory\n", + erlang:display(Report), + exit({error, invalid_current_directory}); + _ -> + init_ack(Pid) + end, MultiGet = case erlang:system_info(thread_pool_size) of 0 -> false; _ -> true @@ -434,7 +444,7 @@ efile_multi_get_file_from_port2(_MFs, 0, _Max, State, _Paths, _Fun, _Ref, Ret) - efile_par_get_file(Ref, State, {Mod,File} = MF, Paths, Pid, Fun) -> %% One port for each file read in "parallel": - case prim_file:open([binary]) of + case prim_file:start() of {ok, Port} -> Port0 = State#state.data, State1 = State#state{data = Port}, diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 115e1b03c4..8e4a471a82 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -36,7 +36,8 @@ -export([set_cookie/2, get_cookie/0]). -export([nodes/0]). --export([list_to_integer/2,integer_to_list/2]). +-export([integer_to_list/2]). +-export([integer_to_binary/2]). -export([flush_monitor_message/2]). -export([set_cpu_topology/1, format_cpu_topology/1]). -export([await_proc_exit/3]). @@ -73,7 +74,9 @@ -export([adler32/1, adler32/2, adler32_combine/3, append_element/2]). -export([atom_to_binary/2, atom_to_list/1, binary_part/2, binary_part/3]). --export([binary_to_atom/2, binary_to_existing_atom/2, binary_to_list/1]). +-export([binary_to_atom/2, binary_to_existing_atom/2, binary_to_float/1]). +-export([binary_to_integer/1,binary_to_integer/2]). +-export([binary_to_list/1]). -export([binary_to_list/3, binary_to_term/1, binary_to_term/2]). -export([bit_size/1, bitsize/1, bitstr_to_list/1, bitstring_to_list/1]). -export([bump_reductions/1, byte_size/1, call_on_load_function/1]). @@ -84,18 +87,21 @@ -export([display_nl/0, display_string/1, dist_exit/3, erase/0, erase/1]). -export([error/1, error/2, exit/1, exit/2, external_size/1]). -export([external_size/2, finish_after_on_load/2, finish_loading/1, float/1]). --export([float_to_list/1, float_to_list/2]). +-export([float_to_binary/1, float_to_binary/2, + float_to_list/1, float_to_list/2]). -export([fun_info/2, fun_to_list/1, function_exported/3]). -export([garbage_collect/0, garbage_collect/1]). -export([garbage_collect_message_area/0, get/0, get/1, get_keys/1]). -export([get_module_info/1, get_stacktrace/0, group_leader/0]). -export([group_leader/2, halt/0, halt/1, halt/2, hash/2, hibernate/3]). -export([insert_element/3]). --export([integer_to_list/1, iolist_size/1, iolist_to_binary/1]). +-export([integer_to_binary/1, integer_to_list/1]). +-export([iolist_size/1, iolist_to_binary/1]). -export([is_alive/0, is_builtin/3, is_process_alive/1, length/1, link/1]). -export([list_to_atom/1, list_to_binary/1, list_to_bitstr/1]). -export([list_to_bitstring/1, list_to_existing_atom/1, list_to_float/1]). --export([list_to_integer/1, list_to_pid/1, list_to_tuple/1, loaded/0]). +-export([list_to_integer/1, list_to_integer/2]). +-export([list_to_pid/1, list_to_tuple/1, loaded/0]). -export([localtime/0, make_ref/0, match_spec_test/3, md5/1, md5_final/1]). -export([md5_init/0, md5_update/2, module_loaded/1, monitor/2]). -export([monitor_node/2, monitor_node/3, nif_error/1, nif_error/2 @@ -317,6 +323,25 @@ binary_to_atom(_Binary, _Encoding) -> binary_to_existing_atom(_Binary, _Encoding) -> erlang:nif_error(undefined). +%% binary_to_float/1 +-spec binary_to_float(Binary) -> float() when + Binary :: binary(). +binary_to_float(_Binary) -> + erlang:nif_error(undefined). + +%% binary_to_integer/1 +-spec binary_to_integer(Binary) -> integer() when + Binary :: binary(). +binary_to_integer(_Binary) -> + erlang:nif_error(undefined). + +%% binary_to_integer/2 +-spec binary_to_integer(Binary,Base) -> integer() when + Binary :: binary(), + Base :: 2..36. +binary_to_integer(_Binary,_Base) -> + erlang:nif_error(undefined). + %% binary_to_list/1 -spec binary_to_list(Binary) -> [byte()] when Binary :: binary(). @@ -706,6 +731,22 @@ finish_after_on_load(_P1, _P2) -> float(_Number) -> erlang:nif_error(undefined). +%% float_to_binary/1 +-spec float_to_binary(Float) -> binary() when + Float :: float(). +float_to_binary(_Float) -> + erlang:nif_error(undefined). + +%% float_to_binary/2 +-spec float_to_binary(Float, Options) -> binary() when + Float :: float(), + Options :: [Option], + Option :: {decimals, Decimals :: 0..253} | + {scientific, Decimals :: 0..249} | + compact. +float_to_binary(_Float, _Options) -> + erlang:nif_error(undefined). + %% float_to_list/1 -spec float_to_list(Float) -> string() when Float :: float(). @@ -716,8 +757,8 @@ float_to_list(_Float) -> -spec float_to_list(Float, Options) -> string() when Float :: float(), Options :: [Option], - Option :: {decimals, non_neg_integer()} | - {scientific, non_neg_integer()} | + Option :: {decimals, Decimals :: 0..253} | + {scientific, Decimals :: 0..249} | compact. float_to_list(_Float, _Options) -> erlang:nif_error(undefined). @@ -850,6 +891,12 @@ hibernate(_Module, _Function, _Args) -> insert_element(_Index, _Tuple1, _Term) -> erlang:nif_error(undefined). +%% integer_to_binary/1 +-spec integer_to_binary(Integer) -> binary() when + Integer :: integer(). +integer_to_binary(_Integer) -> + erlang:nif_error(undefined). + %% integer_to_list/1 -spec integer_to_list(Integer) -> string() when Integer :: integer(). @@ -942,6 +989,13 @@ list_to_float(_String) -> list_to_integer(_String) -> erlang:nif_error(undefined). +%% list_to_integer/2 +-spec list_to_integer(String, Base) -> integer() when + String :: string(), + Base :: 2..36. +list_to_integer(_String,_Base) -> + erlang:nif_error(undefined). + %% list_to_pid/1 -spec list_to_pid(String) -> pid() when String :: string(). @@ -2838,51 +2892,32 @@ integer_to_list(I0, Base, R0) -> integer_to_list(I1, Base, R1) end. - --spec list_to_integer(String, Base) -> integer() when - String :: string(), +-spec integer_to_binary(Integer, Base) -> binary() when + Integer :: integer(), Base :: 2..36. -list_to_integer(L, 10) -> - erlang:list_to_integer(L); -list_to_integer(L, Base) - when erlang:is_list(L), erlang:is_integer(Base), +integer_to_binary(I, 10) -> + erlang:integer_to_binary(I); +integer_to_binary(I, Base) + when erlang:is_integer(I), erlang:is_integer(Base), Base >= 2, Base =< 1+$Z-$A+10 -> - case list_to_integer_sign(L, Base) of - I when erlang:is_integer(I) -> - I; - Fault -> - erlang:error(Fault, [L,Base]) - end; -list_to_integer(L, Base) -> - erlang:error(badarg, [L,Base]). - -list_to_integer_sign([$-|[_|_]=L], Base) -> - case list_to_integer(L, Base, 0) of - I when erlang:is_integer(I) -> - -I; - I -> - I + if I < 0 -> + <<"$-",(integer_to_binary(-I, Base, []))/binary>>; + true -> + integer_to_binary(I, Base, <<>>) end; -list_to_integer_sign([$+|[_|_]=L], Base) -> - list_to_integer(L, Base, 0); -list_to_integer_sign([_|_]=L, Base) -> - list_to_integer(L, Base, 0); -list_to_integer_sign(_, _) -> - badarg. - -list_to_integer([D|L], Base, I) - when erlang:is_integer(D), D >= $0, D =< $9, D < Base+$0 -> - list_to_integer(L, Base, I*Base + D-$0); -list_to_integer([D|L], Base, I) - when erlang:is_integer(D), D >= $A, D < Base+$A-10 -> - list_to_integer(L, Base, I*Base + D-$A+10); -list_to_integer([D|L], Base, I) - when erlang:is_integer(D), D >= $a, D < Base+$a-10 -> - list_to_integer(L, Base, I*Base + D-$a+10); -list_to_integer([], _, I) -> - I; -list_to_integer(_, _, _) -> - badarg. +integer_to_binary(I, Base) -> + erlang:error(badarg, [I, Base]). + +integer_to_binary(0, _Base, R0) -> + R0; +integer_to_binary(I0, Base, R0) -> + D = I0 rem Base, + I1 = I0 div Base, + if D >= 10 -> + integer_to_binary(I1,Base,<<(D-10+$A),R0/binary>>); + true -> + integer_to_binary(I1,Base,<<(D+$0),R0/binary>>) + end. %% erlang:flush_monitor_message/2 is for internal use only! %% diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl index 50adf9c89d..b40a6d9633 100644 --- a/erts/preloaded/src/prim_file.erl +++ b/erts/preloaded/src/prim_file.erl @@ -50,9 +50,9 @@ write_file_info/2, write_file_info/3, write_file_info/4, make_link/2, make_link/3, make_symlink/2, make_symlink/3, - read_link/1, read_link/2, + read_link/1, read_link/2, read_link_all/1, read_link_all/2, read_link_info/1, read_link_info/2, read_link_info/3, - list_dir/1, list_dir/2]). + list_dir/1, list_dir/2, list_dir_all/1, list_dir_all/2]). %% How to start and stop the ?DRV port. -export([start/0, stop/1]). @@ -152,16 +152,19 @@ -export([internal_name2native/1, internal_native2name/1, - internal_normalize_utf8/1]). + internal_normalize_utf8/1, + is_translatable/1]). -type prim_file_name() :: string() | unicode:unicode_binary(). +-type prim_file_name_error() :: 'error' | 'ignore' | 'warning'. -spec internal_name2native(prim_file_name()) -> binary(). internal_name2native(_) -> erlang:nif_error(undefined). --spec internal_native2name(binary()) -> prim_file_name(). +-spec internal_native2name(binary()) -> + prim_file_name() | {'error',prim_file_name_error()}. internal_native2name(_) -> erlang:nif_error(undefined). @@ -171,6 +174,11 @@ internal_native2name(_) -> internal_normalize_utf8(_) -> erlang:nif_error(undefined). +-spec is_translatable(prim_file_name()) -> boolean(). + +is_translatable(_) -> + erlang:nif_error(undefined). + %%% End of BIFs %%%----------------------------------------------------------------- @@ -210,12 +218,7 @@ open(_, _) -> %% Opens a port that can be used for open/3 or read_file/2. %% Returns {ok, Port} | {error, Reason}. open(Portopts) when is_list(Portopts) -> - case drv_open(?FD_DRV, Portopts) of - {error, _} = Error -> - Error; - Other -> - Other - end; + drv_open(?FD_DRV, [binary|Portopts]); open(_) -> {error, badarg}. @@ -607,13 +610,7 @@ sendfile(#file_descriptor{module = ?MODULE, data = {Port, _}}, %% Returns {ok, Port}, the Port should be used as first argument in all %% the following functions. Returns {error, Reason} upon failure. start() -> - try erlang:open_port({spawn, ?DRV}, [binary]) of - Port -> - {ok, Port} - catch - error:Reason -> - {error, Reason} - end. + drv_open(?DRV, [binary]). stop(Port) when is_port(Port) -> try erlang:port_close(Port) of @@ -667,7 +664,8 @@ get_cwd_int(Drive) -> get_cwd_int({?DRV, [binary]}, Drive). get_cwd_int(Port, Drive) -> - drv_command(Port, <<?FILE_PWD, Drive>>). + drv_command(Port, <<?FILE_PWD, Drive>>, + fun handle_fname_response/1). @@ -679,10 +677,17 @@ set_cwd(Dir) -> set_cwd(Port, Dir) when is_port(Port) -> set_cwd_int(Port, Dir). -set_cwd_int(Port, Dir) -> - %% Dir is now either a string or an EXIT tuple. - %% An EXIT tuple will fail in the following catch. - drv_command(Port, [?FILE_CHDIR, pathname(Dir)]). +set_cwd_int(Port, Dir) when is_binary(Dir) -> + case prim_file:is_translatable(Dir) of + false -> + {error, no_translation}; + true -> + drv_command(Port, [?FILE_CHDIR, pathname(Dir)]) + end; +set_cwd_int(Port, Dir) when is_list(Dir) -> + drv_command(Port, [?FILE_CHDIR, pathname(Dir)]); +set_cwd_int(_, _) -> + {error, badarg}. @@ -775,7 +780,8 @@ altname(Port, File) when is_port(Port) -> altname_int(Port, File). altname_int(Port, File) -> - drv_command(Port, [?FILE_ALTNAME, pathname(File)]). + drv_command(Port, [?FILE_ALTNAME, pathname(File)], + fun handle_fname_response/1). %% write_file_info/{2,3,4} @@ -868,7 +874,20 @@ read_link(Port, Link) when is_port(Port) -> read_link_int(Port, Link). read_link_int(Port, Link) -> - drv_command(Port, [?FILE_READLINK, pathname(Link)]). + drv_command(Port, [?FILE_READLINK, pathname(Link)], + fun handle_fname_response/1). + +%% read_link_all/{2,3} + +read_link_all(Link) -> + read_link_all_int({?DRV, [binary]}, Link). + +read_link_all(Port, Link) when is_port(Port) -> + read_link_all_int(Port, Link). + +read_link_all_int(Port, Link) -> + drv_command(Port, [?FILE_READLINK, pathname(Link)], + fun handle_fname_response_all/1). @@ -910,20 +929,112 @@ list_dir(Port, Dir) when is_port(Port) -> list_dir_int(Port, Dir). list_dir_int(Port, Dir) -> - drv_command(Port, [?FILE_READDIR, pathname(Dir)], []). - + drv_command(Port, [?FILE_READDIR, pathname(Dir)], + fun(P) -> + case list_dir_response(P, []) of + {ok, RawNames} -> + {ok, list_dir_convert(RawNames)}; + Error -> + Error + end + end). + +list_dir_all(Dir) -> + list_dir_all_int({?DRV, [binary]}, Dir). + +list_dir_all(Port, Dir) when is_port(Port) -> + list_dir_all_int(Port, Dir). + +list_dir_all_int(Port, Dir) -> + drv_command(Port, [?FILE_READDIR, pathname(Dir)], + fun(P) -> + case list_dir_response(P, []) of + {ok, RawNames} -> + {ok, list_dir_convert_all(RawNames)}; + Error -> + Error + end + end). + +list_dir_response(Port, Acc0) -> + case drv_get_response(Port) of + {lfname, []} -> + {ok, Acc0}; + {lfname, Names} -> + Acc = [Name || <<L:16,Name:L/binary>> <= Names] ++ Acc0, + list_dir_response(Port, Acc); + Error -> + Error + end. +list_dir_convert([Name|Names]) -> + %% If the filename cannot be converted, return error or ignore + %% with optional error logger warning, depending on +fn{u|a}{i|e|w} + %% emulator switches. + case prim_file:internal_native2name(Name) of + {error, warning} -> + error_logger:warning_msg("Non-unicode filename ~p ignored\n", + [Name]), + list_dir_convert(Names); + {error, ignore} -> + list_dir_convert(Names); + {error, error} -> + {error, {no_translation, Name}}; + Converted when is_list(Converted) -> + [Converted|list_dir_convert(Names)] + end; +list_dir_convert([]) -> []. + +list_dir_convert_all([Name|Names]) -> + %% If the filename cannot be converted, retain the filename as + %% a binary. + case prim_file:internal_native2name(Name) of + {error, _} -> + [Name|list_dir_convert_all(Names)]; + Converted when is_list(Converted) -> + [Converted|list_dir_convert_all(Names)] + end; +list_dir_convert_all([]) -> []. %%%----------------------------------------------------------------- %%% Functions to communicate with the driver +handle_fname_response(Port) -> + case drv_get_response(Port) of + {fname, Name} -> + case prim_file:internal_native2name(Name) of + {error, warning} -> + error_logger:warning_msg("Non-unicode filename ~p " + "ignored when reading link\n", + [Name]), + {error, einval}; + {error, _} -> + {error, einval}; + Converted when is_list(Converted) -> + {ok, Converted} + end; + Error -> + Error + end. +handle_fname_response_all(Port) -> + case drv_get_response(Port) of + {fname, Name} -> + case prim_file:internal_native2name(Name) of + {error, _} -> + {ok, Name}; + Converted when is_list(Converted) -> + {ok, Converted} + end; + Error -> + Error + end. %% Opens a driver port and converts any problems into {error, emfile}. %% Returns {ok, Port} when successful. drv_open(Driver, Portopts) -> - try erlang:open_port({spawn, Driver}, Portopts) of + try erlang:open_port({spawn_driver, Driver}, Portopts) of Port -> {ok, Port} catch @@ -1028,19 +1139,10 @@ drv_command_nt(Port, Command, R) when is_port(Port) -> %% Receives the response from a driver port. %% Returns: {ok, ListOrBinary}|{error, Reason} -drv_get_response(Port, R) when is_list(R) -> - case drv_get_response(Port) of - ok -> - {ok, R}; - {ok, Name} -> - drv_get_response(Port, [Name|R]); - {append, Names} -> - drv_get_response(Port, append(Names, R)); - Error -> - Error - end; -drv_get_response(Port, _) -> - drv_get_response(Port). +drv_get_response(Port, undefined) -> + drv_get_response(Port); +drv_get_response(Port, Fun) when is_function(Fun, 1) -> + Fun(Port). drv_get_response(Port) -> erlang:bump_reductions(100), @@ -1060,10 +1162,6 @@ drv_get_response(Port) -> %%%----------------------------------------------------------------- %%% Utility functions. -append([I | Is], R) when is_list(R) -> append(Is, [I | R]); -append([], R) -> R. - - %% Converts a list of mode atoms into a mode word for the driver. %% Returns {Mode, Portopts, Setopts} where Portopts is a list of %% options for erlang:open_port/2 and Setopts is a list of @@ -1205,18 +1303,10 @@ translate_response(?FILE_RESP_N2DATA = X, L0) when is_list(L0) -> end; translate_response(?FILE_RESP_EOF, []) -> eof; -translate_response(?FILE_RESP_FNAME, []) -> - ok; -translate_response(?FILE_RESP_FNAME, Data) when is_binary(Data) -> - {ok, prim_file:internal_native2name(Data)}; translate_response(?FILE_RESP_FNAME, Data) -> - {ok, Data}; -translate_response(?FILE_RESP_LFNAME, []) -> - ok; -translate_response(?FILE_RESP_LFNAME, Data) when is_binary(Data) -> - {append, transform_lfname(Data)}; + {fname, Data}; translate_response(?FILE_RESP_LFNAME, Data) -> - {append, transform_lfname(Data)}; + {lfname, Data}; translate_response(?FILE_RESP_ALL_DATA, Data) -> {ok, Data}; translate_response(X, Data) -> @@ -1332,16 +1422,6 @@ transform_ldata(0, List, [Size | Sizes], R) -> {Front, Rear} = lists_split(List, Size), transform_ldata(0, Rear, Sizes, [Front | R]). -transform_lfname(<<>>) -> []; -transform_lfname(<<L:16, Name:L/binary, Names/binary>>) -> - [ prim_file:internal_native2name(Name) | transform_lfname(Names)]; -transform_lfname([]) -> []; -transform_lfname([L1,L2|Names]) -> - L = (L1 bsl 8) bor L2, - {Name, Rest} = lists_split(Names, L), - [Name | transform_lfname(Rest)]. - - lists_split(List, 0) when is_list(List) -> {[], List}; lists_split(List, N) when is_list(List), is_integer(N), N < 0 -> diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index 51f07b5432..374255bbe6 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -273,7 +273,7 @@ call_to_size_1(Config) when is_list(Config) -> Server = ?config(xref_server, Config), %% Applications that do not call erlang:size/1: - Apps = [compiler,debugger,kernel,observer,parsetools, + Apps = [asn1,compiler,debugger,kernel,observer,parsetools, runtime_tools,stdlib,tools,webtool], Fs = [{erlang,size,1}], diff --git a/lib/Makefile b/lib/Makefile index 64b17a3cca..6a12334d8d 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -20,18 +20,17 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk ERTS_SUB_DIRECTORIES = stdlib sasl kernel compiler -OTHER_SUB_DIRECTORIES = tools test_server common_test runtime_tools +OTHER_SUB_DIRECTORIES = tools test_server common_test runtime_tools \ + inets xmerl edoc erl_docgen ifdef BUILD_ALL OTHER_SUB_DIRECTORIES += \ snmp otp_mibs appmon erl_interface asn1 jinterface \ - wx debugger reltool gs inets \ + wx debugger reltool gs \ ic mnesia crypto orber os_mon parsetools syntax_tools \ - pman public_key ssl toolbar tv observer odbc \ - diameter \ + pman public_key ssl toolbar tv observer odbc diameter \ cosTransactions cosEvent cosTime cosNotification \ cosProperty cosFileTransfer cosEventDomain et megaco webtool \ - xmerl edoc eunit ssh typer erl_docgen \ - percept eldap dialyzer hipe + eunit ssh typer percept eldap dialyzer hipe EXTRA_FILE := $(wildcard EXTRA-APPLICATIONS) EXTRA_APPLICATIONS := $(if $(EXTRA_FILE),$(shell cat $(EXTRA_FILE))) endif diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index dd77085c39..452862fcee 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -1263,13 +1263,13 @@ check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) -> check_object_list(S,ClassRef,Objs,[{{no_mod,no_name},Def}|Acc]); {'ObjectSetFromObjects',Os,FieldName} when is_tuple(Os) -> NewSet = - check_ObjectSetFromObjects(S,element(size(Os),Os), + check_ObjectSetFromObjects(S, element(tuple_size(Os), Os), FieldName,[]), check_object_list(S,ClassRef,Objs,NewSet++Acc); {{'ObjectSetFromObjects',Os,FieldName},InterSection} when is_tuple(Os) -> NewSet = - check_ObjectSetFromObjects(S, element(size(Os),Os), + check_ObjectSetFromObjects(S, element(tuple_size(Os), Os), FieldName,InterSection), check_object_list(S,ClassRef,Objs,NewSet++Acc); Other -> @@ -1570,7 +1570,7 @@ gen_incl_set(S,Fields,#typedef{typespec=#type{def=Eref}}) gen_incl_set(S,Fields,CDef); gen_incl_set(S,Fields,ClassDef) -> case catch get_unique_fieldname(S,ClassDef) of - Tuple when is_tuple(Tuple), size(Tuple) =:= 3 -> + Tuple when tuple_size(Tuple) =:= 3 -> false; _ -> gen_incl_set1(S,Fields, @@ -1589,7 +1589,7 @@ gen_incl_set1(_,['EXTENSIONMARK'],_) -> gen_incl_set1(_,['EXTENSIONMARK'|_],_) -> true; gen_incl_set1(S,[Object|Rest],CFields)-> - Fields = element(size(Object),Object), + Fields = element(tuple_size(Object), Object), case gen_incl1(S,Fields,CFields) of true -> true; @@ -3028,7 +3028,7 @@ is_record_normalized(S,Name,V = #'Externalvaluereference'{},NumComps) -> _ -> false end; is_record_normalized(_S,Name,Value,NumComps) when is_tuple(Value) -> - (size(Value) =:= (NumComps + 1)) andalso (element(1,Value)=:=Name); + (tuple_size(Value) =:= (NumComps + 1)) andalso (element(1, Value) =:= Name); is_record_normalized(_,_,_,_) -> false. @@ -3720,7 +3720,7 @@ maybe_open_type(S,ClassSpec=#objectclass{fields=Fs}, {typefieldreference,_} -> case {catch get_unique_fieldname(S,#classdef{typespec=ClassSpec}), asn1ct_gen:get_constraint(Constr,componentrelation)}of - {Tuple,_} when is_tuple(Tuple), size(Tuple) =:= 3 -> + {Tuple,_} when tuple_size(Tuple) =:= 3 -> OCFT#'ObjectClassFieldType'{fieldname=FieldNames, type='ASN1_OPEN_TYPE'}; {_,no} -> @@ -4167,7 +4167,7 @@ check_constraint(S,Ext) when is_record(Ext,'Externaltypereference') -> check_constraint(S,{'SizeConstraint',{Lb,Ub}}) - when is_list(Lb);is_tuple(Lb),size(Lb)==2 -> + when is_list(Lb); tuple_size(Lb) =:= 2 -> NewLb = range_check(resolv_tuple_or_list(S,Lb)), NewUb = range_check(resolv_tuple_or_list(S,Ub)), {'SizeConstraint',{NewLb,NewUb}}; @@ -5217,7 +5217,7 @@ imported1(_Name,[]) -> check_integer(_S,[],_C) -> []; check_integer(S,NamedNumberList,_C) -> - case [X||X<-NamedNumberList,is_tuple(X),size(X)=:=2] of + case [X || X <- NamedNumberList, tuple_size(X) =:= 2] of NamedNumberList -> %% An already checked integer with NamedNumberList NamedNumberList; diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index e82212f0d8..341a04761b 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -528,14 +528,7 @@ gen_decode_sof(Erules,TypeName,_InnerTypeName,D) when is_record(D,type) -> Atom when is_atom(Atom) -> Atom; _ -> TypeNameSuffix end, -%% fix me - ObjFun = - case D#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - [] - end, + ObjFun = false, gen_dec_line(Erules,TypeName,ContName,[],Cont,mandatory,ObjFun), %% gen_dec_line_sof(Erules,Typename,ContName,Cont,ObjFun), emit([" || ",{curr,v}," <- ",{curr,tlv},"].",nl,nl,nl]). diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index ebc52df1d9..76c4182160 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -657,9 +657,13 @@ gen_check_sof(Name,SOF,Type) -> end, emit({" ",{asis,NewName},"(DVs,Vs).",nl,nl}). +gen_check_sequence(Name, []) -> + emit([{asis,ensure_atom(Name)},"(_,_) ->",nl, + " throw(badval).",nl,nl]); gen_check_sequence(Name,Components) -> emit([{asis,ensure_atom(Name)},"(DefaultValue,Value) ->",nl]), gen_check_sequence(Name,Components,1). + gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) -> InnerType = get_inner(Type#type.def), NthDefV = ["element(",Num+1,",DefaultValue)"], @@ -671,9 +675,7 @@ gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) -> _ -> emit({",",nl}), gen_check_sequence(Name,Cs,Num+1) - end; -gen_check_sequence(_,[],_) -> - ok. + end. gen_check_choice(Name,CList=[#'ComponentType'{}|_Cs]) -> emit([{asis,ensure_atom(Name)},"({Id,DefaultValue},{Id,Value}) ->",nl]), diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index f3a2486565..de0adef2b2 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -1162,7 +1162,7 @@ gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), emit({indent(3),"fun(_, Val, _RestPrimFieldName) ->",nl}), emit({indent(6),"Len = case Val of",nl,indent(9), - "Bin when is_binary(Bin) -> size(Bin);",nl,indent(9), + "Bin when is_binary(Bin) -> byte_size(Bin);",nl,indent(9), "_ -> length(Val)",nl,indent(6),"end,"}), emit({indent(6),"{Val,Len}",nl}), emit({indent(3),"end.",nl,nl}), @@ -1270,7 +1270,7 @@ gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName, %% treatment. emit([";",nl,indent(9),{asis,Name}," ->",nl]), emit([indent(12),"Len = case Val of",nl, - indent(15),"Bin when is_binary(Bin) -> size(Bin);",nl, + indent(15),"Bin when is_binary(Bin) -> byte_size(Bin);",nl, indent(15),"_ -> length(Val)",nl,indent(12),"end,",nl, indent(12),"{Val,Len}"]), {Acc,0} @@ -1449,7 +1449,7 @@ gen_inlined_dec_funs(Fields,[{typefield,Name,Prop}|Rest], nl,indent(6),"case Type of",nl, indent(9),{asis,Name}," ->",nl, indent(12),"Len = case Bytes of",nl, - indent(15),"B when is_binary(B) -> size(B);",nl, + indent(15),"B when is_binary(B) -> byte_size(B);",nl, indent(15),"_ -> length(Bytes)",nl, indent(12),"end,",nl, indent(12),"{Bytes,[],Len}"]), diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 0d6620667f..fac233532b 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -1174,12 +1174,12 @@ gen_dec_imm_1('UTF8String', _Constraint, Aligned) -> asn1ct_imm:per_dec_restricted_string(Aligned); gen_dec_imm_1('REAL', _Constraint, Aligned) -> asn1ct_imm:per_dec_real(Aligned); -gen_dec_imm_1(#'ObjectClassFieldType'{}=TypeName, Constraint, Aligned) -> +gen_dec_imm_1(#'ObjectClassFieldType'{}=TypeName, _Constraint, Aligned) -> case asn1ct_gen:get_inner(TypeName) of - {fixedtypevaluefield,_,InnerType} -> - gen_dec_imm_1(InnerType, Constraint, Aligned); - T -> - gen_dec_imm_1(T, Constraint, Aligned) + {fixedtypevaluefield,_,#type{def=InnerType,constraint=C}} -> + gen_dec_imm_1(InnerType, C, Aligned); + #type{def=T,constraint=C} -> + gen_dec_imm_1(T, C, Aligned) end. gen_dec_bit_string(F, Imm) -> diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl index 5a409295fb..81d8cdcae6 100644 --- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl +++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl @@ -610,9 +610,9 @@ gen_encode_objectfields(Erules,ClassName,[{typefield,Name,OptOrMand}|Rest], emit([" if",nl, " is_list(Val) ->",nl, " NewVal = list_to_binary(Val),",nl, - " [20,size(NewVal),NewVal];",nl, + " [20,byte_size(NewVal),NewVal];",nl, " is_binary(Val) ->",nl, - " [20,size(Val),Val]",nl, + " [20,byte_size(Val),Val]",nl, " end"]), []; {false,{'DEFAULT',DefaultType}} -> @@ -989,7 +989,7 @@ gen_objset_enc(_Erule,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, emit({indent(9),"is_list(Val) -> list_to_binary(Val);",nl}), emit({indent(9),"true -> Val",nl}), emit({indent(6),"end,",nl}), - emit({indent(6),"Size = size(BinVal),",nl}), + emit({indent(6),"Size = byte_size(BinVal),",nl}), emit({indent(6),"if",nl}), emit({indent(9),"Size < 256 ->",nl}), emit({indent(12),"[20,Size,BinVal];",nl}), diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl index 88292aca99..5fbf116747 100644 --- a/lib/asn1/src/asn1rtt_ber.erl +++ b/lib/asn1/src/asn1rtt_ber.erl @@ -868,7 +868,7 @@ remove_unused_then_dotag(TagIn,Unused,BinBits) -> encode_tags(TagIn, <<0>>, 1); 0 -> Bin = <<Unused,BinBits/binary>>, - encode_tags(TagIn,Bin,size(Bin)); + encode_tags(TagIn, Bin, byte_size(Bin)); Num -> N = byte_size(BinBits)-1, <<BBits:N/binary,LastByte>> = BinBits, diff --git a/lib/asn1/src/asn1rtt_per.erl b/lib/asn1/src/asn1rtt_per.erl index d02f4f548e..84ff809912 100644 --- a/lib/asn1/src/asn1rtt_per.erl +++ b/lib/asn1/src/asn1rtt_per.erl @@ -613,11 +613,11 @@ bit_string_trailing_zeros1(BitList,Lb,Ub) -> encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) when is_integer(C),C=<16 -> range_check(C, bit_size(BinBits) - Unused), - [45,C,size(BinBits),BinBits]; + [45,C,byte_size(BinBits),BinBits]; encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) when is_integer(C), C =< 255 -> range_check(C, bit_size(BinBits) - Unused), - [2,45,C,size(BinBits),BinBits]; + [2,45,C,byte_size(BinBits),BinBits]; encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) when is_integer(C), C =< 65535 -> range_check(C, bit_size(BinBits) - Unused), diff --git a/lib/asn1/src/asn1rtt_real_common.erl b/lib/asn1/src/asn1rtt_real_common.erl index 540f0d60a5..d1668f68b2 100644 --- a/lib/asn1/src/asn1rtt_real_common.erl +++ b/lib/asn1/src/asn1rtt_real_common.erl @@ -88,7 +88,7 @@ encode_real(_C, {Mantissa, Base, Exponent}) when Base =:= 2 -> end, %% ok = io:format("SignBitMask: ~w~n",[SignBitMask]), SFactor = 0, - OctExpLen = size(OctExp), + OctExpLen = byte_size(OctExp), if OctExpLen > 255 -> exit({error,{asn1, {to_big_exp_in_encode_real, OctExpLen}}}); true -> true %% make real assert later.. diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile index 1fa495d8f1..10f8e2833b 100644 --- a/lib/asn1/test/Makefile +++ b/lib/asn1/test/Makefile @@ -109,6 +109,7 @@ MODULES= \ test_modified_x420 \ testX420 \ test_x691 \ + testWSParamClass \ asn1_test_lib \ asn1_app_test \ asn1_appup_test \ diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index be9b82cddf..62418e554e 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -86,6 +86,7 @@ groups() -> testInvokeMod, per, ber_other, + der, h323test, per_GeneralString]}, testChoPrim, @@ -166,13 +167,13 @@ groups() -> testINSTANCE_OF, testTCAP, test_ParamTypeInfObj, - test_WS_ParamClass, test_Defed_ObjectIdentifier, testSelectionType, testSSLspecs, testNortel, - % Uses 'PKCS7' - {group, [], [test_modified_x420, + % Uses 'PKCS7', 'InformationFramework' + {group, [], [test_WS_ParamClass, + test_modified_x420, testX420]}, testTcapsystem, testNBAPsystem, @@ -200,8 +201,6 @@ parallel(Options) -> %%------------------------------------------------------------------------------ init_per_suite(Config) -> - PrivDir = ?config(priv_dir, Config), - true = code:add_patha(PrivDir), Config. end_per_suite(_Config) -> @@ -214,7 +213,7 @@ end_per_group(_GroupName, Config) -> Config. init_per_testcase(Func, Config) -> - CaseDir = filename:join([?config(priv_dir, Config), ?MODULE, Func]), + CaseDir = filename:join(?config(priv_dir, Config), Func), ok = filelib:ensure_dir(filename:join([CaseDir, dummy_file])), true = code:add_patha(CaseDir), @@ -351,7 +350,7 @@ testPrimStrings(Config, Rule, Opts) -> asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [compact_bit_string,Rule|Opts]), testPrimStrings:bit_string(Rule), - ?only_ber(testPrimStrings:more_strings(Rule)). + testPrimStrings:more_strings(Rule). testPrimStrings_cases(Rule) -> testPrimStrings:bit_string(Rule), @@ -368,10 +367,10 @@ testPrimExternal(Config, Rule, Opts) -> asn1_test_lib:compile_all(["External", "PrimExternal"], Config, [Rule|Opts]), testPrimExternal:external(Rule), - ?only_ber(asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, - [Rule|Opts])), - ?only_ber(testPrimStrings_cases(Rule)), - ?only_ber(testPrimStrings:more_strings(Rule)). + asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, + [Rule|Opts]), + testPrimStrings_cases(Rule), + testPrimStrings:more_strings(Rule). testChoPrim(Config) -> test(Config, fun testChoPrim/3). testChoPrim(Config, Rule, Opts) -> @@ -634,9 +633,10 @@ c_syntax(Config) -> "SeqBadComma"]]. c_string(Config) -> - test(Config, fun c_string/3, [per, ber]). + test(Config, fun c_string/3). c_string(Config, Rule, Opts) -> - asn1_test_lib:compile("String", Config, [Rule|Opts]). + asn1_test_lib:compile("String", Config, [Rule|Opts]), + asn1ct:test('String'). c_implicit_before_choice(Config) -> test(Config, fun c_implicit_before_choice/3, [ber]). @@ -688,6 +688,8 @@ ber_other(Config) -> ber_other(Config, Rule, Opts) -> [module_test(M, Config, Rule, Opts) || M <- ber_modules()]. +der(Config) -> + asn1_test_lib:compile_all(ber_modules(), Config, [der]). module_test(M, Config, Rule, Opts) -> asn1_test_lib:compile(M, Config, [Rule|Opts]), @@ -740,13 +742,9 @@ value_test(Config, Rule, Opts) -> 'ObjIdValues':'mobileDomainId'()). value_bad_enum_test(Config) -> - case ?MODULE of - asn1_SUITE -> - {error, _} = asn1ct:compile(?config(data_dir, Config) - ++ "BadEnumValue1", - [{outdir, ?config(case_dir, Config)}]); - _ -> {skip, "Runs in asn1_SUITE only"} - end. + {error, _} = asn1ct:compile(?config(data_dir, Config) ++ + "BadEnumValue1", + [{outdir, ?config(case_dir, Config)}]). constructed(Config) -> test(Config, fun constructed/3, [ber]). @@ -861,18 +859,13 @@ testInvokeMod(Config, Rule, Opts) -> {ok, _Result2} = 'PrimStrings':encode('Bs1', [1, 0, 1, 0]). testExport(Config) -> - case ?MODULE of - asn1_SUITE -> - {error, {asn1, _Reason}} = - asn1ct:compile(filename:join(?config(data_dir, Config), - "IllegalExport"), - [{outdir, ?config(case_dir, Config)}]); - _ -> - {skip, "Runs in asn1_SUITE only"} - end. + {error, {asn1, _Reason}} = + asn1ct:compile(filename:join(?config(data_dir, Config), + "IllegalExport"), + [{outdir, ?config(case_dir, Config)}]). testImport(Config) -> - test(Config, fun testImport/3, [ber]). + test(Config, fun testImport/3). testImport(Config, Rule, Opts) -> {error, _} = asn1ct:compile(filename:join(?config(data_dir, Config), "ImportsFrom"), @@ -910,18 +903,14 @@ testOpenTypeImplicitTag(Config, Rule, Opts) -> testOpenTypeImplicitTag:main(Rule). duplicate_tags(Config) -> - case ?MODULE of - asn1_SUITE -> - DataDir = ?config(data_dir, Config), - CaseDir = ?config(case_dir, Config), - {error, {asn1, [{error, {type, _, _, 'SeqOpt1Imp', {asn1, {duplicates_of_the_tags, _}}}}]}} = - asn1ct:compile(filename:join(DataDir, "SeqOptional2"), - [abs, {outdir, CaseDir}]); - _ -> - {skip, "Runs in asn1_SUITE only"} - end. + DataDir = ?config(data_dir, Config), + CaseDir = ?config(case_dir, Config), + {error, {asn1, [{error, {type, _, _, 'SeqOpt1Imp', + {asn1, {duplicates_of_the_tags, _}}}}]}} = + asn1ct:compile(filename:join(DataDir, "SeqOptional2"), + [abs, {outdir, CaseDir}]). -rtUI(Config) -> test(Config, fun rtUI/3, [per,ber]). +rtUI(Config) -> test(Config, fun rtUI/3). rtUI(Config, Rule, Opts) -> asn1_test_lib:compile("Prim", Config, [Rule|Opts]), {ok, _} = asn1rt:info('Prim'). @@ -937,7 +926,7 @@ testINSTANCE_OF(Config, Rule, Opts) -> testINSTANCE_OF:main(Rule). testTCAP(Config) -> - test(Config, fun testTCAP/3, [ber]). + test(Config, fun testTCAP/3). testTCAP(Config, Rule, Opts) -> testTCAP:compile(Config, [Rule|Opts]), testTCAP:test(Rule, Config), @@ -988,11 +977,16 @@ test_driver_load(Config, Rule, Opts) -> test_ParamTypeInfObj(Config) -> asn1_test_lib:compile("IN-CS-1-Datatypes", Config, [ber]). -test_WS_ParamClass(Config) -> - asn1_test_lib:compile("InformationFramework", Config, [ber]). +test_WS_ParamClass(Config) -> test(Config, fun test_WS_ParamClass/3). +test_WS_ParamClass(Config, Rule, Opts) -> + asn1_test_lib:compile("InformationFramework", Config, [Rule|Opts]), + ?only_ber(testWSParamClass:main(Rule)), + ok. test_Defed_ObjectIdentifier(Config) -> - asn1_test_lib:compile("UsefulDefinitions", Config, [ber]). + test(Config, fun test_Defed_ObjectIdentifier/3). +test_Defed_ObjectIdentifier(Config, Rule, Opts) -> + asn1_test_lib:compile("UsefulDefinitions", Config, [Rule|Opts]). testSelectionType(Config) -> test(Config, fun testSelectionType/3). testSelectionType(Config, Rule, Opts) -> @@ -1020,7 +1014,7 @@ test_undecoded_rest(Config, Rule, Opts) -> test_undecoded_rest:test(undec_rest, Config). testTcapsystem(Config) -> - test(Config, fun testTcapsystem/3, [ber]). + test(Config, fun testTcapsystem/3). testTcapsystem(Config, Rule, Opts) -> testTcapsystem:compile(Config, [Rule|Opts]). @@ -1123,6 +1117,7 @@ test_modules() -> "Int", "MAP-commonDataTypes", "Null", + "NullTest", "Octetstr", "One", "P-Record", @@ -1264,189 +1259,6 @@ smp(Config) -> {skipped,"No smp support"} end. -per_performance(Config) -> - PrivDir = proplists:get_value(priv_dir, Config), - NifDir = filename:join(PrivDir,"nif"), - ErlDir = filename:join(PrivDir,"erl"), - file:make_dir(NifDir),file:make_dir(ErlDir), - - Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, - ok = testNBAPsystem:compile([{priv_dir,NifDir}|Config], [per]), - ok = testNBAPsystem:compile([{priv_dir,ErlDir}|Config], [per]), - - Modules = ['NBAP-CommonDataTypes', - 'NBAP-Constants', - 'NBAP-Containers', - 'NBAP-IEs', - 'NBAP-PDU-Contents', - 'NBAP-PDU-Discriptions'], - - - PreNif = fun() -> - code:add_patha(NifDir), - lists:foreach(fun(M) -> - code:purge(M), - code:load_file(M) - end,Modules) - end, - - PreErl = fun() -> - code:add_patha(ErlDir), - lists:foreach(fun(M) -> - code:purge(M), - code:load_file(M) - end,Modules) - end, - - Func = fun() -> - element(1,timer:tc( - asn1_wrapper,encode,['NBAP-PDU-Discriptions', - 'NBAP-PDU', - Msg])) - end, - - nif_vs_erlang_performance({{{PreNif,Func},{PreErl,Func}},100000,32}). - -ber_performance(Config) -> - - Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, - ok = testNBAPsystem:compile(Config, [ber]), - - - BerFun = fun() -> - {ok,B} = asn1_wrapper:encode('NBAP-PDU-Discriptions', - 'NBAP-PDU', Msg), - asn1_wrapper:decode( - 'NBAP-PDU-Discriptions', - 'NBAP-PDU', - B) - end, - nif_vs_erlang_performance({BerFun,100000,32}). - -cert_pem_performance(Config) when is_list(Config) -> - cert_pem_performance({100000, 32}); -cert_pem_performance({N,S}) -> - nif_vs_erlang_performance({fun pem_performance:cert_pem/0,N,S}). - -dsa_pem_performance(Config) when is_list(Config) -> - dsa_pem_performance({100000, 32}); -dsa_pem_performance({N,S}) -> - nif_vs_erlang_performance({fun pem_performance:dsa_pem/0,N,S}). - - -nif_vs_erlang_performance({{TC1,TC2},N,Sched}) -> - random:seed({123,456,789}), - io:format("Running a ~p sample with ~p max procs...~n~n",[N,Sched]), - - {True,False} = exec(TC1,TC2,Sched,N+1), - - io:format("~ndone!~n"), - - io:format("~n"),TStats = print_stats(strip(True,N div 20)), - io:format("~n"),FStats = print_stats(strip(False,N div 20)), - Str = io_lib:format("~nNifs are ~.3f% faster than erlang!~n", - [(element(2,FStats) - element(2,TStats)) / - element(2,FStats) * 100]), - io:format(Str), - {comment, lists:flatten(Str)}; -nif_vs_erlang_performance({T,N,Sched}) -> - PTC1 = fun() -> - application:set_env(asn1, nif_loadable, true) - end, - PTC2 = fun() -> - application:set_env(asn1, nif_loadable, false) - end, - TC = fun() -> - element(1,timer:tc(T)) - end, - nif_vs_erlang_performance({{{PTC1,TC},{PTC2,TC}},N,Sched}). - - -print_stats(Data) -> - Length = length(Data), - Mean = lists:sum(Data) / Length, - Variance = lists:foldl(fun(N,Acc) -> math:pow(N - Mean, 2)+Acc end, 0, Data), - StdDev = math:sqrt(Variance / Length), - Median = lists:nth(round(Length/2),Data), - Min = lists:min(Data), - Max = lists:max(Data), - if Length < 20 -> - io:format("Data: ~w~n",[Data]); - true -> - ok - end, - io:format("Length: ~p~nMean: ~p~nStdDev: ~p~nMedian: ~p~nMin: ~p~nMax: ~p~n", - [Length,Mean,StdDev,Median,Min,Max]), - {Length,Mean,StdDev,Median,Min,Max}. - -collect(Acc) -> - receive - {Tag,Val} -> - Prev = proplists:get_value(Tag,Acc,[]), - collect(lists:keystore(Tag,1,Acc,{Tag,[Val|Prev]})) - after 100 -> - Acc - end. - -exec(One,Two,Max,N) -> - exec(One,Two,Max,N,{[],[]}). -exec(_,_,_,1,{D1,D2}) -> - {lists:flatten(D1),lists:flatten(D2)}; -exec({PreOne,One} = O,{PreTwo,Two} = T,MaxProcs, N, {D1,D2}) -> - Num = random:uniform(round(N/2)), - if Num rem 3 == 0 -> - timer:sleep(Num rem 1000); - true -> - ok - end, - Procs = random:uniform(MaxProcs), - io:format("\tBatch: ~p items in ~p processes, ~p left~n",[Num,Procs,N-Num]), - if Num rem 2 == 1 -> - erlang:garbage_collect(), - PreOne(), - MoreOne = pexec(One, Num, Procs, []), - erlang:garbage_collect(), - PreTwo(), - MoreTwo = pexec(Two, Num, Procs, []); - true -> - erlang:garbage_collect(), - PreTwo(), - MoreTwo = pexec(Two, Num, Procs, []), - erlang:garbage_collect(), - PreOne(), - MoreOne = pexec(One, Num, Procs, []) - end, - exec(O,T,MaxProcs,N-Num,{[MoreOne|D1], - [MoreTwo|D2]}). - -pexec(_Fun, _, 0, []) -> - []; -pexec(Fun, _, 0, [{Ref,Pid}|Rest]) -> - receive - {data,D} -> - [D|pexec(Fun,0,0,[{Ref,Pid}|Rest])]; - {'DOWN', Ref, process, Pid, normal} -> - pexec(Fun, 0,0,Rest) - end; -pexec(Fun, 0, 1, AccProcs) -> - pexec(Fun, 0, 0, AccProcs); -pexec(Fun, N, 1, AccProcs) -> - [Fun()|pexec(Fun, N - 1, 1, AccProcs)]; -pexec(Fun, N, Procs, AccProcs) -> - S = self(), - Pid = spawn(fun() -> - S ! {data,pexec(Fun,N,1,[])} - end), - Ref = erlang:monitor(process, Pid), - pexec(Fun, N, Procs - 1, [{Ref,Pid}|AccProcs]). - -strip(Data,Num) -> - {_,R} = lists:split(Num,lists:sort(Data)), - element(2,lists:split(Num,lists:reverse(R))). - -faster(A,B) -> - (B - A)/B * 100. - enc_dec(1, Msg, N) -> worker_loop(N, Msg); enc_dec(NumOfProcs,Msg, N) -> diff --git a/lib/asn1/test/asn1_SUITE_data/Def.py b/lib/asn1/test/asn1_SUITE_data/Def.py deleted file mode 100644 index ff08ed6386..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Def.py +++ /dev/null @@ -1,31 +0,0 @@ -Def DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - -Def1 ::= SEQUENCE -{ - bool0 [0] BOOLEAN, - bool1 [1] BOOLEAN DEFAULT false, - bool2 [2] BOOLEAN DEFAULT false, - bool3 [3] BOOLEAN DEFAULT false -} - - -Def2 ::= SEQUENCE -{ - bool10 [10] BOOLEAN, - bool11 [11] BOOLEAN DEFAULT false, - bool12 [12] BOOLEAN DEFAULT false, - bool13 [13] BOOLEAN -} - - -Def3 ::= SEQUENCE -{ - bool30 [30] BOOLEAN DEFAULT false, - bool31 [31] BOOLEAN DEFAULT false, - bool32 [32] BOOLEAN DEFAULT false, - bool33 [33] BOOLEAN DEFAULT false -} - -END diff --git a/lib/asn1/test/asn1_SUITE_data/NullTest.asn1 b/lib/asn1/test/asn1_SUITE_data/NullTest.asn1 new file mode 100644 index 0000000000..041b20a4c1 --- /dev/null +++ b/lib/asn1/test/asn1_SUITE_data/NullTest.asn1 @@ -0,0 +1,14 @@ +NullTest DEFINITIONS ::= +BEGIN + +NullTestData ::= SEQUENCE { + body NullBody, + tail INTEGER +} + +NullBody ::= CHOICE { + null [0] NULL, + notNull [1] INTEGER +} + +END diff --git a/lib/asn1/test/asn1_SUITE_data/Opt.py b/lib/asn1/test/asn1_SUITE_data/Opt.py deleted file mode 100644 index 48c2a09b64..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Opt.py +++ /dev/null @@ -1,31 +0,0 @@ -Opt DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - -Opt1 ::= SEQUENCE -{ - bool0 [0] BOOLEAN, - bool1 [1] BOOLEAN OPTIONAL, - bool2 [2] BOOLEAN OPTIONAL, - bool3 [3] BOOLEAN OPTIONAL -} - - -Opt2 ::= SEQUENCE -{ - bool10 [10] BOOLEAN, - bool11 [11] BOOLEAN OPTIONAL, - bool12 [12] BOOLEAN OPTIONAL, - bool13 [13] BOOLEAN -} - - -Opt3 ::= SEQUENCE -{ - bool30 [30] BOOLEAN OPTIONAL, - bool31 [31] BOOLEAN OPTIONAL, - bool32 [32] BOOLEAN OPTIONAL, - bool33 [33] BOOLEAN OPTIONAL -} - -END diff --git a/lib/asn1/test/asn1_SUITE_data/SeqOf.py b/lib/asn1/test/asn1_SUITE_data/SeqOf.py deleted file mode 100644 index c941418934..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/SeqOf.py +++ /dev/null @@ -1,45 +0,0 @@ -SeqOf DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - - -Seq1 ::= SEQUENCE -{ - bool1 BOOLEAN, - int1 INTEGER, - seq1 SEQUENCE OF SeqIn DEFAULT {} -} - -Seq2 ::= SEQUENCE -{ - seq2 SEQUENCE OF SeqIn DEFAULT {}, - bool2 BOOLEAN, - int2 INTEGER -} - -Seq3 ::= SEQUENCE -{ - bool3 BOOLEAN, - seq3 SEQUENCE OF SeqIn DEFAULT {}, - int3 INTEGER -} - -Seq4 ::= SEQUENCE -{ - seq41 [41] SEQUENCE OF SeqIn DEFAULT {}, - seq42 [42] SEQUENCE OF SeqIn DEFAULT {}, - seq43 [43] SEQUENCE OF SeqIn DEFAULT {} -} - - - -SeqIn ::= SEQUENCE -{ - boolIn BOOLEAN, - intIn INTEGER -} - - - - -END diff --git a/lib/asn1/test/asn1_SUITE_data/SetOf.py b/lib/asn1/test/asn1_SUITE_data/SetOf.py deleted file mode 100644 index 4e2ea16fcc..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/SetOf.py +++ /dev/null @@ -1,42 +0,0 @@ -SetOf DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - - -Set1 ::= SET -{ - bool1 BOOLEAN, - int1 INTEGER, - set1 SET OF SetIn DEFAULT {} -} - -Set2 ::= SET -{ - set2 SET OF SetIn DEFAULT {}, - bool2 BOOLEAN, - int2 INTEGER -} - -Set3 ::= SET -{ - bool3 BOOLEAN, - set3 SET OF SetIn DEFAULT {}, - int3 INTEGER -} - -Set4 ::= SET -{ - set41 [41] SET OF SetIn DEFAULT {}, - set42 [42] SET OF SetIn DEFAULT {}, - set43 [43] SET OF SetIn DEFAULT {} -} - - - -SetIn ::= SET -{ - boolIn BOOLEAN, - intIn INTEGER -} - -END diff --git a/lib/asn1/test/testTCAP.erl b/lib/asn1/test/testTCAP.erl index b723995e40..354b6c5ea4 100644 --- a/lib/asn1/test/testTCAP.erl +++ b/lib/asn1/test/testTCAP.erl @@ -37,7 +37,7 @@ compile_asn1config(Config, Options) -> asn1_test_lib:compile_all(Files, Config, Options), asn1_test_lib:compile_erlang("TCAPPackage_msg", Config, []). -test(ber=Erule,_Config) -> +test(Erule,_Config) -> % ?line OutDir = ?config(priv_dir,Config), %% testing OTP-4798, open type encoded with indefinite length ?line {ok,_Res} = asn1_wrapper:decode('TCAPMessages-simple','MessageType', val_OTP_4798(Erule)), diff --git a/lib/asn1/test/testWSParamClass.erl b/lib/asn1/test/testWSParamClass.erl new file mode 100644 index 0000000000..ae67ca8b81 --- /dev/null +++ b/lib/asn1/test/testWSParamClass.erl @@ -0,0 +1,17 @@ +-module(testWSParamClass). +-export([main/1]). + +main(_) -> + IF = 'InformationFramework', + roundtrip({'Attribute',IF:'id-at-objectClass'(), + [IF:'id-at-objectClass'()], + asn1_NOVALUE}), + roundtrip({'Attribute',IF:'id-at-objectClass'(), + [],[]}), + ok. + +roundtrip(Data) -> + IF = 'InformationFramework', + {ok,Enc} = asn1_wrapper:encode(IF, 'Attribute', Data), + {ok,Data} = IF:decode('Attribute', Enc), + ok. diff --git a/lib/common_test/priv/auxdir/config.guess b/lib/common_test/priv/auxdir/config.guess index 38a833903b..f475ceb413 100755 --- a/lib/common_test/priv/auxdir/config.guess +++ b/lib/common_test/priv/auxdir/config.guess @@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-05-17' +timestamp='2013-02-12' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -17,26 +15,22 @@ timestamp='2007-05-17' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <[email protected]>. -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. # -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# Please send patches with a ChangeLog entry to [email protected]. + me=`echo "$0" | sed -e 's,.*/,,'` @@ -56,8 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -144,7 +137,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward @@ -170,7 +163,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -180,7 +173,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -201,6 +194,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} @@ -223,7 +220,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on @@ -269,7 +266,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead @@ -295,12 +295,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo s390-ibm-zvmoe exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 + echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) + arm*:riscos:*:*|arm*:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) @@ -324,14 +324,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; - i86pc:SunOS:5.*:* | ix86xen:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -375,23 +394,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; @@ -461,8 +480,8 @@ EOF echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -475,7 +494,7 @@ EOF else echo i586-dg-dgux${UNAME_RELEASE} fi - exit ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; @@ -532,7 +551,7 @@ EOF echo rs6000-ibm-aix3.2 fi exit ;; - *:AIX:*:[45]) + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -575,52 +594,52 @@ EOF 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -640,7 +659,7 @@ EOF # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -711,22 +730,22 @@ EOF exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; @@ -750,14 +769,14 @@ EOF exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} @@ -769,40 +788,51 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in amd64) echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 + exit ;; *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - *:Interix*:[3456]*) - case ${UNAME_MACHINE} in - x86) + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) echo i586-pc-interix${UNAME_RELEASE} exit ;; - EM64T | authenticamd) + authenticamd | genuineintel | EM64T) echo x86_64-unknown-interix${UNAME_RELEASE} exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we @@ -832,20 +862,68 @@ EOF i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; - arm*:Linux:*:*) + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) - echo cris-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) - echo frv-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -856,74 +934,36 @@ EOF m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + padre:Linux:*:*) + echo sparc-unknown-linux-gnu exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level @@ -933,14 +973,17 @@ EOF *) echo hppa-unknown-linux-gnu ;; esac exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -948,81 +991,18 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - tile:Linux:*:*) - echo tile-unknown-linux-gnu + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - xtensa:Linux:*:*) - echo xtensa-unknown-linux-gnu + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both @@ -1030,11 +1010,11 @@ EOF echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) @@ -1051,7 +1031,7 @@ EOF i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) @@ -1066,7 +1046,7 @@ EOF fi exit ;; i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; @@ -1094,10 +1074,13 @@ EOF exit ;; pc:*:*:*) # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; @@ -1132,8 +1115,18 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; @@ -1146,7 +1139,7 @@ EOF rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) @@ -1166,10 +1159,10 @@ EOF echo ns32k-sni-sysv fi exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <[email protected]> - echo i586-unisys-sysv4 - exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <[email protected]> + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <[email protected]>. # How about differentiating between stratus architectures? -djm @@ -1195,11 +1188,11 @@ EOF exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; @@ -1209,6 +1202,12 @@ EOF BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; @@ -1236,6 +1235,16 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1251,7 +1260,10 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NSE-?:NONSTOP_KERNEL:*:*) + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) @@ -1296,13 +1308,13 @@ EOF echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} + echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` + UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; @@ -1317,11 +1329,14 @@ EOF i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; esac -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ @@ -1339,11 +1354,11 @@ main () #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif @@ -1477,9 +1492,9 @@ This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff --git a/lib/common_test/priv/auxdir/config.sub b/lib/common_test/priv/auxdir/config.sub index f43233b104..bb6edbdb47 100755 --- a/lib/common_test/priv/auxdir/config.sub +++ b/lib/common_test/priv/auxdir/config.sub @@ -1,44 +1,40 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-04-29' +timestamp='2013-02-12' -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# Please send patches with a ChangeLog entry to [email protected]. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -72,8 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -120,12 +115,18 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ - uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] @@ -148,10 +149,13 @@ case $os in -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray) + -apple | -axis | -knuth | -cray | -microblaze*) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -166,10 +170,10 @@ case $os in os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; @@ -214,6 +218,12 @@ case $os in -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; -lynx*) os=-lynxos ;; @@ -238,24 +248,34 @@ case $basic_machine in # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ + | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | arc \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ + | epiphany \ | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | mcore | mep \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ @@ -266,31 +286,45 @@ case $basic_machine in | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ | mt \ | msp430 \ - | nios | nios2 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | or32 \ + | open8 \ + | or1k | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ + | rl78 | rx \ | score \ - | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu | strongarm \ - | tahoe | thumb | tic4x | tic80 | tron \ - | v850 | v850e \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; @@ -300,6 +334,21 @@ case $basic_machine in basic_machine=mt-unknown ;; + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; + # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. @@ -314,29 +363,37 @@ case $basic_machine in # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ + | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* | avr32-* \ + | be32-* | be64-* \ | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ @@ -347,31 +404,41 @@ case $basic_machine in | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ - | nios-* | nios2-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ - | xstormy16-* | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -389,7 +456,7 @@ case $basic_machine in basic_machine=a29k-amd os=-udi ;; - abacus) + abacus) basic_machine=abacus-unknown ;; adobe68k) @@ -435,6 +502,10 @@ case $basic_machine in basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -443,10 +514,35 @@ case $basic_machine in basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -475,8 +571,8 @@ case $basic_machine in basic_machine=craynv-cray os=-unicosmp ;; - cr16c) - basic_machine=cr16c-unknown + cr16 | cr16-*) + basic_machine=cr16-unknown os=-elf ;; crds | unos) @@ -514,6 +610,10 @@ case $basic_machine in basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp @@ -629,7 +729,6 @@ case $basic_machine in i370-ibm* | ibm*) basic_machine=i370-ibm ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 @@ -668,6 +767,14 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -679,6 +786,13 @@ case $basic_machine in basic_machine=ns32k-utek os=-sysv ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; mingw32) basic_machine=i386-pc os=-mingw32 @@ -715,10 +829,18 @@ case $basic_machine in ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -783,6 +905,12 @@ case $basic_machine in np1) basic_machine=np1-gould ;; + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem + ;; nsr-tandem) basic_machine=nsr-tandem ;; @@ -813,6 +941,14 @@ case $basic_machine in basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -857,9 +993,10 @@ case $basic_machine in ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -884,7 +1021,11 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; - rdos) + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) basic_machine=i386-pc os=-rdos ;; @@ -953,6 +1094,9 @@ case $basic_machine in basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -1009,17 +1153,9 @@ case $basic_machine in basic_machine=t90-cray os=-unicos ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -1027,10 +1163,6 @@ case $basic_machine in tx39el) basic_machine=mipstx39el-unknown ;; - tile*) - basic_machine=tile-tilera - os=-linux-gnu - ;; toad1) basic_machine=pdp10-xkl os=-tops20 @@ -1092,6 +1224,9 @@ case $basic_machine in xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1100,6 +1235,10 @@ case $basic_machine in basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1138,7 +1277,7 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) @@ -1185,9 +1324,12 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1208,21 +1350,23 @@ case $os in # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -openbsd* | -solidbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ @@ -1230,7 +1374,7 @@ case $os in | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1269,7 +1413,7 @@ case $os in -opened*) os=-openedition ;; - -os400*) + -os400*) os=-os400 ;; -wince*) @@ -1318,7 +1462,7 @@ case $os in -sinix*) os=-sysv4 ;; - -tpf*) + -tpf*) os=-tpf ;; -triton*) @@ -1354,12 +1498,14 @@ case $os in -aros*) os=-aros ;; - -kaos*) - os=-kaos - ;; -zvmoe) os=-zvmoe ;; + -dicos*) + os=-dicos + ;; + -nacl*) + ;; -none) ;; *) @@ -1382,10 +1528,10 @@ else # system, and we'll never get to this point. case $basic_machine in - score-*) + score-*) os=-elf ;; - spu-*) + spu-*) os=-elf ;; *-acorn) @@ -1397,8 +1543,20 @@ case $basic_machine in arm*-semi) os=-aout ;; - c4x-* | tic4x-*) - os=-coff + c4x-* | tic4x-*) + os=-coff + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff ;; # This must come before the *-dec entry. pdp10-*) @@ -1418,14 +1576,11 @@ case $basic_machine in ;; m68000-sun) os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 ;; m68*-cisco) os=-aout ;; - mep-*) + mep-*) os=-elf ;; mips*-cisco) @@ -1434,6 +1589,9 @@ case $basic_machine in mips*-*) os=-elf ;; + or1k-*) + os=-elf + ;; or32-*) os=-coff ;; @@ -1452,7 +1610,7 @@ case $basic_machine in *-ibm) os=-aix ;; - *-knuth) + *-knuth) os=-mmixware ;; *-wec) @@ -1557,7 +1715,7 @@ case $basic_machine in -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1628,3 +1786,4 @@ exit # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: + diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 5924930072..0b204a681a 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -397,9 +397,9 @@ tc_print(Category,Format,Args) -> %%% <p>This function is called by <code>ct</code> when printing %%% stuff from a testcase on the user console.</p> tc_print(Category,Importance,Format,Args) -> - VLvl = case ct_util:get_testdata({verbosity,Category}) of + VLvl = case ct_util:get_verbosity(Category) of undefined -> - ct_util:get_testdata({verbosity,'$unspecified'}); + ct_util:get_verbosity('$unspecified'); {error,bad_invocation} -> ?MAX_VERBOSITY; Val -> @@ -1475,8 +1475,9 @@ count_cases(Dir) -> write_summary(SumFile, Summary), Summary end; - {error, _Reason} -> - io:format("\nFailed to read ~p (skipped)\n", [LogFile]), + {error, Reason} -> + io:format("\nFailed to read ~p: ~p (skipped)\n", + [LogFile,Reason]), error end end. diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index e516f635d2..b42ff73846 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -428,7 +428,7 @@ master_loop(#state{node_ctrl_pids=[], log(all,"TEST RESULTS",Str,[]), log(all,"Info","Updating log files",[]), refresh_logs(LogDirs,[]), - + ct_master_event:stop(), ct_master_logs:stop(), ok; diff --git a/lib/common_test/src/ct_master_event.erl b/lib/common_test/src/ct_master_event.erl index 5877b7c6f2..fd97ab16f7 100644 --- a/lib/common_test/src/ct_master_event.erl +++ b/lib/common_test/src/ct_master_event.erl @@ -66,16 +66,30 @@ add_handler(Args) -> %% Description: Stops the event manager %%-------------------------------------------------------------------- stop() -> - flush(), - gen_event:stop(?CT_MEVMGR_REF). + case flush() of + {error,Reason} -> + ct_master_logs:log("Error", + "No response from CT Master Event.\n" + "Reason = ~p\n" + "Terminating now!\n",[Reason]), + %% communication with event manager fails, kill it + catch exit(whereis(?CT_MEVMGR_REF), kill); + _ -> + gen_event:stop(?CT_MEVMGR_REF) + end. flush() -> - case gen_event:call(?CT_MEVMGR_REF,?MODULE,flush) of + try gen_event:call(?CT_MEVMGR_REF,?MODULE,flush,1800000) of flushing -> timer:sleep(1), flush(); done -> - ok + ok; + Error = {error,_} -> + Error + catch + _:Reason -> + {error,Reason} end. %%-------------------------------------------------------------------- diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index c0bdbb2a09..49f00429ae 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -2291,8 +2291,12 @@ add_jobs([{TestDir,all,_}|Tests], Skip, Opts, CleanUp) -> {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, CleanUp) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, CleanUp); + _ -> + CleanUp + end end; add_jobs([{TestDir,[Suite],all}|Tests], Skip, Opts, CleanUp) when is_atom(Suite) -> @@ -2305,8 +2309,12 @@ add_jobs([{TestDir,Suites,all}|Tests], Skip, {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, CleanUp) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, CleanUp); + _ -> + CleanUp + end end; add_jobs([{TestDir,Suite,all}|Tests], Skip, Opts, CleanUp) -> case maybe_interpret(Suite, all, Opts) of @@ -2318,8 +2326,12 @@ add_jobs([{TestDir,Suite,all}|Tests], Skip, Opts, CleanUp) -> {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]); + _ -> + CleanUp + end end; Error -> Error @@ -2358,8 +2370,12 @@ add_jobs([{TestDir,Suite,Confs}|Tests], Skip, Opts, CleanUp) when {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]); + _ -> + CleanUp + end end; Error -> Error @@ -2384,8 +2400,12 @@ add_jobs([{TestDir,Suite,Cases}|Tests], {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]); + _ -> + CleanUp + end end; Error -> Error @@ -2401,8 +2421,12 @@ add_jobs([{TestDir,Suite,Case}|Tests], Skip, Opts, CleanUp) when is_atom(Case) - {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]); + _ -> + CleanUp + end end; Error -> Error @@ -2412,7 +2436,13 @@ add_jobs([], _, _, CleanUp) -> wait_for_idle() -> ct_util:update_last_run_index(), - Notify = fun(Me) -> Me ! idle end, + Notify = fun(Me,IdleState) -> Me ! {idle,IdleState}, + receive + {Me,proceed} -> ok + after + 30000 -> ok + end + end, case catch test_server_ctrl:idle_notify(Notify) of {'EXIT',_} -> error; @@ -2420,11 +2450,14 @@ wait_for_idle() -> %% so we don't hang forever if test_server dies Ref = erlang:monitor(process, TSPid), Result = receive - idle -> ok; + {idle,abort} -> aborted; + {idle,_} -> ok; {'DOWN', Ref, _, _, _} -> error end, erlang:demonitor(Ref, [flush]), ct_util:update_last_run_index(), + %% let test_server_ctrl proceed (and possibly shut down) now + TSPid ! {self(),proceed}, Result end. @@ -2921,11 +2954,11 @@ opts2args(EnvStartOpts) -> [{event_handler_init,[atom_to_list(EH),ArgStr]}]; ({event_handler,{EHs,Arg}}) when is_list(EHs) -> ArgStr = lists:flatten(io_lib:format("~p", [Arg])), - Strs = lists:map(fun(EH) -> - [atom_to_list(EH), - ArgStr,"and"] - end, EHs), - [_LastAnd|StrsR] = lists:reverse(lists:flatten(Strs)), + Strs = lists:flatmap(fun(EH) -> + [atom_to_list(EH), + ArgStr,"and"] + end, EHs), + [_LastAnd | StrsR] = lists:reverse(Strs), [{event_handler_init,lists:reverse(StrsR)}]; ({logopts,LOs}) when is_list(LOs) -> [{logopts,[atom_to_list(LO) || LO <- LOs]}]; diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index e341391a91..71b03c0ea6 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -1020,17 +1020,6 @@ add_tests([],Spec) -> % done %% check if it's a CT term that has bad format or if the user seems to %% have added something of his/her own, which we'll let pass if relaxed %% mode is enabled. -check_term(Atom) when is_atom(Atom) -> - Valid = valid_terms(), - case lists:member(Atom,Valid) of - true -> - valid; - false -> % ignore - case get(relaxed) of - true -> invalid; - false -> throw({error,{undefined_term_in_spec,Atom}}) - end - end; check_term(Term) when is_tuple(Term) -> Size = size(Term), [Name|_] = tuple_to_list(Term), @@ -1059,9 +1048,7 @@ check_term(Term) when is_tuple(Term) -> throw({error,{undefined_term_in_spec,Term}}) end end - end; -check_term(Other) -> - throw({error,{undefined_term_in_spec,Other}}). + end. %% specific data handling before saving in testspec record, e.g. %% converting relative paths to absolute for directories and files diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index 0f2b2081d9..2e7e731595 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -39,7 +39,8 @@ delete_suite_data/0, delete_suite_data/1, match_delete_suite_data/1, delete_testdata/0, delete_testdata/1, set_testdata/1, get_testdata/1, get_testdata/2, - set_testdata_async/1, update_testdata/2, update_testdata/3]). + set_testdata_async/1, update_testdata/2, update_testdata/3, + set_verbosity/1, get_verbosity/1]). -export([override_silence_all_connections/0, override_silence_connections/1, get_overridden_silenced_connections/0, @@ -128,6 +129,10 @@ do_start(Parent, Mode, LogDir, Verbosity) -> create_table(?conn_table,#conn.handle), create_table(?board_table,2), create_table(?suite_table,#suite_data.key), + + create_table(?verbosity_table,1), + [ets:insert(?verbosity_table,{Cat,Lvl}) || {Cat,Lvl} <- Verbosity], + {ok,StartDir} = file:get_cwd(), case file:set_cwd(LogDir) of ok -> ok; @@ -202,7 +207,7 @@ do_start(Parent, Mode, LogDir, Verbosity) -> self() ! {{stop,{self(),{user_error,CTHReason}}}, {Parent,make_ref()}} end, - loop(Mode, [{{verbosity,Cat},Lvl} || {Cat,Lvl} <- Verbosity], StartDir). + loop(Mode, [], StartDir). create_table(TableName,KeyPos) -> create_table(TableName,set,KeyPos). @@ -278,6 +283,19 @@ reset_cwd() -> get_start_dir() -> call(get_start_dir). +%% handle verbosity outside ct_util_server (let the client read +%% the verbosity table) to avoid possible deadlock situations +set_verbosity(Elem = {_Category,_Level}) -> + ets:insert(?verbosity_table, Elem), + ok. +get_verbosity(Category) -> + case ets:lookup(?verbosity_table, Category) of + [{Category,Level}] -> + Level; + _ -> + undefined + end. + loop(Mode,TestData,StartDir) -> receive {update_last_run_index,From} -> @@ -377,6 +395,7 @@ loop(Mode,TestData,StartDir) -> ets:delete(?conn_table), ets:delete(?board_table), ets:delete(?suite_table), + ets:delete(?verbosity_table), ct_logs:close(Info, StartDir), ct_event:stop(), ct_config:stop(), diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index c9c6514fa4..7c2e31f40c 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -21,6 +21,7 @@ -define(conn_table,ct_connections). -define(board_table,ct_boards). -define(suite_table,ct_suite_data). +-define(verbosity_table,ct_verbosity_table). -record(conn, {handle, targetref, diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 7c33fd404d..5e109e98e9 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -312,8 +312,10 @@ wait_for_ct_stop(Retries, CTNode) -> undefined -> true; Pid -> + Info = (catch process_info(Pid)), test_server:format(0, "Waiting for CT (~p) to finish (~p)...", [Pid,Retries]), + test_server:format(0, "Process info for ~p:~n~p", [Info]), timer:sleep(5000), wait_for_ct_stop(Retries-1, CTNode) end. @@ -328,12 +330,17 @@ handle_event(EH, Event) -> start_event_receiver(Config) -> CTNode = proplists:get_value(ct_node, Config), - spawn_link(CTNode, fun() -> er() end). + Level = proplists:get_value(trace_level, Config), + ER = spawn_link(CTNode, fun() -> er() end), + test_server:format(Level, "~nEvent receiver ~w started!~n", [ER]), + ER. get_events(_, Config) -> CTNode = proplists:get_value(ct_node, Config), + Level = proplists:get_value(trace_level, Config), {event_receiver,CTNode} ! {self(),get_events}, Events = receive {event_receiver,Evs} -> Evs end, + test_server:format(Level, "Stopping event receiver!~n", []), {event_receiver,CTNode} ! stop, Events. diff --git a/lib/common_test/test/ct_verbosity_SUITE.erl b/lib/common_test/test/ct_verbosity_SUITE.erl index 349319de94..198d4c44b5 100644 --- a/lib/common_test/test/ct_verbosity_SUITE.erl +++ b/lib/common_test/test/ct_verbosity_SUITE.erl @@ -44,8 +44,11 @@ %% there will be clashes with logging processes etc). %%-------------------------------------------------------------------- init_per_suite(Config) -> - Config1 = ct_test_support:init_per_suite(Config), - Config1. + DataDir = ?config(data_dir, Config), + EvH = filename:join(DataDir,"simple_evh.erl"), + ct:pal("Compiling ~s: ~p", [EvH,compile:file(EvH,[{outdir,DataDir}, + debug_info])]), + ct_test_support:init_per_suite([{path_dirs,[DataDir]} | Config]). end_per_suite(Config) -> ct_test_support:end_per_suite(Config). @@ -56,7 +59,8 @@ init_per_testcase(TestCase, Config) -> end_per_testcase(TestCase, Config) -> ct_test_support:end_per_testcase(TestCase, Config). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> [{timetrap,{seconds,30}}, + {ct_hooks,[ts_install_cth]}]. all() -> [ @@ -67,7 +71,8 @@ all() -> change_default, combine_categories, testspec_only, - merge_with_testspec + merge_with_testspec, + possible_deadlock ]. %%-------------------------------------------------------------------- @@ -173,6 +178,17 @@ merge_with_testspec(Config) -> ok = execute(TC, Opts, ERPid, Config). %%%----------------------------------------------------------------- +%%% +possible_deadlock(Config) -> + TC = possible_deadlock, + DataDir = ?config(data_dir, Config), + Suite = filename:join(DataDir, "io_test_SUITE"), + {Opts,ERPid} = setup([{suite,Suite},{label,TC}, + {event_handler,[simple_evh]}], Config), + ok = execute(TC, Opts, ERPid, Config). + + +%%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -180,7 +196,14 @@ setup(Test, Config) -> Opts0 = ct_test_support:get_opts(Config), Level = ?config(trace_level, Config), EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], - Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test], + Opts = + case proplists:get_value(event_handler, Test) of + undefined -> + Opts0 ++ [{event_handler,{?eh,EvHArgs}} | Test]; + EvHs -> + Opts0 ++ [{event_handler,{[?eh|EvHs],EvHArgs}} | + proplists:delete(event_handler, Test)] + end, ERPid = ct_test_support:start_event_receiver(Config), {Opts,ERPid}. diff --git a/lib/common_test/test/ct_verbosity_SUITE_data/simple_evh.erl b/lib/common_test/test/ct_verbosity_SUITE_data/simple_evh.erl new file mode 100644 index 0000000000..b677e601fb --- /dev/null +++ b/lib/common_test/test/ct_verbosity_SUITE_data/simple_evh.erl @@ -0,0 +1,171 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2012. 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% +%% + +%%% @doc Common Test Framework Event Handler +%%% +%%% <p>This module implements an event handler that CT uses to +%%% handle status and progress notifications during test runs. +%%% The notifications are handled locally (per node) and passed +%%% on to ct_master when CT runs in distributed mode. This +%%% module may be used as a template for other event handlers +%%% that can be plugged in to handle local logging and reporting.</p> +-module(simple_evh). + +-behaviour(gen_event). + +%% gen_event callbacks +-export([init/1, handle_event/2, handle_call/2, + handle_info/2, terminate/2, code_change/3]). + +-include_lib("common_test/include/ct_event.hrl"). +-include_lib("common_test/src/ct_util.hrl"). + +%%==================================================================== +%% gen_event callbacks +%%==================================================================== +%%-------------------------------------------------------------------- +%% Function: init(Args) -> {ok, State} +%% Description: Whenever a new event handler is added to an event manager, +%% this function is called to initialize the event handler. +%%-------------------------------------------------------------------- +init(_) -> + io:format("Event handler ~w started!~n", [?MODULE]), + {ok,[]}. + +%%-------------------------------------------------------------------- +%% Function: +%% handle_event(Event, State) -> {ok, State} | +%% {swap_handler, Args1, State1, Mod2, Args2} | +%% remove_handler +%% Description:Whenever an event manager receives an event sent using +%% gen_event:notify/2 or gen_event:sync_notify/2, this function is called for +%% each installed event handler to handle the event. +%%-------------------------------------------------------------------- +handle_event(Event = #event{name = test_stats},State) -> + %% this could cause a deadlock + ct:pal("~p: ~p~n", [Event#event.name,Event#event.data]), + {ok,State}; +handle_event(_Event,State) -> + {ok,State}. + +%%============================== EVENTS ============================== +%% +%% Name = test_start +%% Data = {StartTime,LogDir} +%% +%% Name = start_info +%% Data = {Tests,Suites,Cases} +%% Tests = Suites = Cases = integer() +%% +%% Name = test_done +%% Data = EndTime +%% +%% Name = start_make +%% Data = Dir +%% +%% Name = finished_make +%% Data = Dir +%% +%% Name = tc_start +%% Data = {Suite,CaseOrGroup} +%% CaseOrGroup = atom() | {Conf,GroupName,GroupProperties} +%% Conf = init_per_group | end_per_group +%% GroupName = atom() +%% GroupProperties = list() +%% +%% Name = tc_done +%% Data = {Suite,CaseOrGroup,Result} +%% CaseOrGroup = atom() | {Conf,GroupName,GroupProperties} +%% Conf = init_per_group | end_per_group +%% GroupName = atom() +%% GroupProperties = list() +%% Result = ok | {skipped,Reason} | {failed,Reason} +%% +%% Name = tc_user_skip +%% Data = {Suite,Case,Comment} +%% Comment = string() +%% +%% Name = tc_auto_skip +%% Data = {Suite,Case,Comment} +%% Comment = string() +%% +%% Name = test_stats +%% Data = {Ok,Failed,Skipped} +%% Ok = Failed = integer() +%% Skipped = {UserSkipped,AutoSkipped} +%% UserSkipped = AutoSkipped = integer() +%% +%% Name = start_logging +%% Data = CtRunDir +%% +%% Name = stop_logging +%% Data = [] +%% +%% Name = start_write_file +%% Data = FullNameFile +%% +%% Name = finished_write_file +%% Data = FullNameFile +%% +%% Name = +%% Data = +%% + +%%-------------------------------------------------------------------- +%% Function: +%% handle_call(Request, State) -> {ok, Reply, State} | +%% {swap_handler, Reply, Args1, State1, +%% Mod2, Args2} | +%% {remove_handler, Reply} +%% Description: Whenever an event manager receives a request sent using +%% gen_event:call/3,4, this function is called for the specified event +%% handler to handle the request. +%%-------------------------------------------------------------------- +handle_call(_Req, State) -> + Reply = ok, + {ok, Reply, State}. + +%%-------------------------------------------------------------------- +%% Function: +%% handle_info(Info, State) -> {ok, State} | +%% {swap_handler, Args1, State1, Mod2, Args2} | +%% remove_handler +%% Description: This function is called for each installed event handler when +%% an event manager receives any other message than an event or a synchronous +%% request (or a system message). +%%-------------------------------------------------------------------- +handle_info(_Info, State) -> + {ok, State}. + +%%-------------------------------------------------------------------- +%% Function: terminate(Reason, State) -> void() +%% Description:Whenever an event handler is deleted from an event manager, +%% this function is called. It should be the opposite of Module:init/1 and +%% do any necessary cleaning up. +%%-------------------------------------------------------------------- +terminate(_Reason, _State) -> + ok. + +%%-------------------------------------------------------------------- +%% Function: code_change(OldVsn, State, Extra) -> {ok, NewState} +%% Description: Convert process state when code is changed +%%-------------------------------------------------------------------- +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 9ad2378d00..cc07f0b9bc 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -68,6 +68,8 @@ is_pure(erlang, atom_to_list, 1) -> true; is_pure(erlang, binary_part, 2) -> true; is_pure(erlang, binary_part, 3) -> true; is_pure(erlang, binary_to_atom, 2) -> true; +is_pure(erlang, binary_to_float, 1) -> true; +is_pure(erlang, binary_to_integer, 1) -> true; is_pure(erlang, binary_to_list, 1) -> true; is_pure(erlang, binary_to_list, 3) -> true; is_pure(erlang, bit_size, 1) -> true; @@ -75,8 +77,10 @@ is_pure(erlang, byte_size, 1) -> true; is_pure(erlang, element, 2) -> true; is_pure(erlang, float, 1) -> true; is_pure(erlang, float_to_list, 1) -> true; +is_pure(erlang, float_to_binary, 1) -> true; is_pure(erlang, hash, 2) -> false; is_pure(erlang, hd, 1) -> true; +is_pure(erlang, integer_to_binary, 1) -> true; is_pure(erlang, integer_to_list, 1) -> true; is_pure(erlang, is_atom, 1) -> true; is_pure(erlang, is_boolean, 1) -> true; diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index 5e0c9b51e3..0ac96e8ac9 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -158,6 +158,9 @@ <item>Make Dialyzer a bit more quiet.</item> <tag><c><![CDATA[--verbose]]></c></tag> <item>Make Dialyzer a bit more verbose.</item> + <tag><c><![CDATA[--statistics]]></c></tag> + <item>Prints information about the progress of execution (analysis phases, + time spent in each and size of the relative input).</item> <tag><c><![CDATA[--build_plt]]></c></tag> <item>The analysis starts from an empty plt and creates a new one from the files specified with <c><![CDATA[-c]]></c> and @@ -228,6 +231,9 @@ match.</item> <tag><c><![CDATA[-Wno_opaque]]></c></tag> <item>Suppress warnings for violations of opaqueness of data types.</item> + <tag><c><![CDATA[-Wno_behaviours]]></c>***</tag> + <item>Suppress warnings about behaviour callbacks which drift from the + published recommended interfaces.</item> <tag><c><![CDATA[-Wunmatched_returns]]></c>***</tag> <item>Include warnings for function calls which ignore a structured return value or do not match against one of many possible return @@ -237,9 +243,6 @@ exception.</item> <tag><c><![CDATA[-Wrace_conditions]]></c>***</tag> <item>Include warnings for possible race conditions.</item> - <tag><c><![CDATA[-Wbehaviours]]></c>***</tag> - <item>Include warnings about behaviour callbacks which drift from the - published recommended interfaces.</item> <tag><c><![CDATA[-Wunderspecs]]></c>***</tag> <item>Warn about underspecified functions (the -spec is strictly more allowing than the success typing).</item> diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl index 36aef2a37f..bf0d08cf8f 100644 --- a/lib/dialyzer/src/dialyzer_behaviours.erl +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -25,8 +25,6 @@ %%% %%% Created : 28 Oct 2009 by Stavros Aronis <[email protected]> %%%------------------------------------------------------------------- -%%% NOTE: This module is currently experimental -- do NOT rely on it! -%%%------------------------------------------------------------------- -module(dialyzer_behaviours). @@ -127,15 +125,12 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest], erl_types:t_to_string(CbReturnType, Records)]}|Acc00] end end, - Acc02 = - case erl_types:any_none( - erl_types:t_inf_lists(ArgTypes, CbArgTypes)) of - false -> Acc01; - true -> - find_mismatching_args(type, ArgTypes, CbArgTypes, Behaviour, - Function, Arity, Records, 1, Acc01) - end, - Acc02 + case erl_types:any_none(erl_types:t_inf_lists(ArgTypes, CbArgTypes)) of + false -> Acc01; + true -> + find_mismatching_args(type, ArgTypes, CbArgTypes, Behaviour, + Function, Arity, Records, 1, Acc01) + end end, Acc2 = case dialyzer_codeserver:lookup_mfa_contract(CbMFA, Codeserver) of @@ -157,16 +152,14 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest], erl_types:t_to_string(ExtraType, Records), erl_types:t_to_string(CbReturnType, Records)]}|Acc10] end, - Acc12 = - case erl_types:any_none( - erl_types:t_inf_lists(SpecArgTypes, CbArgTypes)) of - false -> Acc11; - true -> - find_mismatching_args({spec, File, Line}, SpecArgTypes, - CbArgTypes, Behaviour, Function, - Arity, Records, 1, Acc11) - end, - Acc12 + case erl_types:any_none( + erl_types:t_inf_lists(SpecArgTypes, CbArgTypes)) of + false -> Acc11; + true -> + find_mismatching_args({spec, File, Line}, SpecArgTypes, + CbArgTypes, Behaviour, Function, + Arity, Records, 1, Acc11) + end end, NewAcc = Acc2, check_all_callbacks(Module, Behaviour, Rest, State, NewAcc). diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index 64e0ee88af..9e9226fa5a 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -798,10 +798,7 @@ condensation(G) -> fun({V1, V2}) -> I1 = ets:lookup_element(V2I, V1, 2), I2 = ets:lookup_element(V2I, V2, 2), - case I1 =:= I2 of - true -> true; - false -> ets:insert(I2I, {I1, I2}) - end + I1 =:= I2 orelse ets:insert(I2I, {I1, I2}) end, lists:foreach(Fun1, digraph:edges(G)), Fun3 = diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 6732d96b98..967aa989fb 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -488,6 +488,7 @@ expand_dependent_modules_1([Mod|Mods], Included, ModDeps) -> expand_dependent_modules_1([], Included, _ModDeps) -> Included. +-define(MIN_PARALLELISM, 7). -define(MIN_FILES_FOR_NATIVE_COMPILE, 20). -spec hipe_compile([file:filename()], #options{}) -> 'ok'. @@ -501,11 +502,14 @@ hipe_compile(Files, #options{erlang_mode = ErlangMode} = Options) -> case erlang:system_info(hipe_architecture) of undefined -> ok; _ -> - Mods = [lists, dict, gb_sets, gb_trees, ordsets, sets, + Mods = [lists, dict, digraph, digraph_utils, ets, + gb_sets, gb_trees, ordsets, sets, sofs, cerl, cerl_trees, erl_types, erl_bif_types, - dialyzer_analysis_callgraph, dialyzer_codeserver, - dialyzer_dataflow, dialyzer_dep, dialyzer_plt, - dialyzer_succ_typings, dialyzer_typesig], + dialyzer_analysis_callgraph, dialyzer, dialyzer_behaviours, + dialyzer_codeserver, dialyzer_contracts, + dialyzer_coordinator, dialyzer_dataflow, dialyzer_dep, + dialyzer_plt, dialyzer_succ_typings, dialyzer_typesig, + dialyzer_typesig, dialyzer_worker], report_native_comp(Options), {T1, _} = statistics(wall_clock), native_compile(Mods), @@ -515,12 +519,12 @@ hipe_compile(Files, #options{erlang_mode = ErlangMode} = Options) -> end. native_compile(Mods) -> - case erlang:system_info(schedulers) of - %% N when N > 1 -> - %% Parent = self(), - %% Pids = [spawn(fun () -> Parent ! {self(), hc(M)} end) || M <- Mods], - %% lists:foreach(fun (Pid) -> receive {Pid, Res} -> Res end end, Pids); - _ -> % 1 -> + case dialyzer_utils:parallelism() > ?MIN_PARALLELISM of + true -> + Parent = self(), + Pids = [spawn(fun () -> Parent ! {self(), hc(M)} end) || M <- Mods], + lists:foreach(fun (Pid) -> receive {Pid, Res} -> Res end end, Pids); + false -> lists:foreach(fun (Mod) -> hc(Mod) end, Mods) end. @@ -529,6 +533,7 @@ hc(Mod) -> case code:is_module_native(Mod) of true -> ok; false -> + %% io:format(" ~s", [Mod]), {ok, Mod} = hipe:c(Mod), ok end. diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl index 9989118671..5109bf968a 100644 --- a/lib/dialyzer/src/dialyzer_codeserver.erl +++ b/lib/dialyzer/src/dialyzer_codeserver.erl @@ -100,10 +100,7 @@ ets_dict_to_dict(Table) -> ets:foldl(Fold, dict:new(), Table). ets_set_is_element(Key, Table) -> - case ets:lookup(Table, Key) of - [] -> false; - _ -> true - end. + ets:lookup(Table, Key) =/= []. ets_set_insert_set(Set, Table) -> ets_set_insert_list(sets:to_list(Set), Table). @@ -116,7 +113,7 @@ ets_set_to_set(Table) -> ets:foldl(Fold, sets:new(), Table). ets_read_concurrent_table(Name) -> - ets:new(Name,[{read_concurrency, true}]). + ets:new(Name, [{read_concurrency, true}]). %%-------------------------------------------------------------------- diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 0df003a035..40d8936afa 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -1543,12 +1543,11 @@ get_bif_constr({erlang, '==', 2}, Dst, [Arg1, Arg2] = Args, _State) -> mk_constraint(Arg1, sub, ArgV1), mk_constraint(Arg2, sub, ArgV2)]); get_bif_constr({erlang, element, 2} = _BIF, Dst, Args, - #state{cs = Constrs} = State) -> + #state{cs = Constrs, opaques = Opaques}) -> GenType = erl_bif_types:type(erlang, element, 2), case t_is_none(GenType) of true -> ?debug("Bif: ~w failed\n", [_BIF]), throw(error); false -> - Opaques = State#state.opaques, Fun = fun(Map) -> [I, T] = ATs = lookup_type_list(Args, Map), ATs2 = case lists:member(T, Opaques) of @@ -2582,19 +2581,8 @@ enter_type(Key, Val, Map) when is_integer(Key) -> end end; enter_type(Key, Val, Map) -> - ?debug("Entering ~s :: ~s\n", [format_type(Key), format_type(Val)]), KeyName = t_var_name(Key), - case t_is_any(Val) of - true -> - erase_type(KeyName, Map); - false -> - LimitedVal = t_limit(Val, ?INTERNAL_TYPE_LIMIT), - case dict:find(KeyName, Map) of - {ok, LimitedVal} -> Map; - {ok, _} -> map_store(KeyName, LimitedVal, Map); - error -> map_store(KeyName, LimitedVal, Map) - end - end. + enter_type(KeyName, Val, Map). enter_type_lists([Key|KeyTail], [Val|ValTail], Map) -> Map1 = enter_type(Key, Val, Map), diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 8046b48838..dc8e825199 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -219,15 +219,18 @@ get_record_and_type_info([], _Module, Records, RecDict) -> end. add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, RecDict) -> - case erl_types:type_is_defined(TypeOrOpaque, Name, RecDict) of + Arity = length(ArgForms), + case erl_types:type_is_defined(TypeOrOpaque, Name, Arity, RecDict) of true -> - throw({error, flat_format("Type ~s already defined\n", [Name])}); + Msg = flat_format("Type ~s/~w already defined\n", [Name, Arity]), + throw({error, Msg}); false -> ArgTypes = [erl_types:t_from_form(X) || X <- ArgForms], case lists:all(fun erl_types:t_is_var/1, ArgTypes) of true -> ArgNames = [erl_types:t_var_name(X) || X <- ArgTypes], - dict:store({TypeOrOpaque, Name}, {Module, TypeForm, ArgNames}, RecDict); + dict:store({TypeOrOpaque, Name, Arity}, + {Module, TypeForm, ArgNames}, RecDict); false -> throw({error, flat_format("Type declaration for ~w does not " "have variables as parameters", [Name])}) diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes index 4850f3ff0c..173ff3a9f1 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes @@ -5,18 +5,18 @@ contracts_with_subtypes.erl:108: The call contracts_with_subtypes:rec_arg({'a',{ contracts_with_subtypes.erl:109: The call contracts_with_subtypes:rec_arg({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) contracts_with_subtypes.erl:110: The call contracts_with_subtypes:rec_arg({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) contracts_with_subtypes.erl:111: The call contracts_with_subtypes:rec_arg({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) -contracts_with_subtypes.erl:142: The pattern 1 can never match the type binary() | string() -contracts_with_subtypes.erl:145: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,binary() | string()} -contracts_with_subtypes.erl:147: The pattern 42 can never match the type {'ok',_} | {'ok',_,binary() | string()} +contracts_with_subtypes.erl:142: The pattern 1 can never match the type string() +contracts_with_subtypes.erl:145: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,string()} +contracts_with_subtypes.erl:147: The pattern 42 can never match the type {'ok',_} | {'ok',_,string()} contracts_with_subtypes.erl:163: The pattern 'alpha' can never match the type {'ok',X} contracts_with_subtypes.erl:165: The pattern 42 can never match the type {'ok',X} contracts_with_subtypes.erl:183: The pattern 'alpha' can never match the type {'ok',X} contracts_with_subtypes.erl:185: The pattern 42 can never match the type {'ok',X} -contracts_with_subtypes.erl:202: The pattern 1 can never match the type binary() | string() -contracts_with_subtypes.erl:205: The pattern {'ok', _} can never match the type {'ok',X,binary() | string()} -contracts_with_subtypes.erl:206: The pattern 'alpha' can never match the type {'ok',X,binary() | string()} -contracts_with_subtypes.erl:207: The pattern {'ok', 42} can never match the type {'ok',X,binary() | string()} -contracts_with_subtypes.erl:208: The pattern 42 can never match the type {'ok',X,binary() | string()} +contracts_with_subtypes.erl:202: The pattern 1 can never match the type string() +contracts_with_subtypes.erl:205: The pattern {'ok', _} can never match the type {'ok',X,string()} +contracts_with_subtypes.erl:206: The pattern 'alpha' can never match the type {'ok',X,string()} +contracts_with_subtypes.erl:207: The pattern {'ok', 42} can never match the type {'ok',X,string()} +contracts_with_subtypes.erl:208: The pattern 42 can never match the type {'ok',X,string()} contracts_with_subtypes.erl:234: Function flat_ets_new_t/0 has no local return contracts_with_subtypes.erl:235: The call contracts_with_subtypes:flat_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,'set' | 'ordered_set' | 'bag' | 'duplicate_bag' | 'public' | 'protected' | 'private' | 'named_table' | {'keypos',integer()} | {'heir',pid(),term()} | {'heir','none'} | {'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed') contracts_with_subtypes.erl:23: Invalid type specification for function contracts_with_subtypes:extract2/0. The success typing is () -> 'something' diff --git a/lib/dialyzer/test/small_SUITE_data/results/types_arity b/lib/dialyzer/test/small_SUITE_data/results/types_arity new file mode 100644 index 0000000000..02641bd167 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/types_arity @@ -0,0 +1,2 @@ + +types_arity.erl:16: Invalid type specification for function types_arity:test2/0. The success typing is () -> {'node','a','nil','nil'} diff --git a/lib/dialyzer/test/small_SUITE_data/src/types_arity.erl b/lib/dialyzer/test/small_SUITE_data/src/types_arity.erl new file mode 100644 index 0000000000..4ddc986ea8 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/types_arity.erl @@ -0,0 +1,20 @@ +-module(types_arity). + +-export([ test1/0 + , test2/0 + , test3/0 + ]). + +-export_type([tree/0, tree/1]). + +-type tree(T) :: 'nil' | {'node', T, tree(T), tree(T)}. +-type tree() :: tree(integer()). + +-spec test1() -> tree(). +test1() -> {node, 7, nil, nil}. + +-spec test2() -> tree(). +test2() -> {node, a, nil, nil}. + +-spec test3() -> tree(atom()). +test3() -> {node, a, nil, nil}. diff --git a/lib/diameter/bin/diameterc b/lib/diameter/bin/diameterc index a72ba2d75c..2f5834d359 100755 --- a/lib/diameter/bin/diameterc +++ b/lib/diameter/bin/diameterc @@ -4,7 +4,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -124,10 +124,10 @@ arg(["-i", Dir | Args], #argv{options = Opts} = A) -> arg(["--name", Name | Args], #argv{options = Opts} = A) -> arg(Args, A#argv{options = [{name, Name} | Opts]}); - + arg(["--prefix", Name | Args], #argv{options = Opts} = A) -> arg(Args, A#argv{options = [{prefix, Name} | Opts]}); - + arg(["--inherits", Dict | Args], #argv{options = Opts} = A) -> arg(Args, A#argv{options = Opts ++ [{inherits, Dict}]}); @@ -166,7 +166,7 @@ path_exists(File, Type) -> _ -> throw({"No such file: ~p", [File]}) end. - + file_exists(File) -> path_exists(File, regular). diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 7e50f338d3..379e9f0738 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -16,7 +16,7 @@ <header> <copyright> -<year>2011</year><year>2012</year> +<year>2011</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -188,7 +188,7 @@ Defaults to the value of the <c>alias</c> option if unspecified.</p> <item> <p> Specifies whether or not the &app_pick_peer; -application callback can modify the application state, +application callback can modify the application state. Defaults to <c>false</c> if unspecified.</p> <note> @@ -206,11 +206,13 @@ probably avoid it.</p> <item> <p> Determines the manner in which incoming answer messages containing -decode errors are handled. +decode errors are handled.</p> + +<p> If <c>callback</c> then errors result in a &app_handle_answer; callback in the same fashion as for &app_handle_request;, with errors communicated in the <c>errors</c> field of the -<c>#diameter_packet{}</c> record passed to the callback. +<c>#diameter_packet{}</c> passed to the callback. If <c>report</c> then an answer containing errors is discarded without a callback and a warning report is written to the log. If <c>discard</c> then an answer containing errors is silently @@ -224,6 +226,39 @@ question is as if a callback had taken place and returned Defaults to <c>report</c> if unspecified.</p> </item> +<tag><c>{request_errors, answer_3xxx|answer|callback}</c></tag> +<item> +<p> +Determines the manner in which incoming requests are handled when an +error other than 3007, DIAMETER_APPLICATION_UNSUPPORTED (which cannot +be associated with an application callback module), is detected.</p> + +<p> +If <c>answer_3xxx</c> then requests are answered without a +&app_handle_request; callback taking place. +If <c>answer</c> then even 5xxx errors are answered without a +callback unless the connection in question has configured the RFC 3588 +common dictionary as noted below. +If <c>callback</c> then a &app_handle_request; callback always takes +place and the return value determines the answer sent to the peer.</p> + +<p> +Defaults to <c>answer_3xxx</c> if unspecified.</p> + +<note> +<p> +Answers sent by diameter set the E-bit in the Diameter Header. +Since RFC 3588 allowed only 3xxx result codes in an +<c>answer-message</c>, <c>answer</c> has the same semantics as +<c>answer_3xxx</c> if the peer connection in question has configured +the RFC 3588 common dictionary, <c>diameter_gen_base_rfc3588</c>. +RFC 6733 allows both 3xxx and 5xxx result codes in an +<c>answer-message</c> so a connection configured with the RFC 6733 +common dictionary, <c>diameter_gen_base_rfc6733</c>, does +distinguish between <c>answer_3xxx</c> and <c>answer</c>.</p> +</note> +</item> + </taglist> <marker id="call_opt"/> @@ -534,7 +569,7 @@ Pkt = #diameter_packet{} The RFC 3539 watchdog state machine has transitioned into (<c>up</c>) or out of (<c>down</c>) the OKAY state. -If a <c>#diameter_packet{}</c> record is present in an <c>up</c> event +If a <c>#diameter_packet{}</c> is present in an <c>up</c> event then there has been a capabilties exchange on a newly established transport connection and the record contains the received CER or CEA. Otherwise a connection has reestablished without the loss or @@ -975,6 +1010,42 @@ configured them.</p> Defaults to a single callback returning <c>dpr</c>.</p> </item> +<marker id="length_errors"/> +<tag><c>{length_errors, exit|handle|discard}</c></tag> +<item> +<p> +Specifies how to deal with errors in the Message Length field of the +Diameter Header in an incoming message. +An error in this context is that the length is not at least 20 bytes +(the length of a Header), is not a multiple of 4 (a valid length) or +is not the length of the message in question, as received over the +transport interface documented in &man_transport;.</p> + +<p> +If <c>exit</c> then a warning report is emitted and the parent of the +transport process in question exits, which causes the transport +process itself to exit as described in &man_transport;. +If <c>handle</c> then the message is processed as usual, a resulting +&app_handle_request; or &app_handle_answer; callback (if one takes +place) indicating the <c>5015</c> error (DIAMETER_INVALID_MESSAGE_LENGTH). +If <c>discard</c> then the message in question is silently discarded.</p> + +<p> +Defaults to <c>exit</c>.</p> + +<note> +<p> +The default value reflects the fact that a transport module for a +stream-oriented transport like TCP may not be able to recover from a +message length error since such a transport must use the Message +Length header to divide the incoming byte stream into individual +Diameter messages. +An invalid length leaves it with no reliable way to rediscover message +boundaries, which may result in the failure of subsequent messages. +See &man_tcp; for the behaviour of that module.</p> +</note> +</item> + <marker id="reconnect_timer"/> <tag><c>{reconnect_timer, Tc}</c></tag> <item> diff --git a/lib/diameter/doc/src/diameter_app.xml b/lib/diameter/doc/src/diameter_app.xml index f4db625c71..d0f1b22ebd 100644 --- a/lib/diameter/doc/src/diameter_app.xml +++ b/lib/diameter/doc/src/diameter_app.xml @@ -13,7 +13,7 @@ <header> <copyright> -<year>2011</year><year>2012</year> +<year>2011</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -475,6 +475,7 @@ not selected.</p> | discard | {eval|eval_packet, Action, PostF}</v> <v>Reply = {reply, &packet; | &message;} + | {answer_message, 3000..3999|5000..5999} | {protocol_error, 3000..3999}</v> <v>Opt = &mod_call_opt;</v> <v>PostF = &mod_evaluable;</v> @@ -509,14 +510,15 @@ Otherwise it contains the record representing the request as outlined in &dict;.</p> <p> -The <c>errors</c> field specifies any Result-Code's identifying errors -that were encountered in decoding the request. -In this case diameter will set both Result-Code and -Failed-AVP AVP's in a returned -answer &message; before sending it to the peer: -the returned &message; need only set any other required AVP's. -Note that the errors detected by diameter are all of the 5xxx series -(Permanent Failures). +The <c>errors</c> field specifies any results codes identifying errors +found while decoding the request. +This is used to set Result-Code and/or Failed-AVP in a returned +answer unless the callback returns a <c>#diameter_packet{}</c> +whose <c>errors</c> field is set to either a non-empty list of its +own, in which case this list is used instead, or the atom <c>false</c> +to disable any setting of Result-Code and Failed-AVP. +Note that the errors detected by diameter are of the 3xxx +and 5xxx series, Protocol Errors and Permanent Failures respectively. The <c>errors</c> list is empty if the request has been received in the relay application.</p> @@ -544,24 +546,25 @@ preserved in the outgoing answer, appropriate values otherwise being set by diameter.</p> </item> -<tag><c>{protocol_error, 3000..3999}</c></tag> +<tag><c>{answer_message, 3000..3999|5000..5999}</c></tag> <item> <p> Send an answer message to the peer containing the specified -protocol error. +Result-Code. Equivalent to</p> <pre> {reply, ['answer-message' | Avps] </pre> <p> where <c>Avps</c> sets the Origin-Host, Origin-Realm, the specified -Result-Code and (if the request sent one) Session-Id AVP's.</p> +Result-Code and (if the request contained one) Session-Id AVP's.</p> <p> -Note that &the_rfc; mandates that only answers with a 3xxx series -Result-Code (protocol errors) may set the E bit. -Returning a non-3xxx value in a <c>protocol_error</c> tuple -will cause the request process in question to fail.</p> +Returning a value other than 3xxx or 5xxx will cause the request +process in question to fail, as will returning a 5xxx value if the +peer connection in question has been configured with the RFC 3588 +common dictionary <c>diameter_gen_base_rfc3588</c>. +(Since RFC 3588 only allows 3xxx values in an answer-message.)</p> </item> <tag><c>{relay, Opts}</c></tag> @@ -614,11 +617,20 @@ containing the encoded binary. The return value is ignored.</p> </item> +<tag><c>{protocol_error, 3000..3999}</c></tag> +<item> +<p> +Equivalent to <c>{answer_message, 3000..3999}</c>.</p> +</item> + </taglist> +<note> <p> -Note that protocol errors detected by diameter will result in an -answer message without <c>handle_request/3</c> being invoked.</p> +Requests containing errors may be answered by diameter, without a +callback taking place, depending on the value of the +&mod_application_opt; <c>request_errors</c>.</p> +</note> </desc> </func> diff --git a/lib/diameter/doc/src/diameter_dict.xml b/lib/diameter/doc/src/diameter_dict.xml index 8b0687a22e..1034781ff2 100644 --- a/lib/diameter/doc/src/diameter_dict.xml +++ b/lib/diameter/doc/src/diameter_dict.xml @@ -16,7 +16,7 @@ <header> <copyright> -<year>2011</year><year>2012</year> +<year>2011</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -76,14 +76,18 @@ The generated hrl also contains macro definitions for the possible values of AVPs of type Enumerated.</p> <p> -The diameter application includes three dictionary modules +The diameter application includes five dictionary modules corresponding to applications defined in section 2.4 of &the_rfc;: -<c>diameter_gen_base_rfc3588</c> for the Diameter Common Messages -application with application identifier 0, -<c>diameter_gen_accounting</c> for the Diameter Base Accounting +<c>diameter_gen_base_rfc3588</c> and <c>diameter_gen_base_rfc6733</c> +for the Diameter Common Messages application with application +identifier 0, +<c>diameter_gen_accounting</c> (for RFC 3588) and +<c>diameter_gen_acct_rfc6733</c> for the Diameter Base Accounting application with application identifier 3 and <c>diameter_gen_relay</c> the Relay application with application -identifier 0xFFFFFFFF. +identifier 0xFFFFFFFF.</p> + +<p> The Common Message and Relay applications are the only applications that diameter itself has any specific knowledge of. The Common Message application is used for messages that diameter diff --git a/lib/diameter/doc/src/diameter_sctp.xml b/lib/diameter/doc/src/diameter_sctp.xml index 5e3fd5eaf1..df140b16b9 100644 --- a/lib/diameter/doc/src/diameter_sctp.xml +++ b/lib/diameter/doc/src/diameter_sctp.xml @@ -15,7 +15,7 @@ <erlref> <header> <copyright> -<year>2011</year><year>2012</year> +<year>2011</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -81,7 +81,6 @@ and implements the behaviour documented in The start function required by &man_transport;.</p> <p> -The only diameter_sctp-specific argument is the options list. Options <c>raddr</c> and <c>rport</c> specify the remote address and port for a connecting transport and not valid for a listening transport: the former is required while latter defaults to 3868 if diff --git a/lib/diameter/doc/src/diameter_tcp.xml b/lib/diameter/doc/src/diameter_tcp.xml index fe2389d57d..01c781d553 100644 --- a/lib/diameter/doc/src/diameter_tcp.xml +++ b/lib/diameter/doc/src/diameter_tcp.xml @@ -93,7 +93,8 @@ before configuring TLS capability on diameter transports.</p> <v>Reason = term()</v> <v>OwnOpt = {raddr, &ip_address;} | {rport, integer()} - | {port, integer()}</v> + | {port, integer()} + | {fragment_timer, infinity | 0..16#FFFFFFFF}</v> <v>SslOpt = {ssl_options, true | list()}</v> <v>TcpOpt = term()</v> </type> @@ -103,7 +104,6 @@ before configuring TLS capability on diameter transports.</p> The start function required by &man_transport;.</p> <p> -The only diameter_tcp-specific argument is the options list. Options <c>raddr</c> and <c>rport</c> specify the remote address and port for a connecting transport and are not valid for a listening transport. @@ -112,7 +112,18 @@ that should support TLS: a value of <c>true</c> results in a TLS handshake immediately upon connection establishment while <c>list()</c> specifies options to be passed to &ssl_connect2; or &ssl_accept2; -after capabilities exchange if TLS is negotiated. +after capabilities exchange if TLS is negotiated.</p> + +<p> +Option <c>fragment_timer</c> specifies the timeout, in milliseconds, +of a timer used to flush messages from the incoming byte +stream even if the number of bytes indicated in the Message Length +field of its Diameter Header have not yet been accumulated: +such a message is received over the transport interface after +two successive timeouts without the reception of additional bytes. +Defaults to 1000.</p> + +<p> Remaining options are any accepted by &ssl_connect3; or &gen_tcp_connect3; for a connecting transport, or &ssl_listen2; or &gen_tcp_listen2; for diff --git a/lib/diameter/include/diameter.hrl b/lib/diameter/include/diameter.hrl index beb577afaf..79c4dce541 100644 --- a/lib/diameter/include/diameter.hrl +++ b/lib/diameter/include/diameter.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -25,7 +25,11 @@ -define(DIAMETER_APP_ID_ACCOUNTING, 3). -define(DIAMETER_APP_ID_RELAY, 16#FFFFFFFF). -%% Corresponding dictionaries: +%% Corresponding dictionaries. These macros are deprecated now that +%% there is an RFC6733 whose dictionaries are not strictly backwards +%% compatible. The RFC 6733 common and accounting dictionaries are +%% diameter_gen_base_rfc6733 and diameter_gen_acct_rfc6733 +%% respectively. -define(DIAMETER_DICT_COMMON, diameter_gen_base_rfc3588). -define(DIAMETER_DICT_ACCOUNTING, diameter_gen_base_accounting). -define(DIAMETER_DICT_RELAY, diameter_gen_relay). @@ -139,6 +143,6 @@ init_state, %% option 'state', initial callback state id, %% 32-bit unsigned application identifier = Dict:id() mutable = false, %% boolean(), do traffic callbacks modify state? - options = [{answer_errors, report}]}). %% | callback | discard - + options = [{answer_errors, report}, %% | callback | discard + {request_errors, answer_3xxx}]}). %% | callback | answer -endif. %% -ifdef(diameter_hrl). diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl index 13a6c462af..03aa557c2e 100644 --- a/lib/diameter/include/diameter_gen.hrl +++ b/lib/diameter/include/diameter_gen.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -320,7 +320,7 @@ pack_avp(Name, #diameter_avp{name = AvpName} = Avp, Acc) -> pack_avp(Name, 0, Avp, Acc) -> pack_AVP(Name, Avp, Acc); -pack_avp(_, Arity, Avp, Acc) -> +pack_avp(_, Arity, Avp, Acc) -> pack(Arity, Avp#diameter_avp.name, Avp, Acc). %% pack_AVP/3 @@ -332,7 +332,7 @@ pack_AVP(Name, Avp, Acc) -> Arity -> pack(Arity, 'AVP', Avp, Acc) end. - + %% 3588: %% %% DIAMETER_AVP_UNSUPPORTED 5001 diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index a08c204a23..df10c33268 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2012. All Rights Reserved. +# Copyright Ericsson AB 2010-2013. 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 @@ -109,7 +109,8 @@ ERL_COMPILE_FLAGS += \ +warn_unused_vars \ -pa $(ABS_EBIN) \ -I $(INCDIR) \ - -I gen + -I gen \ + $(STRICT_FLAGS) # -pa is to be able to include_lib from the include directory: the # path must contain the application name. @@ -119,10 +120,18 @@ ERL_COMPILE_FLAGS += \ # erl/hrl from dictionary file. gen/diameter_gen_%.erl gen/diameter_gen_%.hrl: dict/%.dia - $(dia_verbose)../bin/diameterc -o gen -i $(EBIN) $< + $(dia_verbose) \ + ../bin/diameterc -o gen -i $(EBIN) $< opt: $(TARGET_FILES) +# Compile with -Werror during development. Don't do this in the 'opt' +# target so that new warnings don't break the build. It's also +# convenient to have both targets when weeding out warnings isn't the +# priority. (Or when they're intentional, when debugging.) +strict: + $(MAKE) opt STRICT_FLAGS=-Werror + # Build unofficial patches with some degree of traceability. Refuse to # build if there are diffs from HEAD since that defeats the purpose. patch: @@ -134,11 +143,13 @@ debug: # The dictionary parser. gen/$(DICT_YRL).erl: compiler/$(DICT_YRL).yrl - $(yecc_verbose)$(ERLC) -Werror -o $(@D) $< + $(yecc_verbose) \ + $(ERLC) -Werror -o $(@D) $< # Generate the app file. $(APP_TARGET): $(APP_SRC) ../vsn.mk modules.mk - $(gen_verbose)M=`echo $(notdir $(APP_MODULES)) | tr ' ' ,`; \ + $(gen_verbose) \ + M=`echo $(notdir $(APP_MODULES)) | tr ' ' ,`; \ R=`echo $(REGISTERED) | tr ' ' ,`; \ sed -e 's;%VSN%;$(VSN);' \ -e "s;%MODULES%;$$M;" \ @@ -146,7 +157,8 @@ $(APP_TARGET): $(APP_SRC) ../vsn.mk modules.mk $< > $@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ + $(vsn_verbose) \ + sed -e 's;%VSN%;$(VSN);' $< > $@ app: $(APP_TARGET) $(APPUP_TARGET) dict: $(DICT_ERLS) @@ -247,11 +259,15 @@ release_docs_spec: # Dependencies # ---------------------------------------------------- -gen/diameter_gen_base_accounting.erl gen/diameter_gen_relay.erl \ -gen/diameter_gen_base_accounting.hrl gen/diameter_gen_relay.hrl: \ +gen/diameter_gen_base_accounting.erl gen/diameter_gen_base_accounting.hrl: \ $(EBIN)/diameter_gen_base_rfc3588.$(EMULATOR) -gen/diameter_gen_base_rfc3588.erl gen/diameter_gen_base_rfc3588.hrl: \ +gen/diameter_gen_acct_rfc6733.erl gen/diameter_gen_acct_rfc6733.hrl: \ + $(EBIN)/diameter_gen_base_rfc6733.$(EMULATOR) + +gen/diameter_gen_relay.erl gen/diameter_gen_relay.hrl \ +gen/diameter_gen_base_rfc3588.erl gen/diameter_gen_base_rfc3588.hrl \ +gen/diameter_gen_base_rfc6733.erl gen/diameter_gen_base_rfc6733.hrl: \ $(COMPILER_MODULES:%=$(EBIN)/%.$(EMULATOR)) $(DICT_MODULES:gen/%=$(EBIN)/%.$(EMULATOR)): \ @@ -262,7 +278,7 @@ depend: depend.mk # Generate dependencies makefile. depend.mk: depend.sed $(MODULES:%=%.erl) Makefile - $(gen_verbose)(for f in $(MODULES); do \ + (for f in $(MODULES); do \ (echo $$f; cat $$f.erl) | sed -f $<; \ done) \ > $@ @@ -273,7 +289,7 @@ depend.mk: depend.sed $(MODULES:%=%.erl) Makefile .PHONY: debug opt release_docs_spec release_spec .PHONY: $(TARGET_DIRS:%/=%) $(TARGET_DIRS:%/=release_src_%) .PHONY: $(EXAMPLE_DIRS:%/=release_examples_%) -.PHONY: plt dialyze patch +.PHONY: plt dialyze patch strict # Keep intermediate files. .SECONDARY: $(DICT_ERLS) $(DICT_HRLS) gen/$(DICT_YRL:%=%.erl) diff --git a/lib/diameter/src/base/diameter.appup.src b/lib/diameter/src/base/diameter.appup.src index f6d772b534..2ce89579ff 100644 --- a/lib/diameter/src/base/diameter.appup.src +++ b/lib/diameter/src/base/diameter.appup.src @@ -20,14 +20,15 @@ {"%VSN%", [ - {"0.9", [{restart_application, diameter}]}, - {"0.10", [{restart_application, diameter}]}, - {"1.0", [{restart_application, diameter}]}, - {"1.1", [{restart_application, diameter}]}, - {"1.2", [{restart_application, diameter}]}, + {"0.9", [{restart_application, diameter}]}, %% R14B03 + {"0.10", [{restart_application, diameter}]}, %% R14B04 + {"1.0", [{restart_application, diameter}]}, %% R15B + {"1.1", [{restart_application, diameter}]}, %% R15B01 + {"1.2", [{restart_application, diameter}]}, %% R15B02 {"1.2.1", [{restart_application, diameter}]}, - {"1.3", [{restart_application, diameter}]}, - {"1.3.1", [{restart_application, diameter}]} + {"1.3", [{restart_application, diameter}]}, %% R15B03 + {"1.3.1", [{restart_application, diameter}]}, + {"1.4", [{restart_application, diameter}]} %% R16A ], [ {"0.9", [{restart_application, diameter}]}, @@ -37,6 +38,7 @@ {"1.2", [{restart_application, diameter}]}, {"1.2.1", [{restart_application, diameter}]}, {"1.3", [{restart_application, diameter}]}, - {"1.3.1", [{restart_application, diameter}]} + {"1.3.1", [{restart_application, diameter}]}, + {"1.4", [{restart_application, diameter}]} ] }. diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl index 8f9901907a..c67fba5f89 100644 --- a/lib/diameter/src/base/diameter.erl +++ b/lib/diameter/src/base/diameter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -213,7 +213,7 @@ origin_state_id() -> -> any(). call(SvcName, App, Message, Options) -> - diameter_service:call(SvcName, {alias, App}, Message, Options). + diameter_traffic:send_request(SvcName, {alias, App}, Message, Options). call(SvcName, App, Message) -> call(SvcName, App, Message, []). @@ -306,7 +306,8 @@ call(SvcName, App, Message) -> | {module, app_module()} | {state, any()} | {call_mutates_state, boolean()} - | {answer_errors, callback|report|discard}. + | {answer_errors, callback|report|discard} + | {request_errors, answer_3xxx|answer|callback}. -type app_alias() :: any(). @@ -332,8 +333,9 @@ call(SvcName, App, Message) -> | {capabilities_cb, evaluable()} | {capx_timeout, 'Unsigned32'()} | {disconnect_cb, evaluable()} - | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} + | {length_errors, exit | handle | discard} | {reconnect_timer, 'Unsigned32'()} + | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} | {private, any()}. %% Predicate passed to remove_transport/2 diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl index c6c3d2934d..715b15628c 100644 --- a/lib/diameter/src/base/diameter_capx.erl +++ b/lib/diameter/src/base/diameter_capx.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -47,14 +47,13 @@ -module(diameter_capx). --export([build_CER/1, - recv_CER/2, - recv_CEA/2, +-export([build_CER/2, + recv_CER/3, + recv_CEA/3, make_caps/2]). -include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). --include("diameter_gen_base_rfc3588.hrl"). -define(SUCCESS, 2001). %% DIAMETER_SUCCESS -define(NOAPP, 5010). %% DIAMETER_NO_COMMON_APPLICATION @@ -67,27 +66,31 @@ -type tried(T) :: {ok, T} | {error, {term(), list()}}. --spec build_CER(#diameter_caps{}) - -> tried(#diameter_base_CER{}). +-spec build_CER(#diameter_caps{}, module()) + -> tried(CER) + when CER :: tuple(). -build_CER(Caps) -> - try_it([fun bCER/1, Caps]). +build_CER(Caps, Dict) -> + try_it([fun bCER/2, Caps, Dict]). --spec recv_CER(#diameter_base_CER{}, #diameter_service{}) +-spec recv_CER(CER, #diameter_service{}, module()) -> tried({[diameter:'Unsigned32'()], #diameter_caps{}, - #diameter_base_CEA{}}). + CEA}) + when CER :: tuple(), + CEA :: tuple(). -recv_CER(CER, Svc) -> - try_it([fun rCER/2, CER, Svc]). +recv_CER(CER, Svc, Dict) -> + try_it([fun rCER/3, CER, Svc, Dict]). --spec recv_CEA(#diameter_base_CEA{}, #diameter_service{}) +-spec recv_CEA(CEA, #diameter_service{}, module()) -> tried({[diameter:'Unsigned32'()], [diameter:'Unsigned32'()], - #diameter_caps{}}). + #diameter_caps{}}) + when CEA :: tuple(). -recv_CEA(CEA, Svc) -> - try_it([fun rCEA/2, CEA, Svc]). +recv_CEA(CEA, Svc, Dict) -> + try_it([fun rCEA/3, CEA, Svc, Dict]). make_caps(Caps, Opts) -> try_it([fun mk_caps/2, Caps, Opts]). @@ -161,16 +164,17 @@ ipaddr(A) -> ?THROW(T) end. -%% bCER/1 +%% bCER/2 %% %% Build a CER record to send to a remote peer. %% Use the fact that diameter_caps has the same field names as CER. -bCER(#diameter_caps{} = Rec) -> - #diameter_base_CER{} - = list_to_tuple([diameter_base_CER | tl(tuple_to_list(Rec))]). +bCER(#diameter_caps{} = Rec, Dict) -> + Values = lists:zip(Dict:'#info-'(diameter_base_CER, fields), + tl(tuple_to_list(Rec))), + Dict:'#new-'(diameter_base_CER, Values). -%% rCER/2 +%% rCER/3 %% %% Build a CEA record to send to a remote peer in response to an %% incoming CER. RFC 3588 gives no guidance on what should be sent @@ -214,12 +218,9 @@ bCER(#diameter_caps{} = Rec) -> %% TLS 1 %% This node supports TLS security, as defined by [TLS]. -rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> - #diameter_base_CEA{} - = CEA - = cea_from_cer(bCER(LCaps)), - - RCaps = capx_to_caps(CER), +rCER(CER, #diameter_service{capabilities = LCaps} = Svc, Dict) -> + CEA = cea_from_cer(bCER(LCaps, Dict), Dict), + RCaps = capx_to_caps(CER, Dict), SApps = common_applications(LCaps, RCaps, Svc), {SApps, @@ -227,17 +228,18 @@ rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> build_CEA(SApps, LCaps, RCaps, - CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}. + Dict, + Dict:'#set-'({'Result-Code', ?SUCCESS}, CEA))}. -build_CEA([], _, _, CEA) -> - CEA#diameter_base_CEA{'Result-Code' = ?NOAPP}; +build_CEA([], _, _, Dict, CEA) -> + Dict:'#set-'({'Result-Code', ?NOAPP}, CEA); -build_CEA(_, LCaps, RCaps, CEA) -> +build_CEA(_, LCaps, RCaps, Dict, CEA) -> case common_security(LCaps, RCaps) of [] -> - CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY}; + Dict:'#set-'({'Result-Code', ?NOSECURITY}, CEA); [_] = IS -> - CEA#diameter_base_CEA{'Inband-Security-Id' = IS} + Dict:'#set-'({'Inband-Security-Id', IS}, CEA) end. %% common_security/2 @@ -275,46 +277,41 @@ cs(LS, RS) -> %% practice something there may be a need for more synchronization %% than notification by way of an event subscription offers. -%% cea_from_cer/1 +%% cea_from_cer/2 %% CER is a subset of CEA, the latter adding Result-Code and a few %% more AVP's. -cea_from_cer(#diameter_base_CER{} = CER) -> - lists:foldl(fun(F,A) -> to_cea(CER, F, A) end, - #diameter_base_CEA{}, - record_info(fields, diameter_base_CER)). - -to_cea(CER, Field, CEA) -> - try ?BASE:'#get-'(Field, CER) of - V -> ?BASE:'#set-'({Field, V}, CEA) - catch - error: _ -> CEA - end. - -%% rCEA/2 +cea_from_cer(CER, Dict) -> + [diameter_base_CER | Values] = Dict:'#get-'(CER), + Dict:'#set-'(Values, Dict:'#new-'(diameter_base_CEA)). -rCEA(CEA, #diameter_service{capabilities = LCaps} = Svc) -> - RCaps = capx_to_caps(CEA), +%% rCEA/3 + +rCEA(CEA, #diameter_service{capabilities = LCaps} = Svc, Dict) -> + RCaps = capx_to_caps(CEA, Dict), SApps = common_applications(LCaps, RCaps, Svc), IS = common_security(LCaps, RCaps), {SApps, IS, RCaps}. -%% capx_to_caps/1 - -capx_to_caps(#diameter_base_CEA{'Origin-Host' = OH, - 'Origin-Realm' = OR, - 'Host-IP-Address' = IP, - 'Vendor-Id' = VId, - 'Product-Name' = PN, - 'Origin-State-Id' = OSI, - 'Supported-Vendor-Id' = SV, - 'Auth-Application-Id' = Auth, - 'Inband-Security-Id' = IS, - 'Acct-Application-Id' = Acct, - 'Vendor-Specific-Application-Id' = VSA, - 'Firmware-Revision' = FR, - 'AVP' = X}) -> +%% capx_to_caps/2 + +capx_to_caps(CEX, Dict) -> + [OH, OR, IP, VId, PN, OSI, SV, Auth, IS, Acct, VSA, FR, X] + = Dict:'#get-'(['Origin-Host', + 'Origin-Realm', + 'Host-IP-Address', + 'Vendor-Id', + 'Product-Name', + 'Origin-State-Id', + 'Supported-Vendor-Id', + 'Auth-Application-Id', + 'Inband-Security-Id', + 'Acct-Application-Id', + 'Vendor-Specific-Application-Id', + 'Firmware-Revision', + 'AVP'], + CEX), #diameter_caps{origin_host = OH, origin_realm = OR, vendor_id = VId, @@ -327,10 +324,7 @@ capx_to_caps(#diameter_base_CEA{'Origin-Host' = OH, acct_application_id = Acct, vendor_specific_application_id = VSA, firmware_revision = FR, - avp = X}; - -capx_to_caps(#diameter_base_CER{} = CER) -> - capx_to_caps(cea_from_cer(CER)). + avp = X}. %% --------------------------------------------------------------------------- %% --------------------------------------------------------------------------- @@ -365,13 +359,12 @@ app_union(#diameter_caps{auth_application_id = U, vendor_specific_application_id = V}) -> set_list(U ++ C ++ lists:flatmap(fun vsa_apps/1, V)). -vsa_apps(#'diameter_base_Vendor-Specific-Application-Id' - {'Auth-Application-Id' = U, - 'Acct-Application-Id' = C}) -> - U ++ C; -vsa_apps(L) -> - Rec = ?BASE:'#new-'('diameter_base_Vendor-Specific-Application-Id', L), - vsa_apps(Rec). +vsa_apps([_ | [_,_] = Ids]) -> + lists:append(Ids); +vsa_apps(Rec) + when is_tuple(Rec) -> + [_|T] = tuple_to_list(Rec), + vsa_apps(T). %% It's a configuration error for a locally advertised application not %% to be represented in Apps. Don't just match on lists:keyfind/3 in diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl index 0b0bfe3f0a..e446a0209c 100644 --- a/lib/diameter/src/base/diameter_codec.erl +++ b/lib/diameter/src/base/diameter_codec.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -26,7 +26,7 @@ decode_header/1, sequence_numbers/1, hop_by_hop_id/2, - msg_name/1, + msg_name/2, msg_id/1]). %% Towards generated encoders (from diameter_gen.hrl). @@ -99,13 +99,13 @@ e(_, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) -> Eid:32, Avps/binary>>}; -e(Mod0, #diameter_packet{header = Hdr, msg = Msg} = Pkt) -> +e(Mod, #diameter_packet{header = Hdr, msg = Msg} = Pkt) -> #diameter_header{version = Vsn, hop_by_hop_id = Hid, end_to_end_id = Eid} = Hdr, - {Mod, MsgName} = rec2msg(Mod0, Msg), + MsgName = rec2msg(Mod, Msg), {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr), Flags = make_flags(Flags0, Hdr), @@ -192,11 +192,11 @@ encode_avps(Avps) -> %% msg_header/3 msg_header(Mod, 'answer-message' = MsgName, Header) -> - ?BASE = Mod, + 0 = Mod:id(), %% assert #diameter_header{application_id = Aid, cmd_code = Code} = Header, - {-1, Flags, ?DIAMETER_APP_ID_COMMON} = ?BASE:msg_header(MsgName), + {-1, Flags, ?DIAMETER_APP_ID_COMMON} = Mod:msg_header(MsgName), {Code, Flags, Aid}; msg_header(Mod, MsgName, _) -> @@ -204,22 +204,12 @@ msg_header(Mod, MsgName, _) -> %% rec2msg/2 -rec2msg(_, ['answer-message' = M | _]) -> - {?BASE, M}; - -rec2msg(Mod, [MsgName|_]) - when is_atom(MsgName) -> - {Mod, MsgName}; +rec2msg(_, [Name|_]) + when is_atom(Name) -> + Name; rec2msg(Mod, Rec) -> - R = element(1, Rec), - A = 'answer-message', - case ?BASE:msg2rec(A) of - R -> - {?BASE, A}; - _ -> - {Mod, Mod:rec2msg(R)} - end. + Mod:rec2msg(element(1, Rec)). %%% --------------------------------------------------------------------------- %%% # decode/2 @@ -243,20 +233,19 @@ decode(?APP_ID_RELAY, _, #diameter_packet{} = Pkt) -> end; %% Otherwise decode using the dictionary. -decode(_, Mod, #diameter_packet{header = Hdr} = Pkt) - when is_atom(Mod) -> +decode(_, Mod, #diameter_packet{header = Hdr} = Pkt) -> #diameter_header{cmd_code = CmdCode, is_request = IsRequest, is_error = IsError} = Hdr, - {M, MsgName} = if IsError andalso not IsRequest -> - {?BASE, 'answer-message'}; - true -> - {Mod, Mod:msg_name(CmdCode, IsRequest)} - end, + MsgName = if IsError andalso not IsRequest -> + 'answer-message'; + true -> + Mod:msg_name(CmdCode, IsRequest) + end, - decode_avps(MsgName, M, Pkt, collect_avps(Pkt)); + decode_avps(MsgName, Mod, Pkt, collect_avps(Pkt)); decode(Id, Mod, Bin) when is_bitstring(Bin) -> @@ -360,15 +349,15 @@ hop_by_hop_id(Id, <<H:12/binary, _:32, T/binary>>) -> <<H/binary, Id:32, T/binary>>. %%% --------------------------------------------------------------------------- -%%% # msg_name/1 +%%% # msg_name/2 %%% --------------------------------------------------------------------------- -msg_name(#diameter_header{application_id = ?APP_ID_COMMON, - cmd_code = C, - is_request = R}) -> - ?BASE:msg_name(C,R); +msg_name(Dict0, #diameter_header{application_id = ?APP_ID_COMMON, + cmd_code = C, + is_request = R}) -> + Dict0:msg_name(C,R); -msg_name(Hdr) -> +msg_name(_, Hdr) -> msg_id(Hdr). %% Note that messages in different applications could have the same diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl index 63d28f25a2..9f73815756 100644 --- a/lib/diameter/src/base/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -113,15 +113,22 @@ -define(VALUES(Rec), tl(tuple_to_list(Rec))). +%% The RFC 3588 common dictionary is used to validate capabilities +%% configuration. That a given transport may use the RFC 6733 +%% dictionary is of no consequence. +-define(BASE, diameter_gen_base_rfc3588). + %%% The return values below assume the server diameter_config is started. %%% The functions will exit if it isn't. %% -------------------------------------------------------------------------- -%% # start_service(SvcName, Opts) -%% -%% Output: ok | {error, Reason} +%% # start_service/2 %% -------------------------------------------------------------------------- +-spec start_service(diameter:service_name(), [diameter:service_opt()]) + -> ok + | {error, term()}. + start_service(SvcName, Opts) when is_list(Opts) -> start_rc(sync(SvcName, {start_service, SvcName, Opts})). @@ -134,22 +141,23 @@ start_rc(timeout) -> {error, application_not_started}. %% -------------------------------------------------------------------------- -%% # stop_service(SvcName) -%% -%% Output: ok +%% # stop_service/1 %% -------------------------------------------------------------------------- +-spec stop_service(diameter:service_name()) + -> ok. + stop_service(SvcName) -> sync(SvcName, {stop_service, SvcName}). %% -------------------------------------------------------------------------- -%% # add_transport(SvcName, {Type, Opts}) -%% -%% Input: Type = connect | listen -%% -%% Output: {ok, Ref} | {error, Reason} +%% # add_transport/2 %% -------------------------------------------------------------------------- +-spec add_transport(diameter:service_name(), {connect|listen, [diameter:transport_opt()]}) + -> {ok, diameter:transport_ref()} + | {error, term()}. + add_transport(SvcName, {T, Opts}) when is_list(Opts), (T == connect orelse T == listen) -> sync(SvcName, {add, SvcName, T, Opts}). @@ -171,6 +179,10 @@ add_transport(SvcName, {T, Opts}) %% Output: ok | {error, Reason} %% -------------------------------------------------------------------------- +-spec remove_transport(diameter:service_name(), diameter:transport_pred()) + -> ok + | {error, term()}. + remove_transport(SvcName, Pred) -> try sync(SvcName, {remove, SvcName, pred(Pred)}) @@ -473,6 +485,10 @@ stop(SvcName) -> %% add/3 +%% Can't check for a single common dictionary since a transport may +%% restrict applications so that that there's one while the service +%% has many. + add(SvcName, Type, Opts) -> %% Ensure usable capabilities. diameter_service:merge_service/2 %% depends on this. @@ -545,7 +561,7 @@ make_config(SvcName, Opts) -> [] == Apps andalso ?THROW(no_apps), %% Use the fact that diameter_caps has the same field names as CER. - Fields = diameter_gen_base_rfc3588:'#info-'(diameter_base_CER) -- ['AVP'], + Fields = ?BASE:'#info-'(diameter_base_CER) -- ['AVP'], COpts = [T || {K,_} = T <- Opts, lists:member(K, Fields)], Caps = make_caps(#diameter_caps{}, COpts), @@ -608,14 +624,14 @@ opt(sequence = K, F) -> E:R -> ?THROW({value, {K, E, R, ?STACK}}) end; - + opt(K, _) -> ?THROW({value, K}). sequence({H,N} = T) when 0 =< N, N =< 32, 0 =< H, 0 == H bsr N -> T; - + sequence(_) -> ?THROW({value, sequence}). @@ -629,7 +645,8 @@ make_caps(Caps, Opts) -> %% Validate types by encoding a CER. encode_CER(Opts) -> - {ok, CER} = diameter_capx:build_CER(make_caps(?EXAMPLE_CAPS, Opts)), + {ok, CER} = diameter_capx:build_CER(make_caps(?EXAMPLE_CAPS, Opts), + ?BASE), Hdr = #diameter_header{version = ?DIAMETER_VERSION, end_to_end_id = 0, @@ -653,15 +670,17 @@ app_acc({application, Opts}, Acc) -> [Dict, Mod] = get_opt([dictionary, module], Opts), Alias = get_opt(alias, Opts, Dict), ModS = get_opt(state, Opts, Alias), - M = get_opt(call_mutates_state, Opts, false), - A = get_opt(answer_errors, Opts, report), + M = get_opt(call_mutates_state, Opts, false, [true]), + A = get_opt(answer_errors, Opts, report, [callback, discard]), + P = get_opt(request_errors, Opts, answer_3xxx, [answer, callback]), [#diameter_app{alias = Alias, dictionary = Dict, id = cb(Dict, id), module = init_mod(Mod), init_state = ModS, - mutable = init_mutable(M), - options = [{answer_errors, init_answers(A)}]} + mutable = M, + options = [{answer_errors, A}, + {request_errors, P}]} | Acc]; app_acc(_, Acc) -> Acc. @@ -690,20 +709,16 @@ init_cb(List) -> V <- [proplists:get_value(F, List, D)]], #diameter_callback{} = list_to_tuple([diameter_callback | Values]). -init_mutable(M) - when M == true; - M == false -> - M; -init_mutable(M) -> - ?THROW({call_mutates_state, M}). - -init_answers(A) - when callback == A; - report == A; - discard == A -> - A; -init_answers(A) -> - ?THROW({answer_errors, A}). +%% Retreive and validate. +get_opt(Key, List, Def, Other) -> + init_opt(Key, get_opt(Key, List, Def), [Def|Other]). + +init_opt(_, V, [V|_]) -> + V; +init_opt(Name, V, [_|Vals]) -> + init_opt(Name, V, Vals); +init_opt(Name, V, []) -> + ?THROW({Name, V}). %% Get a single value at the specified key. get_opt(Keys, List) diff --git a/lib/diameter/src/base/diameter_internal.hrl b/lib/diameter/src/base/diameter_internal.hrl index 63b35550a8..4b672aa071 100644 --- a/lib/diameter/src/base/diameter_internal.hrl +++ b/lib/diameter/src/base/diameter_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -58,8 +58,6 @@ -define(APP_ID_COMMON, 0). -define(APP_ID_RELAY, 16#FFFFFFFF). --define(BASE, diameter_gen_base_rfc3588). - %%% --------------------------------------------------------- %%% RFC 3588, ch 2.6 Peer table diff --git a/lib/diameter/src/base/diameter_peer.erl b/lib/diameter/src/base/diameter_peer.erl index 25c9eab4cb..130bedda84 100644 --- a/lib/diameter/src/base/diameter_peer.erl +++ b/lib/diameter/src/base/diameter_peer.erl @@ -123,7 +123,7 @@ pair([_ | Rest], Mods, Acc) -> pair(Rest, Mods, Acc); %% No transport_module or transport_config: defaults. -pair([], [], []) -> +pair([], [], []) -> [{[?DEFAULT_TMOD], ?DEFAULT_TCFG, ?DEFAULT_TTMO}]; %% One transport_module, one transport_config. @@ -272,7 +272,7 @@ handle_cast(Msg, State) -> %% Remote service is distributing a message. handle_info({notify, SvcName, T}, S) -> - bang(diameter_service:whois(SvcName), T), + diameter_service:notify(SvcName, T), {noreply, S}; handle_info(Info, State) -> @@ -304,13 +304,6 @@ code_change(_OldVsn, State, _Extra) -> ifc_send(Pid, T) -> Pid ! {diameter, T}. -%% bang/2 - -bang(undefined = No, _) -> - No; -bang(Pid, T) -> - Pid ! T. - %% call/1 call(Request) -> diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index 5dab6214b1..66342f7b62 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -18,10 +18,10 @@ %% %% -%% This module implements (as a process) the RFC 3588 Peer State +%% This module implements (as a process) the RFC 3588/6733 Peer State %% Machine modulo the necessity of adapting the peer election to the -%% fact that we don't know the identity of a peer until we've -%% received a CER/CEA from it. +%% fact that we don't know the identity of a peer until we've received +%% a CER/CEA from it. %% -module(diameter_peer_fsm). @@ -46,16 +46,19 @@ -include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). --include("diameter_gen_base_rfc3588.hrl"). %% Values of Disconnect-Cause in DPR. --define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU'). --define(REBOOT, ?'DIAMETER_BASE_DISCONNECT-CAUSE_REBOOTING'). --define(BUSY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_BUSY'). +-define(GOAWAY, 2). %% DO_NOT_WANT_TO_TALK_TO_YOU +-define(BUSY, 1). %% BUSY +-define(REBOOT, 0). %% REBOOTING +%% Values of Inband-Security-Id. -define(NO_INBAND_SECURITY, 0). -define(TLS, 1). +%% Note that the a common dictionary hrl is purposely not included +%% since the common dictionary is an argument to start/3. + %% Keys in process dictionary. -define(CB_KEY, cb). %% capabilities callback -define(DPR_KEY, dpr). %% disconnect callback @@ -100,11 +103,13 @@ | {'Wait-CEA', uint32(), uint32()} | 'Open', mode :: accept | connect | {connect, reference()}, - parent :: pid(), %% watchdog process - transport :: pid(), %% transport process + parent :: pid(), %% watchdog process + transport :: pid(), %% transport process + dictionary :: module(), %% common dictionary service :: #diameter_service{}, - dpr = false :: false | {uint32(), uint32()}}). + dpr = false :: false | {uint32(), uint32()}, %% | hop by hop and end to end identifiers + length_errors :: exit | handle | discard}). %% There are non-3588 states possible as a consequence of 5.6.1 of the %% standard and the corresponding problem for incoming CEA's: we don't @@ -126,24 +131,18 @@ %% State Machine rather than closer to the transport. This is what we %% now do below: connect/accept call diameter_watchdog and return the %% pid of the watchdog process, and the watchdog in turn calls start/3 -%% below to start the process implementing the Peer State Machine. The -%% former is a "peer" in diameter_service while the latter is a -%% "conn". In a sense, diameter_service sees the watchdog as -%% implementing the Peer State Machine and the process implemented -%% here as being the transport, not being aware of the watchdog at -%% all. +%% below to start the process implementing the Peer State Machine. %% -%%% --------------------------------------------------------------------------- -%%% # start({connect|accept, Ref}, Opts, Service) -%%% -%%% Output: Pid -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # start/3 +%% --------------------------------------------------------------------------- -spec start(T, [Opt], {diameter:sequence(), - diameter:restriction(), + [node()], + module(), #diameter_service{}}) - -> pid() + -> {reference(), pid()} when T :: {connect|accept, diameter:transport_ref()}, Opt :: diameter:transport_opt(). @@ -152,9 +151,15 @@ %% specified on the transport in question. Check here that the list is %% still non-empty. -start({_,_} = Type, Opts, MS) -> - {ok, Pid} = diameter_peer_fsm_sup:start_child({self(), Type, Opts, MS}), - Pid. +start({_,_} = Type, Opts, S) -> + Ack = make_ref(), + T = {Ack, self(), Type, Opts, S}, + {ok, Pid} = diameter_peer_fsm_sup:start_child(T), + try + {erlang:monitor(process, Pid), Pid} + after + Pid ! Ack + end. start_link(T) -> {ok, _} = proc_lib:start_link(?MODULE, @@ -163,8 +168,8 @@ start_link(T) -> infinity, diameter_lib:spawn_opts(server, [])). -%%% --------------------------------------------------------------------------- -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- %% init/1 @@ -172,12 +177,14 @@ init(T) -> proc_lib:init_ack({ok, self()}), gen_server:enter_loop(?MODULE, [], i(T)). -i({WPid, T, Opts, {Mask, Nodes, #diameter_service{applications = Apps, - capabilities = LCaps} - = Svc}}) -> - [] /= Apps orelse ?ERROR({no_apps, T, Opts}), +i({Ack, WPid, {M, Ref} = T, Opts, {Mask, + Nodes, + Dict0, + #diameter_service{capabilities = LCaps} + = Svc}}) -> + erlang:monitor(process, WPid), + wait(Ack, WPid), putr(?DWA_KEY, dwa(LCaps)), - {M, Ref} = T, diameter_stats:reg(Ref), {[Cs,Ds], Rest} = proplists:split(Opts, [capabilities_cb, disconnect_cb]), putr(?CB_KEY, {Ref, [F || {_,F} <- Cs]}), @@ -185,23 +192,39 @@ i({WPid, T, Opts, {Mask, Nodes, #diameter_service{applications = Apps, putr(?REF_KEY, Ref), putr(?SEQUENCE_KEY, Mask), putr(?RESTRICT_KEY, Nodes), - erlang:monitor(process, WPid), - {TPid, Addrs} = start_transport(T, Rest, Svc), + Tmo = proplists:get_value(capx_timeout, Opts, ?EVENT_TIMEOUT), ?IS_TIMEOUT(Tmo) orelse ?ERROR({invalid, {capx_timeout, Tmo}}), + OnLengthErr = proplists:get_value(length_errors, Opts, exit), + lists:member(OnLengthErr, [exit, handle, discard]) + orelse ?ERROR({invalid, {length_errors, OnLengthErr}}), + + {TPid, Addrs} = start_transport(T, Rest, Svc), + #state{state = {'Wait-Conn-Ack', Tmo}, parent = WPid, transport = TPid, + dictionary = Dict0, mode = M, - service = svc(Svc, Addrs)}. + service = svc(Svc, Addrs), + length_errors = OnLengthErr}. %% The transport returns its local ip addresses so that different %% transports on the same service can use different local addresses. %% The local addresses are put into Host-IP-Address avps here when %% sending capabilities exchange messages. %% %% Invalid transport config may cause us to crash but note that the -%% watchdog start (start/2) succeeds regardless so as not to crash the -%% service. +%% watchdog start (start/2) succeeds regardless. + +%% Wait for the caller to have a monitor to avoid a race with our +%% death. (Since the exit reason is used in diameter_service.) +wait(Ref, Pid) -> + receive + Ref -> + ok; + {'DOWN', _, process, Pid, _} = D -> + exit({shutdown, D}) + end. start_transport(T, Opts, #diameter_service{capabilities = LCaps} = Svc) -> Addrs0 = LCaps#diameter_caps.host_ip_address, @@ -274,13 +297,12 @@ handle_info(T, #state{} = State) -> {noreply, S}; {stop, Reason} -> ?LOG(stop, Reason), - x(Reason, State); + {stop, {shutdown, Reason}, State}; stop -> ?LOG(stop, T), - x(T, State) + {stop, {shutdown, T}, State} catch exit: {diameter_codec, encode, _} = Reason -> - close_wd(Reason, State#state.parent), ?LOG(stop, Reason), %% diameter_codec:encode/2 emits an error report. Only %% indicate the probable reason here. @@ -300,10 +322,6 @@ handle_info(T, #state{} = State) -> %% succesfully encoded. It's not checked at diameter:add_transport/2 %% since this can be called before creating the service. -x(Reason, #state{} = S) -> - close_wd(Reason, S), - {stop, {shutdown, Reason}, S}. - %% terminate/2 terminate(_, _) -> @@ -314,8 +332,8 @@ terminate(_, _) -> code_change(_, State, _) -> {ok, State}. -%%% --------------------------------------------------------------------------- -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- putr(Key, Val) -> put({?MODULE, Key}, Val). @@ -378,9 +396,8 @@ transition({diameter, {recv, Pkt}}, S) -> recv(Pkt, S); %% Timeout when still in the same state ... -transition({timeout = T, PS}, #state{state = PS} = S) -> - close({capx(PS), T}, S), - stop; +transition({timeout = T, PS}, #state{state = PS}) -> + {stop, {capx(PS), T}}; %% ... or not. transition({timeout, _}, _) -> @@ -393,8 +410,6 @@ transition({send, Msg}, #state{transport = TPid}) -> %% Request for graceful shutdown at remove_transport, stop_service of %% application shutdown. -transition({shutdown = T, Pid}, S) -> - transition({T, Pid, transport}, S); transition({shutdown, Pid, Reason}, #state{parent = Pid, dpr = false} = S) -> dpr(Reason, S); transition({shutdown, Pid, _}, #state{parent = Pid}) -> @@ -454,18 +469,19 @@ start_next(#state{service = Svc0} = S) -> send_CER(#state{state = {'Wait-Conn-Ack', Tmo}, mode = {connect, Remote}, service = #diameter_service{capabilities = LCaps}, - transport = TPid} + transport = TPid, + dictionary = Dict} = S) -> OH = LCaps#diameter_caps.origin_host, req_send_CER(OH, Remote) orelse - close({already_connected, Remote, LCaps}, S), + close({already_connected, Remote, LCaps}), CER = build_CER(S), ?LOG(send, 'CER'), #diameter_packet{header = #diameter_header{end_to_end_id = Eid, hop_by_hop_id = Hid}} = Pkt - = encode(CER), + = encode(CER, Dict), send(TPid, Pkt), start_timer(Tmo, S#state{state = {'Wait-CEA', Hid, Eid}}). @@ -487,42 +503,29 @@ start_timer(Tmo, #state{state = PS} = S) -> %% build_CER/1 -build_CER(#state{service = #diameter_service{capabilities = LCaps}}) -> - {ok, CER} = diameter_capx:build_CER(LCaps), +build_CER(#state{service = #diameter_service{capabilities = LCaps}, + dictionary = Dict}) -> + {ok, CER} = diameter_capx:build_CER(LCaps, Dict), CER. -%% encode/1 +%% encode/2 -encode(Rec) -> +encode(Rec, Dict) -> Seq = diameter_session:sequence({_,_} = getr(?SEQUENCE_KEY)), Hdr = #diameter_header{version = ?DIAMETER_VERSION, end_to_end_id = Seq, hop_by_hop_id = Seq}, - diameter_codec:encode(?BASE, #diameter_packet{header = Hdr, - msg = Rec}). + diameter_codec:encode(Dict, #diameter_packet{header = Hdr, + msg = Rec}). %% recv/2 -%% RFC 3588 has result code 5015 for an invalid length but if a -%% transport is detecting message boundaries using the length header -%% then a length error will likely lead to further errors. - -recv(#diameter_packet{header = #diameter_header{length = Len} - = Hdr, - bin = Bin}, - S) - when Len < 20; - (0 /= Len rem 4 orelse bit_size(Bin) /= 8*Len) -> - discard(invalid_message_length, recv, [size(Bin), - bit_size(Bin) rem 8, - Hdr, - S]); - recv(#diameter_packet{header = #diameter_header{} = Hdr} = Pkt, - #state{parent = Pid} + #state{parent = Pid, + dictionary = Dict0} = S) -> - Name = diameter_codec:msg_name(Hdr), + Name = diameter_codec:msg_name(Dict0, Hdr), Pid ! {recv, self(), Name, Pkt}, diameter_stats:incr({msg_id(Name, Hdr), recv}), %% count received rcv(Name, Pkt, S); @@ -531,29 +534,52 @@ recv(#diameter_packet{header = undefined, bin = Bin} = Pkt, S) -> - recv(Pkt#diameter_packet{header = diameter_codec:decode_header(Bin)}, S); + recv(diameter_codec:decode_header(Bin), Pkt, S); -recv(Bin, S) - when is_binary(Bin) -> - recv(#diameter_packet{bin = Bin}, S); +recv(Bin, S) -> + recv(#diameter_packet{bin = Bin}, S). -recv(#diameter_packet{header = false} = Pkt, S) -> - discard(truncated_header, recv, [Pkt, S]). +%% recv/3 -msg_id({_,_,_} = T, _) -> - T; -msg_id(_, Hdr) -> - diameter_codec:msg_id(Hdr). +recv(#diameter_header{length = Len} + = H, + #diameter_packet{bin = Bin} + = Pkt, + #state{length_errors = E} + = S) + when E == handle; + 0 == Len rem 4, bit_size(Bin) == 8*Len -> + recv(Pkt#diameter_packet{header = H}, S); + +recv(#diameter_header{} + = H, + #diameter_packet{bin = Bin}, + #state{length_errors = E} + = S) -> + invalid(E, + invalid_message_length, + recv, + [size(Bin), bit_size(Bin) rem 8, H, S]); -%% Treat invalid length as a transport error and die. Especially in -%% the TCP case, in which there's no telling where the next message -%% begins in the incoming byte stream, keeping a crippled connection -%% alive may just make things worse. +recv(false, Pkt, #state{length_errors = E} = S) -> + invalid(E, truncated_header, recv, [Pkt, S]). -discard(Reason, F, A) -> +%% Note that counters here only count discarded messages. +invalid(E, Reason, F, A) -> diameter_stats:incr(Reason), + abort(E, Reason, F, A). + +abort(exit, Reason, F, A) -> diameter_lib:warning_report(Reason, {?MODULE, F, A}), - throw({?MODULE, abort, Reason}). + throw({?MODULE, abort, Reason}); + +abort(_, _, _, _) -> + ok. + +msg_id({_,_,_} = T, _) -> + T; +msg_id(_, Hdr) -> + {_,_,_} = diameter_codec:msg_id(Hdr). %% rcv/3 @@ -607,13 +633,13 @@ send(Pid, Msg) -> %% handle_request/3 -handle_request(Type, #diameter_packet{} = Pkt, S) -> +handle_request(Type, #diameter_packet{} = Pkt, #state{dictionary = D} = S) -> ?LOG(recv, Type), - send_answer(Type, diameter_codec:decode(?BASE, Pkt), S). + send_answer(Type, diameter_codec:decode(D, Pkt), S). %% send_answer/3 -send_answer(Type, ReqPkt, #state{transport = TPid} = S) -> +send_answer(Type, ReqPkt, #state{transport = TPid, dictionary = Dict} = S) -> #diameter_packet{header = H, transport_data = TD} = ReqPkt, @@ -630,13 +656,15 @@ send_answer(Type, ReqPkt, #state{transport = TPid} = S) -> msg = Msg, transport_data = TD}, - send(TPid, diameter_codec:encode(?BASE, Pkt)), + send(TPid, diameter_codec:encode(Dict, Pkt)), eval(PostF, S). eval([F|A], S) -> apply(F, A ++ [S]); eval(ok, S) -> - S. + S; +eval(T, _) -> + close(T). %% build_answer/3 @@ -647,11 +675,11 @@ build_answer('CER', is_error = false}, errors = []} = Pkt, - S) -> - {SupportedApps, RCaps, #diameter_base_CEA{'Result-Code' = RC, - 'Inband-Security-Id' = IS} - = CEA} - = recv_CER(CER, S), + #state{dictionary = Dict0} + = S) -> + {SupportedApps, RCaps, CEA} = recv_CER(CER, S), + + [RC, IS] = Dict0:'#get-'(['Result-Code', 'Inband-Security-Id'], CEA), #diameter_caps{origin_host = {OH, DH}} = Caps @@ -664,10 +692,10 @@ build_answer('CER', orelse ?THROW(4003), %% DIAMETER_ELECTION_LOST caps_cb(Caps) of - N -> {cea(CEA, N), [fun open/5, Pkt, - SupportedApps, - Caps, - {accept, hd([_] = IS)}]} + N -> {cea(CEA, N, Dict0), [fun open/5, Pkt, + SupportedApps, + Caps, + {accept, hd([_] = IS)}]} catch ?FAILURE(Reason) -> rejected(Reason, {'CER', Reason, Caps, Pkt}, S) @@ -684,25 +712,25 @@ build_answer(Type, RC = rc(H, Es), {answer(Type, RC, Es, S), post(Type, RC, Pkt, S)}. -cea(CEA, ok) -> +cea(CEA, ok, _) -> CEA; -cea(CEA, 2001) -> +cea(CEA, 2001, _) -> CEA; -cea(CEA, RC) -> - CEA#diameter_base_CEA{'Result-Code' = RC}. +cea(CEA, RC, Dict0) -> + Dict0:'#set-'({'Result-Code', RC}, CEA). post('CER' = T, RC, Pkt, S) -> - [fun close/2, {T, caps(S), {RC, Pkt}}]; + {T, caps(S), {RC, Pkt}}; post(_, _, _, _) -> ok. rejected({capabilities_cb, _F, Reason}, T, S) -> rejected(Reason, T, S); -rejected(discard, T, S) -> - close(T, S); +rejected(discard, T, _) -> + close(T); rejected({N, Es}, T, S) -> - {answer('CER', N, Es, S), [fun close/2, T]}; + {answer('CER', N, Es, S), T}; rejected(N, T, S) -> rejected({N, []}, T, S). @@ -728,7 +756,7 @@ is_origin({N, _}) -> orelse N == 'Origin-State-Id'. %% failed_avp/1 - + failed_avp([] = No) -> No; failed_avp(Avps) -> @@ -817,22 +845,23 @@ a('DPR', #diameter_caps{origin_host = {Host, _}, %% recv_CER/2 -recv_CER(CER, #state{service = Svc}) -> - {ok, T} = diameter_capx:recv_CER(CER, Svc), +recv_CER(CER, #state{service = Svc, dictionary = Dict}) -> + {ok, T} = diameter_capx:recv_CER(CER, Svc, Dict), T. %% handle_CEA/1 handle_CEA(#diameter_packet{bin = Bin} = Pkt, - #state{service = #diameter_service{capabilities = LCaps}} + #state{dictionary = Dict0, + service = #diameter_service{capabilities = LCaps}} = S) when is_binary(Bin) -> ?LOG(recv, 'CEA'), #diameter_packet{msg = CEA} = DPkt - = diameter_codec:decode(?BASE, Pkt), + = diameter_codec:decode(Dict0, Pkt), {SApps, IS, RCaps} = recv_CEA(DPkt, S), @@ -840,8 +869,7 @@ handle_CEA(#diameter_packet{bin = Bin} = Caps = capz(LCaps, RCaps), - #diameter_base_CEA{'Result-Code' = RC} - = CEA, + RC = Dict0:'#get-'('Result-Code', CEA), %% Ensure that we don't already have a connection to the peer in %% question. This isn't the peer election of 3588 except in the @@ -862,7 +890,7 @@ handle_CEA(#diameter_packet{bin = Bin} of _ -> open(DPkt, SApps, Caps, {connect, hd([_] = IS)}, S) catch - ?FAILURE(Reason) -> close({'CEA', Reason, Caps, DPkt}, S) + ?FAILURE(Reason) -> close({'CEA', Reason, Caps, DPkt}) end. %% Check more than the result code since the peer could send success %% regardless. If not 2001 then a peer_up callback could do anything @@ -877,12 +905,13 @@ recv_CEA(#diameter_packet{header = #diameter_header{version is_error = false}, msg = CEA, errors = []}, - #state{service = Svc}) -> - {ok, T} = diameter_capx:recv_CEA(CEA, Svc), + #state{service = Svc, + dictionary = Dict}) -> + {ok, T} = diameter_capx:recv_CEA(CEA, Svc, Dict), T; recv_CEA(Pkt, S) -> - close({'CEA', caps(S), Pkt}, S). + close({'CEA', caps(S), Pkt}). caps(#diameter_service{capabilities = Caps}) -> Caps; @@ -935,14 +964,14 @@ open(Pkt, SupportedApps, Caps, {Type, IS}, #state{parent = Pid, %% We've advertised TLS support: tell the transport the result %% and expect a reply when the handshake is complete. -tls_ack(true, Caps, Type, IS, #state{transport = TPid} = S) -> +tls_ack(true, Caps, Type, IS, #state{transport = TPid}) -> Ref = make_ref(), TPid ! {diameter, {tls, Ref, Type, IS == ?TLS}}, receive {diameter, {tls, Ref}} -> ok; {'DOWN', _, process, TPid, Reason} -> - close({tls_ack, Reason, Caps}, S) + close({tls_ack, Reason, Caps}) end; %% Or not. Don't send anything to the transport so that transports @@ -955,25 +984,11 @@ capz(#diameter_caps{} = L, #diameter_caps{} = R) -> = list_to_tuple([diameter_caps | lists:zip(tl(tuple_to_list(L)), tl(tuple_to_list(R)))]). -%% close/2 +%% close/1 -%% Tell the watchdog that our death isn't due to transport failure. -close(Reason, #state{parent = Pid}) -> - close_wd(Reason, Pid), +close(Reason) -> throw({?MODULE, close, Reason}). -%% close_wd/2 - -%% Ensure the watchdog dies if DPR has been sent ... -close_wd(_, #state{dpr = false}) -> - ok; -close_wd(Reason, #state{parent = Pid}) -> - close_wd(Reason, Pid); - -%% ... or otherwise -close_wd(Reason, Pid) -> - Pid ! {close, self(), Reason}. - %% dwa/1 dwa(#diameter_caps{origin_host = OH, @@ -1035,13 +1050,14 @@ dpr([CB|Rest], [Reason | _] = Args, S) -> diameter_lib:error_report(failure, No), {stop, No} end; - + dpr([], [Reason | _], S) -> send_dpr(Reason, [], S). -record(opts, {cause, timeout = ?DPA_TIMEOUT}). send_dpr(Reason, Opts, #state{transport = TPid, + dictionary = Dict, service = #diameter_service{capabilities = Caps}} = S) -> #opts{cause = Cause, timeout = Tmo} @@ -1061,7 +1077,8 @@ send_dpr(Reason, Opts, #state{transport = TPid, = Pkt = encode(['DPR', {'Origin-Host', OH}, {'Origin-Realm', OR}, - {'Disconnect-Cause', Cause}]), + {'Disconnect-Cause', Cause}], + Dict), send(TPid, Pkt), dpa_timer(Tmo), ?LOG(send, 'DPR'), diff --git a/lib/diameter/src/base/diameter_reg.erl b/lib/diameter/src/base/diameter_reg.erl index 619b12ecad..ac58e4bf5b 100644 --- a/lib/diameter/src/base/diameter_reg.erl +++ b/lib/diameter/src/base/diameter_reg.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -208,10 +208,6 @@ init(_) -> %% # handle_call/3 %% ---------------------------------------------------------- -handle_call(Req, From, S) - when not is_record(S, state) -> - handle_call(Req, From, upgrade(S)); - handle_call({add, Fun, Key, Pid}, _, S) -> B = Fun(?TABLE, {Key, Pid}), monitor(B andalso no_monitor(Pid), Pid), @@ -281,9 +277,6 @@ code_change(_OldVsn, State, _Extra) -> %% =========================================================================== -upgrade(S) -> - #state{} = list_to_tuple(tuple_to_list(S) ++ [[]]). - monitor(true, Pid) -> ets:insert(?TABLE, ?MONITOR(Pid, erlang:monitor(process, Pid))); monitor(false, _) -> diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index d2a416166f..f1342df16c 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -24,33 +24,38 @@ -module(diameter_service). -behaviour(gen_server). +%% towards diameter_service_sup +-export([start_link/1]). + +%% towards diameter +-export([subscribe/1, + unsubscribe/1, + services/0, + info/2]). + +%% towards diameter_config -export([start/1, stop/1, start_transport/2, - stop_transport/2, - info/2, - call/4]). + stop_transport/2]). -%% towards diameter_watchdog --export([receive_message/3]). +%% towards diameter_peer +-export([notify/2]). -%% service supervisor --export([start_link/1]). +%% towards diameter_traffic +-export([find_incoming_app/4, + pick_peer/3]). --export([subscribe/1, - unsubscribe/1, +%% test/debug +-export([services/1, subscriptions/1, subscriptions/0, - services/0, - services/1, - whois/1]). - -%% test/debug --export([call_module/3, + call_module/3, + whois/1, state/1, uptime/1]). -%%% gen_server callbacks +%% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, @@ -58,21 +63,10 @@ terminate/2, code_change/3]). -%% Other callbacks. --export([send/1]). - -include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). -%% The states mirrored by peer_up/peer_down callbacks. --define(STATE_UP, up). --define(STATE_DOWN, down). - --type op_state() :: ?STATE_UP - | ?STATE_DOWN. - -%% The RFC 3539 watchdog states that are now maintained, albeit -%% along with the old up/down. okay = up, else down. +%% RFC 3539 watchdog states. -define(WD_INITIAL, initial). -define(WD_OKAY, okay). -define(WD_SUSPECT, suspect). @@ -86,11 +80,8 @@ | ?WD_REOPEN. -define(DEFAULT_TC, 30000). %% RFC 3588 ch 2.1 --define(DEFAULT_TIMEOUT, 5000). %% for outgoing requests -define(RESTART_TC, 1000). %% if restart was this recent --define(RELAY, ?DIAMETER_DICT_RELAY). - %% Used to be able to swap this with anything else dict-like but now %% rely on the fact that a service's #state{} record does not change %% in storing in it ?STATE table and not always going through the @@ -98,10 +89,6 @@ %% a ?Dict don't change the handle to it. -define(Dict, diameter_dict). -%% Table containing outgoing requests for which a reply has yet to be -%% received. --define(REQUEST_TABLE, diameter_request). - %% Maintains state in a table. In contrast to previously, a service's %% stat is not constant and is accessed outside of the service %% process. @@ -115,83 +102,58 @@ %% Workaround for dialyzer's lack of understanding of match specs. -type match(T) - :: T | '_' | '$1' | '$2' | '$3' | '$4'. - -%% State of service gen_server. + :: T | '_' | '$1' | '$2'. + +%% State of service gen_server. Note that the state term itself +%% doesn't change, which is relevant for the stateless application +%% callbacks since the state is retrieved from ?STATE_TABLE from +%% outside the service process. The pid in the service record is used +%% to determine whether or not we need to call the process for a +%% pick_peer callback in the statefull case. -record(state, {id = now(), - service_name, %% as passed to start_service/2, key in ?STATE_TABLE + service_name :: diameter:service_name(), %% key in ?STATE_TABLE service :: #diameter_service{}, - peerT = ets_new(peers) :: ets:tid(),%% #peer{} at start_fsm - connT = ets_new(conns) :: ets:tid(),%% #conn{} at connection_up/reopen - shared_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...] - local_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...] + watchdogT = ets_new(watchdogs) %% #watchdog{} at start + :: ets:tid(), + peerT = ets_new(peers) %% #peer{pid = TPid} at okay/reopen + :: ets:tid(), + shared_peers = ?Dict:new() %% Alias -> [{TPid, Caps}, ...] + :: ets:tid(), + local_peers = ?Dict:new() %% Alias -> [{TPid, Caps}, ...] + :: ets:tid(), monitor = false :: false | pid(), %% process to die with options :: [{sequence, diameter:sequence()} %% sequence mask | {restrict_connections, diameter:restriction()} | {share_peers, boolean()} %% broadcast peers to remote nodes? | {use_shared_peers, boolean()}]}).%% use broadcasted peers? -%% shared_peers reflects the peers broadcast from remote nodes. Note -%% that the state term itself doesn't change, which is relevant for -%% the stateless application callbacks since the state is retrieved -%% from ?STATE_TABLE from outside the service process. The pid in the -%% service record is used to determine whether or not we need to call -%% the process for a pick_peer callback. - -%% Record representing a watchdog process as implemented by -%% diameter_watchdog. The term "peer" here is historical, made -%% especially confusing by the fact that a peer_ref() in the -%% documentation is the key of a #conn{} record, not a #peer{} record. -%% The name is also unfortunate given the meaning of peer in the -%% Diameter sense. --record(peer, +%% shared_peers reflects the peers broadcast from remote nodes. + +%% Record representing an RFC 3539 watchdog process implemented by +%% diameter_watchdog. +-record(watchdog, {pid :: match(pid()), type :: match(connect | accept), ref :: match(reference()), %% key into diameter_config options :: match([diameter:transport_opt()]),%% from start_transport - op_state = {?STATE_DOWN, ?WD_INITIAL} - :: match(op_state() | {op_state(), wd_state()}), + state = ?WD_INITIAL :: match(wd_state()), started = now(), %% at process start - conn = false :: match(boolean() | pid())}). - %% true at accepted, pid() at connection_up or reopen - -%% Record representing a peer process as implemented by -%% diameter_peer_fsm. The term "conn" is historical. Despite the name -%% here, comments refer to watchdog and peer processes, that are keys -%% in #peer{} and #conn{} records respectively. To add to the -%% confusion, a #request.transport is a peer process = key in a -%% #conn{} record. The actual transport process (that the peer process -%% knows about and that has a transport connection) isn't seen here. --record(conn, + peer = false :: match(boolean() | pid())}). + %% true at accepted, pid() at okay/reopen + +%% Record representing an Peer State Machine processes implemented by +%% diameter_peer_fsm. +-record(peer, {pid :: pid(), apps :: [{0..16#FFFFFFFF, diameter:app_alias()}], %% {Id, Alias} caps :: #diameter_caps{}, started = now(), %% at process start - peer :: pid()}). %% key into peerT - -%% Record stored in diameter_request for each outgoing request. --record(request, - {from, %% arg 2 of handle_call/3 - handler :: match(pid()), %% request process - transport :: match(pid()), %% peer process - caps :: match(#diameter_caps{}), - app :: match(diameter:app_alias()),%% #diameter_app.alias - dictionary :: match(module()), %% #diameter_app.dictionary - module :: match([module() | list()]), %% #diameter_app.module - filter :: match(diameter:peer_filter()), - packet :: match(#diameter_packet{})}). - -%% Record call/4 options are parsed into. --record(options, - {filter = none :: diameter:peer_filter(), - extra = [] :: list(), - timeout = ?DEFAULT_TIMEOUT :: 0..16#FFFFFFFF, - detach = false :: boolean()}). - -%%% --------------------------------------------------------------------------- -%%% # start(SvcName) -%%% --------------------------------------------------------------------------- + watchdog :: pid()}). %% key into watchdogT + +%% --------------------------------------------------------------------------- +%% # start/1 +%% --------------------------------------------------------------------------- start(SvcName) -> diameter_service_sup:start_child(SvcName). @@ -202,9 +164,9 @@ start_link(SvcName) -> %% Put the arbitrary term SvcName in a list in case we ever want to %% send more than this and need to distinguish old from new. -%%% --------------------------------------------------------------------------- -%%% # stop(SvcName) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # stop/1 +%% --------------------------------------------------------------------------- stop(SvcName) -> case whois(SvcName) of @@ -220,180 +182,43 @@ stop(ok, Pid) -> stop(No, _) -> No. -%%% --------------------------------------------------------------------------- -%%% # start_transport(SvcName, {Ref, Type, Opts}) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # start_transport/3 +%% --------------------------------------------------------------------------- -start_transport(SvcName, {_,_,_} = T) -> +start_transport(SvcName, {_Ref, _Type, _Opts} = T) -> call_service_by_name(SvcName, {start, T}). -%%% --------------------------------------------------------------------------- -%%% # stop_transport(SvcName, Refs) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # stop_transport/2 +%% --------------------------------------------------------------------------- stop_transport(_, []) -> ok; stop_transport(SvcName, [_|_] = Refs) -> call_service_by_name(SvcName, {stop, Refs}). -%%% --------------------------------------------------------------------------- -%%% # info(SvcName, Item) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # info/2 +%% --------------------------------------------------------------------------- info(SvcName, Item) -> - case find_state(SvcName) of - #state{} = S -> + case lookup_state(SvcName) of + [#state{} = S] -> service_info(Item, S); - false -> + [] -> undefined end. -%%% --------------------------------------------------------------------------- -%%% # receive_message(TPid, Pkt, MessageData) -%%% --------------------------------------------------------------------------- - -%% Handle an incoming Diameter message in the watchdog process. This -%% used to come through the service process but this avoids that -%% becoming a bottleneck. - -receive_message(TPid, Pkt, T) - when is_pid(TPid) -> - #diameter_packet{header = #diameter_header{is_request = R}} = Pkt, - recv(R, (not R) andalso lookup_request(Pkt, TPid), TPid, Pkt, T). - -%% Incoming request ... -recv(true, false, TPid, Pkt, T) -> - try - spawn(fun() -> recv_request(TPid, Pkt, T) end) - catch - error: system_limit = E -> %% discard - ?LOG({error, E}, now()) - end; - -%% ... answer to known request ... -recv(false, #request{from = {_, Ref}, handler = Pid} = Req, _, Pkt, _) -> - Pid ! {answer, Ref, Req, Pkt}; -%% Note that failover could have happened prior to this message being -%% received and triggering failback. That is, both a failover message -%% and answer may be on their way to the handler process. In the worst -%% case the request process gets notification of the failover and -%% sends to the alternate peer before an answer arrives, so it's -%% always the case that we can receive more than one answer after -%% failover. The first answer received by the request process wins, -%% any others are discarded. - -%% ... or not. -recv(false, false, _, _, _) -> - ok. - -%%% --------------------------------------------------------------------------- -%%% # call(SvcName, App, Msg, Options) -%%% --------------------------------------------------------------------------- - -call(SvcName, App, Msg, Options) - when is_list(Options) -> - Rec = make_options(Options), - Ref = make_ref(), - Caller = {self(), Ref}, - Fun = fun() -> exit({Ref, call(SvcName, App, Msg, Rec, Caller)}) end, - try spawn_monitor(Fun) of - {_, MRef} -> - recv(MRef, Ref, Rec#options.detach, false) - catch - error: system_limit = E -> - {error, E} - end. - -%% Don't rely on gen_server:call/3 for the timeout handling since it -%% makes no guarantees about not leaving a reply message in the -%% mailbox if we catch its exit at timeout. It currently *can* do so, -%% which is also undocumented. - -recv(MRef, _, true, true) -> - erlang:demonitor(MRef, [flush]), - ok; - -recv(MRef, Ref, Detach, Sent) -> - receive - Ref -> %% send has been attempted - recv(MRef, Ref, Detach, true); - {'DOWN', MRef, process, _, Reason} -> - call_rc(Reason, Ref, Sent) - end. - -%% call/5 has returned ... -call_rc({Ref, Ans}, Ref, _) -> - Ans; - -%% ... or not. In this case failure/encode are documented. -call_rc(_, _, Sent) -> - {error, choose(Sent, failure, encode)}. - -%% call/5 -%% -%% In the process spawned for the outgoing request. - -call(SvcName, App, Msg, Opts, Caller) -> - c(find_state(SvcName), App, Msg, Opts, Caller). - -c(#state{service_name = Svc, options = [{_, Mask} | _]} = S, - App, - Msg, - Opts, - Caller) -> - case find_transport(App, Msg, Opts, S) of - {_,_,_} = T -> - send_request(T, Mask, Msg, Opts, Caller, Svc); - false -> - {error, no_connection}; - {error, _} = No -> - No - end; - -c(false, _, _, _, _) -> - {error, no_service}. - -%% find_state/1 - -find_state(SvcName) -> - fs(ets:lookup(?STATE_TABLE, SvcName)). - -fs([#state{} = S]) -> - S; - -fs([]) -> - false. - -%% make_options/1 +%% lookup_state/1 -make_options(Options) -> - lists:foldl(fun mo/2, #options{}, Options). +lookup_state(SvcName) -> + ets:lookup(?STATE_TABLE, SvcName). -mo({timeout, T}, Rec) - when is_integer(T), 0 =< T -> - Rec#options{timeout = T}; - -mo({filter, F}, #options{filter = none} = Rec) -> - Rec#options{filter = F}; -mo({filter, F}, #options{filter = {all, Fs}} = Rec) -> - Rec#options{filter = {all, [F | Fs]}}; -mo({filter, F}, #options{filter = F0} = Rec) -> - Rec#options{filter = {all, [F0, F]}}; - -mo({extra, L}, #options{extra = X} = Rec) - when is_list(L) -> - Rec#options{extra = X ++ L}; - -mo(detach, Rec) -> - Rec#options{detach = true}; - -mo(T, _) -> - ?ERROR({invalid_option, T}). - -%%% --------------------------------------------------------------------------- -%%% # subscribe(SvcName) -%%% # unsubscribe(SvcName) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # subscribe/1 +%% # unsubscribe/1 +%% --------------------------------------------------------------------------- subscribe(SvcName) -> diameter_reg:add({?MODULE, subscriber, SvcName}). @@ -410,9 +235,9 @@ subscriptions() -> pmap(Props) -> lists:map(fun({{?MODULE, _, Name}, Pid}) -> {Name, Pid} end, Props). -%%% --------------------------------------------------------------------------- -%%% # services(Pattern) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # services/1 +%% --------------------------------------------------------------------------- services(Pat) -> pmap(diameter_reg:match({?MODULE, service, Pat})). @@ -428,6 +253,86 @@ whois(SvcName) -> undefined end. +%% --------------------------------------------------------------------------- +%% # pick_peer/3 +%% --------------------------------------------------------------------------- + +-spec pick_peer(SvcName, AppOrAlias, Opts) + -> {{TPid, Caps, App}, Mask} + | false + | {error, term()} + when SvcName :: diameter:service_name(), + AppOrAlias :: {alias, diameter:app_alias()} | #diameter_app{}, + Opts :: tuple(), + TPid :: pid(), + Caps :: #diameter_caps{}, + App :: #diameter_app{}, + Mask :: diameter:sequence(). + +pick_peer(SvcName, App, Opts) -> + pick(lookup_state(SvcName), App, Opts). + +pick([], _, _) -> + {error, no_service}; + +pick([S], App, Opts) -> + pick(S, App, Opts); + +pick(#state{service = #diameter_service{applications = Apps}} + = S, + {alias, Alias}, + Opts) -> %% initial call from diameter:call/4 + pick(S, find_outgoing_app(Alias, Apps), Opts); + +pick(_, false, _) -> + false; + +pick(#state{options = [{_, Mask} | _]} + = S, + #diameter_app{module = ModX, dictionary = Dict} + = App0, + {DestF, Filter, Xtra}) -> + App = App0#diameter_app{module = ModX ++ Xtra}, + [_,_] = RealmAndHost = diameter_lib:eval([DestF, Dict]), + case pick_peer(App, RealmAndHost, Filter, S) of + {TPid, Caps} -> + {{TPid, Caps, App}, Mask}; + false = No -> + No + end. + +%% --------------------------------------------------------------------------- +%% # find_incoming_app/4 +%% --------------------------------------------------------------------------- + +-spec find_incoming_app(PeerT, TPid, Id, Apps) + -> {#diameter_app{}, #diameter_caps{}} %% connection and suitable app + | #diameter_caps{} %% connection but no suitable app + | false %% no connection + when PeerT :: ets:tid(), + TPid :: pid(), + Id :: non_neg_integer(), + Apps :: [#diameter_app{}]. + +find_incoming_app(PeerT, TPid, Id, Apps) -> + try ets:lookup(PeerT, TPid) of + [#peer{} = P] -> + find_incoming_app(P, Id, Apps); + [] -> %% transport has gone down + false + catch + error: badarg -> %% service has gone down (and taken table with it) + false + end. + +%% --------------------------------------------------------------------------- +%% # notify/2 +%% --------------------------------------------------------------------------- + +notify(SvcName, Msg) -> + Pid = whois(SvcName), + is_pid(Pid) andalso (Pid ! Msg). + %% =========================================================================== %% =========================================================================== @@ -442,9 +347,9 @@ uptime(Svc) -> call_module(Service, AppMod, Request) -> call_service(Service, {call_module, AppMod, Request}). -%%% --------------------------------------------------------------------------- -%%% # init([SvcName]) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # init/1 +%% --------------------------------------------------------------------------- init([SvcName]) -> process_flag(trap_exit, true), %% ensure terminate(shutdown, _) @@ -455,9 +360,9 @@ i(SvcName, true) -> i(_, false) -> {stop, {shutdown, already_started}}. -%%% --------------------------------------------------------------------------- -%%% # handle_call(Req, From, State) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # handle_call/3 +%% --------------------------------------------------------------------------- handle_call(state, _, S) -> {reply, S, S}; @@ -493,17 +398,17 @@ handle_call(Req, From, S) -> unexpected(handle_call, [Req, From], S), {reply, nok, S}. -%%% --------------------------------------------------------------------------- -%%% # handle_cast(Req, State) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # handle_cast/2 +%% --------------------------------------------------------------------------- handle_cast(Req, S) -> unexpected(handle_cast, [Req], S), {noreply, S}. -%%% --------------------------------------------------------------------------- -%%% # handle_info(Req, State) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # handle_info/2 +%% --------------------------------------------------------------------------- handle_info(T, #state{} = S) -> case transition(T,S) of @@ -520,67 +425,39 @@ transition({accepted, Pid, TPid}, S) -> accepted(Pid, TPid, S), ok; -%% Peer process has a new open connection. -transition({connection_up, Pid, T}, S) -> - connection_up(Pid, T, S), - ok; - -%% Watchdog has a new connection that will be opened after DW[RA] -%% exchange. This message was added long after connection_up, to -%% communicate the information as soon as it's available. Leave -%% connection_up as is it for now, duplicated information and all. -transition({reopen, Pid, T}, S) -> - reopen(Pid, T, S), - ok; - -%% Watchdog has left state OKAY. -transition({connection_down, Pid}, S) -> - connection_down(Pid, S), - ok; - -%% Watchdog has returned to state OKAY. -transition({connection_up, Pid}, S) -> - connection_up(Pid, S), - ok; - -%% Accepting transport has lost connectivity. -transition({close, Pid}, S) -> - close(Pid, S), - ok; - %% Connecting transport is being restarted by watchdog. transition({reconnect, Pid}, S) -> reconnect(Pid, S), ok; -%% Watchdog is sending notification of a state transition. Note that -%% the connection_up/down messages pre-date this message and are still -%% used. A watchdog message will follow these and communicate the same -%% state as was set in handling connection_up/down. -transition({watchdog, Pid, {TPid, From, To}}, #state{service_name = SvcName, - peerT = PeerT}) -> - #peer{ref = Ref, type = T, options = Opts, op_state = {OS,_}} - = P - = fetch(PeerT, Pid), - insert(PeerT, P#peer{op_state = {OS, To}}), +%% Watchdog is sending notification of transport death. +transition({close, Pid, Reason}, #state{service_name = SvcName, + watchdogT = WatchdogT}) -> + #watchdog{state = WS, + ref = Ref, + type = Type, + options = Opts} + = fetch(WatchdogT, Pid), + WS /= ?WD_OKAY + andalso + send_event(SvcName, {closed, Ref, Reason, {type(Type), Opts}}), + ok; + +%% Watchdog is sending notification of a state transition. +transition({watchdog, Pid, {[TPid | Data], From, To}}, + #state{service_name = SvcName, + watchdogT = WatchdogT} + = S) -> + #watchdog{ref = Ref, type = T, options = Opts} + = Wd + = fetch(WatchdogT, Pid), + watchdog(TPid, Data, From, To, Wd, S), send_event(SvcName, {watchdog, Ref, TPid, {From, To}, {T, Opts}}), ok; -%% Death of a watchdog process (#peer.pid) results in the removal of -%% it's peer and any associated conn record when 'DOWN' is received -%% (after this) but the states will be {?STATE_UP, ?WD_DOWN} for a -%% short time. (No real problem since ?WD_* is only used in -%% service_info.) We set ?WD_OKAY as a consequence of connection_up -%% since we know a watchdog is coming. We can't set anything at -%% connection_down since we don't know if the subsequent watchdog -%% message will be ?WD_DOWN or ?WD_SUSPECT. We don't (yet) set -%% ?STATE_* as a consequence of a watchdog message since this requires -%% changing some of the matching on ?STATE_*. -%% -%% Death of a peer process process (#conn.pid, #peer.conn) results in -%% connection_down followed by watchdog ?WD_DOWN. The latter doesn't -%% result in the conn record being deleted since 'DOWN' from death of -%% its watchdog doesn't (yet) deal with the record having been -%% removed. +%% Death of a watchdog process (#watchdog.pid) results in the removal of +%% it's peer and any associated conn record when 'DOWN' is received. +%% Death of a peer process process (#peer.pid, #watchdog.peer) results in +%% ?WD_DOWN. %% Monitor process has died. Just die with a reason that tells %% diameter_config about the happening. If a cleaner shutdown is @@ -589,9 +466,9 @@ transition({'DOWN', MRef, process, _, Reason}, #state{monitor = MRef}) -> {stop, {monitor, Reason}}; %% Local watchdog process has died. -transition({'DOWN', _, process, Pid, Reason}, S) +transition({'DOWN', _, process, Pid, _Reason}, S) when node(Pid) == node() -> - peer_down(Pid, Reason, S), + watchdog_down(Pid, S), ok; %% Remote service wants to know about shared peers. @@ -614,20 +491,13 @@ transition({tc_timeout, T}, S) -> tc_timeout(T, S), ok; -%% Request process is telling us it may have missed a failover message -%% after a transport went down and the service process looked up -%% outstanding requests. -transition({failover, TRef, Seqs}, S) -> - failover(TRef, Seqs, S), - ok; - transition(Req, S) -> unexpected(handle_info, [Req], S), ok. -%%% --------------------------------------------------------------------------- -%%% # terminate(Reason, State) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # terminate/2 +%% --------------------------------------------------------------------------- terminate(Reason, #state{service_name = Name} = S) -> send_event(Name, stop), @@ -635,9 +505,9 @@ terminate(Reason, #state{service_name = Name} = S) -> shutdown == Reason %% application shutdown andalso shutdown(application, S). -%%% --------------------------------------------------------------------------- -%%% # code_change(FromVsn, State, Extra) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # code_change/3 +%% --------------------------------------------------------------------------- code_change(FromVsn, #state{service_name = SvcName, @@ -663,30 +533,20 @@ code_change(FromVsn, SvcName, Extra, #diameter_app{alias = Alias} = A) -> unexpected(F, A, #state{service_name = Name}) -> ?UNEXPECTED(F, A ++ [Name]). -cb([_|_] = M, F, A) -> - eval(M, F, A); -cb(Rec, F, A) -> - {_, M} = app(Rec), +cb(#diameter_app{module = [_|_] = M}, F, A) -> eval(M, F, A). -app(#request{app = A, module = M}) -> - {A,M}; -app(#diameter_app{alias = A, module = M}) -> - {A,M}. - eval([M|X], F, A) -> apply(M, F, A ++ X). %% Callback with state. -state_cb(#diameter_app{mutable = false, init_state = S}, {ModX, F, A}) -> +state_cb(#diameter_app{module = ModX, mutable = false, init_state = S}, + pick_peer = F, + A) -> eval(ModX, F, A ++ [S]); -state_cb(#diameter_app{mutable = true, alias = Alias}, {_,_,_} = MFA) -> - state_cb(MFA, Alias); - -state_cb({ModX,F,A}, Alias) - when is_list(ModX) -> +state_cb(#diameter_app{module = ModX, alias = Alias}, F, A) -> eval(ModX, F, A ++ [mod_state(Alias)]). choose(true, X, _) -> X; @@ -712,57 +572,38 @@ mod_state(Alias) -> mod_state(Alias, ModS) -> put({?MODULE, mod_state, Alias}, ModS). -%%% --------------------------------------------------------------------------- -%%% # shutdown/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # shutdown/2 +%% --------------------------------------------------------------------------- -%% remove_transport: ask watchdogs to terminate their transport. -shutdown(Refs, #state{peerT = PeerT}) +%% remove_transport +shutdown(Refs, #state{watchdogT = WatchdogT}) when is_list(Refs) -> - ets:foldl(fun(P,ok) -> sp(P, Refs), ok end, ok, PeerT); - -%% application/service shutdown: ask transports to terminate themselves. -shutdown(Reason, #state{peerT = PeerT}) -> - %% A transport might not be alive to receive the shutdown request - %% but give those that are a chance to shutdown gracefully. - shutdown(conn, Reason, PeerT), - %% Kill the watchdogs explicitly in case there was no transport. - shutdown(peer, Reason, PeerT). - -%% sp/2 - -sp(#peer{ref = Ref, pid = Pid}, Refs) -> - lists:member(Ref, Refs) - andalso (Pid ! {shutdown, self()}). %% 'DOWN' cleans up + ets:foldl(fun(P,ok) -> st(P, Refs), ok end, ok, WatchdogT); -%% shutdown/3 - -shutdown(Who, Reason, T) -> - diameter_lib:wait(ets:foldl(fun(X,A) -> shutdown(Who, X, Reason, A) end, +%% application/service shutdown +shutdown(Reason, #state{watchdogT = WatchdogT}) + when Reason == application; + Reason == service -> + diameter_lib:wait(ets:foldl(fun(P,A) -> st(P, Reason, A) end, [], - T)). + WatchdogT)). -shutdown(conn = Who, #peer{op_state = {OS,_}} = P, Reason, Acc) -> - shutdown(Who, P#peer{op_state = OS}, Reason, Acc); +%% st/2 -shutdown(conn, - #peer{pid = Pid, op_state = ?STATE_UP, conn = TPid}, - Reason, - Acc) -> - TPid ! {shutdown, Pid, Reason}, - [TPid | Acc]; +st(#watchdog{ref = Ref, pid = Pid}, Refs) -> + lists:member(Ref, Refs) + andalso (Pid ! {shutdown, self(), transport}). %% 'DOWN' cleans up -shutdown(peer, #peer{pid = Pid}, _Reason, Acc) - when is_pid(Pid) -> - exit(Pid, shutdown), - [Pid | Acc]; +%% st/3 -shutdown(_, #peer{}, _, Acc) -> - Acc. +st(#watchdog{pid = Pid}, Reason, Acc) -> + Pid ! {shutdown, self(), Reason}, + [Pid | Acc]. -%%% --------------------------------------------------------------------------- -%%% # call_service/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # call_service/2 +%% --------------------------------------------------------------------------- call_service(Pid, Req) when is_pid(Pid) -> @@ -785,11 +626,9 @@ cs(Pid, Req) cs(undefined, _) -> {error, no_service}. -%%% --------------------------------------------------------------------------- -%%% # i/1 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # i/1 +%% --------------------------------------------------------------------------- %% Intialize the state of a service gen_server. @@ -859,9 +698,9 @@ get_value(Key, Vs) -> {_, V} = lists:keyfind(Key, 1, Vs), V. -%%% --------------------------------------------------------------------------- -%%% # start/3 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # start/3 +%% --------------------------------------------------------------------------- %% If the initial start/3 at service/transport start succeeds then %% subsequent calls to start/4 on the same service will also succeed @@ -891,22 +730,28 @@ type(connect = T) -> T. %% start/4 -start(Ref, Type, Opts, #state{peerT = PeerT, - connT = ConnT, +start(Ref, Type, Opts, #state{watchdogT = WatchdogT, + peerT = PeerT, options = SvcOpts, service_name = SvcName, - service = Svc}) + service = Svc0}) when Type == connect; Type == accept -> - Pid = s(Type, Ref, {ConnT, + #diameter_service{applications = Apps} + = Svc + = merge_service(Opts, Svc0), + {_,_} = Mask = proplists:get_value(sequence, SvcOpts), + Pid = s(Type, Ref, {diameter_traffic:make_recvdata([SvcName, + PeerT, + Apps, + Mask]), Opts, - SvcName, SvcOpts, - merge_service(Opts, Svc)}), - insert(PeerT, #peer{pid = Pid, - type = Type, - ref = Ref, - options = Opts}), + Svc}), + insert(WatchdogT, #watchdog{pid = Pid, + type = Type, + ref = Ref, + options = Opts}), Pid. %% Note that the service record passed into the watchdog is the merged @@ -949,100 +794,115 @@ ms({capabilities, Opts}, #diameter_service{capabilities = Caps0} = Svc) ms(_, Svc) -> Svc. -%%% --------------------------------------------------------------------------- -%%% # accepted/3 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # accepted/3 +%% --------------------------------------------------------------------------- -accepted(Pid, _TPid, #state{peerT = PeerT} = S) -> - #peer{ref = Ref, type = accept = T, conn = false, options = Opts} - = P - = fetch(PeerT, Pid), - insert(PeerT, P#peer{conn = true}), %% mark replacement as started - start(Ref, T, Opts, S). %% start new watchdog +accepted(Pid, _TPid, #state{watchdogT = WatchdogT} = S) -> + #watchdog{ref = Ref, type = accept = T, peer = false, options = Opts} + = Wd + = fetch(WatchdogT, Pid), + insert(WatchdogT, Wd#watchdog{peer = true}),%% mark replacement as started + start(Ref, T, Opts, S). %% start new watchdog fetch(Tid, Key) -> [T] = ets:lookup(Tid, Key), - case T of - #peer{op_state = ?STATE_UP} = P -> - P#peer{op_state = {?STATE_UP, ?WD_OKAY}}; - #peer{op_state = ?STATE_DOWN} = P -> - P#peer{op_state = {?STATE_DOWN, ?WD_DOWN}}; - _ -> - T - end. + T. -%%% --------------------------------------------------------------------------- -%%% # connection_up/3 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # watchdog/6 +%% +%% React to a watchdog state transition. +%% --------------------------------------------------------------------------- -%% Watchdog process has reached state OKAY. +%% Watchdog has a new open connection. +watchdog(TPid, [T], _, ?WD_OKAY, Wd, State) -> + connection_up({TPid, T}, Wd, State); -connection_up(Pid, {TPid, {Caps, SApps, Pkt}}, #state{peerT = PeerT, - connT = ConnT} - = S) -> - P = fetch(PeerT, Pid), - C = #conn{pid = TPid, - apps = SApps, - caps = Caps, - peer = Pid}, - - insert(ConnT, C), - connection_up([Pkt], P#peer{conn = TPid}, C, S). - -%%% --------------------------------------------------------------------------- -%%% # reopen/3 -%%% --------------------------------------------------------------------------- - -%% Note that this connection_up/3 rewrites the same #conn{} now -%% written here. Both do so in case reopen has not happened in old -%% code. - -reopen(Pid, {TPid, {Caps, SApps, _Pkt}}, #state{peerT = PeerT, - connT = ConnT}) -> - P = fetch(PeerT, Pid), - C = #conn{pid = TPid, - apps = SApps, - caps = Caps, - peer = Pid}, - - insert(ConnT, C), - #peer{op_state = {?STATE_DOWN, _}} - = P, - insert(PeerT, P#peer{op_state = {?STATE_DOWN, ?WD_REOPEN}, - conn = TPid}). - -%%% --------------------------------------------------------------------------- -%%% # connection_up/2 -%%% --------------------------------------------------------------------------- - -%% Peer process has transitioned back into the open state. Note that there -%% has been no new capabilties exchange in this case. - -connection_up(Pid, #state{peerT = PeerT, - connT = ConnT} - = S) -> - #peer{conn = TPid} = P = fetch(PeerT, Pid), - C = fetch(ConnT, TPid), - connection_up([], P, C, S). +%% Watchdog has a new connection that will be opened after DW[RA] +%% exchange. +watchdog(TPid, [T], _, ?WD_REOPEN, Wd, State) -> + reopen({TPid, T}, Wd, State); + +%% Watchdog has recovered a suspect connection. +watchdog(TPid, [], ?WD_SUSPECT, ?WD_OKAY, Wd, State) -> + #watchdog{peer = TPid} = Wd, %% assert + connection_up(Wd, State); + +%% Watchdog has an unresponsive connection. +watchdog(TPid, [], ?WD_OKAY, ?WD_SUSPECT = To, Wd, State) -> + #watchdog{peer = TPid} = Wd, %% assert + connection_down(Wd, To, State); + +%% Watchdog has lost its connection. +watchdog(TPid, [], _, ?WD_DOWN = To, Wd, #state{peerT = PeerT} = S) -> + close(Wd, S), + connection_down(Wd, To, S), + ets:delete(PeerT, TPid); + +watchdog(_, [], _, _, _, _) -> + ok. -%% connection_up/4 +%% --------------------------------------------------------------------------- +%% # connection_up/3 +%% --------------------------------------------------------------------------- -connection_up(T, P, C, #state{peerT = PeerT, - local_peers = LDict, - service_name = SvcName, - service - = #diameter_service{applications = Apps}} - = S) -> - #peer{conn = TPid, op_state = {?STATE_DOWN, _}} - = P, - #conn{apps = SApps, caps = Caps} - = C, +%% Watchdog process has reached state OKAY. + +connection_up({TPid, {Caps, SupportedApps, Pkt}}, + #watchdog{pid = Pid} + = Wd, + #state{peerT = PeerT} + = S) -> + Pr = #peer{pid = TPid, + apps = SupportedApps, + caps = Caps, + watchdog = Pid}, + insert(PeerT, Pr), + connection_up([Pkt], Wd#watchdog{peer = TPid}, Pr, S). + +%% --------------------------------------------------------------------------- +%% # reopen/3 +%% --------------------------------------------------------------------------- + +reopen({TPid, {Caps, SupportedApps, _Pkt}}, + #watchdog{pid = Pid} + = Wd, + #state{watchdogT = WatchdogT, + peerT = PeerT}) -> + insert(PeerT, #peer{pid = TPid, + apps = SupportedApps, + caps = Caps, + watchdog = Pid}), + insert(WatchdogT, Wd#watchdog{state = ?WD_REOPEN, + peer = TPid}). + +%% --------------------------------------------------------------------------- +%% # connection_up/2 +%% --------------------------------------------------------------------------- + +%% Watchdog has recovered as suspect connection. Note that there has +%% been no new capabilties exchange in this case. + +connection_up(#watchdog{peer = TPid} = Wd, #state{peerT = PeerT} = S) -> + connection_up([], Wd, fetch(PeerT, TPid), S). - insert(PeerT, P#peer{op_state = {?STATE_UP, ?WD_OKAY}}), +%% connection_up/4 - request_peer_up(TPid), +connection_up(Extra, + #watchdog{peer = TPid} + = Wd, + #peer{apps = SApps, caps = Caps} + = Pr, + #state{watchdogT = WatchdogT, + local_peers = LDict, + service_name = SvcName, + service = #diameter_service{applications = Apps}} + = S) -> + insert(WatchdogT, Wd#watchdog{state = ?WD_OKAY}), + diameter_traffic:peer_up(TPid), insert_local_peer(SApps, {{TPid, Caps}, {SvcName, Apps}}, LDict), - report_status(up, P, C, S, T). + report_status(up, Wd, Pr, S, Extra). insert_local_peer(SApps, T, LDict) -> lists:foldl(fun(A,D) -> ilp(A, T, D) end, LDict, SApps). @@ -1052,13 +912,57 @@ ilp({Id, Alias}, {TC, SA}, LDict) -> ?Dict:append(Alias, TC, LDict). init_conn(Id, Alias, {TPid, _} = TC, {SvcName, Apps}) -> - #diameter_app{module = ModX, - id = Id} %% assert + #diameter_app{id = Id} %% assert + = App = find_app(Alias, Apps), - peer_cb({ModX, peer_up, [SvcName, TC]}, Alias) + peer_cb(App, peer_up, [SvcName, TC]) orelse exit(TPid, kill). %% fake transport failure +%% --------------------------------------------------------------------------- +%% # find_incoming_app/3 +%% --------------------------------------------------------------------------- + +%% No one should be sending the relay identifier. +find_incoming_app(#peer{caps = Caps}, ?APP_ID_RELAY, _) -> + Caps; + +find_incoming_app(Peer, Id, Apps) + when is_integer(Id) -> + find_incoming_app(Peer, [Id, ?APP_ID_RELAY], Apps); + +%% Note that the apps represented in SApps may be a strict subset of +%% those in Apps. +find_incoming_app(#peer{apps = SApps, caps = Caps}, Ids, Apps) -> + case keyfind(Ids, 1, SApps) of + {_Id, Alias} -> + {#diameter_app{} = find_app(Alias, Apps), Caps}; + false -> + Caps + end. + +%% keyfind/3 + +keyfind([], _, _) -> + false; +keyfind([Key | Rest], Pos, L) -> + case lists:keyfind(Key, Pos, L) of + false -> + keyfind(Rest, Pos, L); + T -> + T + end. + +%% find_outgoing_app/2 + +find_outgoing_app(Alias, Apps) -> + case find_app(Alias, Apps) of + #diameter_app{id = ?APP_ID_RELAY} -> + false; + A -> + A + end. + %% find_app/2 find_app(Alias, Apps) -> @@ -1066,53 +970,51 @@ find_app(Alias, Apps) -> %% Don't bring down the service (and all associated connections) %% regardless of what happens. -peer_cb(MFA, Alias) -> - try state_cb(MFA, Alias) of +peer_cb(App, F, A) -> + try state_cb(App, F, A) of ModS -> - mod_state(Alias, ModS), + mod_state(App#diameter_app.alias, ModS), true catch E:R -> - diameter_lib:error_report({failure, {E, R, Alias, ?STACK}}, MFA), + diameter_lib:error_report({failure, {E, R, ?STACK}}, + {App, F, A}), false end. -%%% --------------------------------------------------------------------------- -%%% # connection_down/2 -%%% --------------------------------------------------------------------------- - -%% Watchdog has transitioned out of state OKAY. - -connection_down(Pid, #state{peerT = PeerT, - connT = ConnT} - = S) -> - #peer{op_state = {?STATE_UP, WS}, %% assert - conn = TPid} - = P - = fetch(PeerT, Pid), +%% --------------------------------------------------------------------------- +%% # connection_down/3 +%% --------------------------------------------------------------------------- - C = fetch(ConnT, TPid), - insert(PeerT, P#peer{op_state = {?STATE_DOWN, WS}}), - connection_down(P,C,S). - -%% connection_down/3 - -connection_down(#peer{op_state = {?STATE_DOWN, _}}, _, _) -> - ok; - -connection_down(#peer{conn = TPid, - op_state = {?STATE_UP, _}} - = P, - #conn{caps = Caps, +connection_down(#watchdog{state = ?WD_OKAY, + peer = TPid} + = Wd, + #peer{caps = Caps, apps = SApps} - = C, + = Pr, #state{service_name = SvcName, service = #diameter_service{applications = Apps}, local_peers = LDict} = S) -> - report_status(down, P, C, S, []), + report_status(down, Wd, Pr, S, []), remove_local_peer(SApps, {{TPid, Caps}, {SvcName, Apps}}, LDict), - request_peer_down(TPid, S). + diameter_traffic:peer_down(TPid); + +connection_down(#watchdog{}, #peer{}, _) -> + ok; + +connection_down(#watchdog{state = WS, + peer = TPid} + = Wd, + To, + #state{watchdogT = WatchdogT, + peerT = PeerT} + = S) + when is_atom(To) -> + insert(WatchdogT, Wd#watchdog{state = To}), + ?WD_OKAY == WS + andalso + connection_down(Wd, fetch(PeerT, TPid), S). remove_local_peer(SApps, T, LDict) -> lists:foldl(fun(A,D) -> rlp(A, T, D) end, LDict, SApps). @@ -1123,71 +1025,58 @@ rlp({Id, Alias}, {TC, SA}, LDict) -> ?Dict:store(Alias, lists:delete(TC, L), LDict). down_conn(Id, Alias, TC, {SvcName, Apps}) -> - #diameter_app{module = ModX, - id = Id} %% assert + #diameter_app{id = Id} %% assert + = App = find_app(Alias, Apps), - peer_cb({ModX, peer_down, [SvcName, TC]}, Alias). + peer_cb(App, peer_down, [SvcName, TC]). -%%% --------------------------------------------------------------------------- -%%% # peer_down/3 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # watchdog_down/2 +%% --------------------------------------------------------------------------- %% Watchdog process has died. -peer_down(Pid, Reason, #state{peerT = PeerT} = S) -> - P = fetch(PeerT, Pid), - ets:delete_object(PeerT, P), - closed(Reason, P, S), - restart(P,S), - peer_down(P,S). - -%% Send an event at connection establishment failure. -closed({shutdown, {close, _TPid, Reason}}, - #peer{op_state = {?STATE_DOWN, _}, - ref = Ref, - type = Type, - options = Opts}, - #state{service_name = SvcName}) -> - send_event(SvcName, {closed, Ref, Reason, {type(Type), Opts}}); -closed(_, _, _) -> - ok. +watchdog_down(Pid, #state{watchdogT = WatchdogT} = S) -> + Wd = fetch(WatchdogT, Pid), + ets:delete_object(WatchdogT, Wd), + restart(Wd,S), + wd_down(Wd,S). -%% The watchdog has never reached OKAY ... -peer_down(#peer{conn = B}, _) +%% Watchdog has never reached OKAY ... +wd_down(#watchdog{peer = B}, _) when is_boolean(B) -> ok; %% ... or maybe it has. -peer_down(#peer{conn = TPid} = P, #state{connT = ConnT} = S) -> - #conn{} = C = fetch(ConnT, TPid), - ets:delete_object(ConnT, C), - connection_down(P,C,S). +wd_down(#watchdog{peer = TPid} = Wd, #state{peerT = PeerT} = S) -> + connection_down(Wd, ?WD_DOWN, S), + ets:delete(PeerT, TPid). %% restart/2 -restart(P,S) -> - q_restart(restart(P), S). +restart(Wd, S) -> + q_restart(restart(Wd), S). %% restart/1 %% Always try to reconnect. -restart(#peer{ref = Ref, - type = connect = T, - options = Opts, - started = Time}) -> +restart(#watchdog{ref = Ref, + type = connect = T, + options = Opts, + started = Time}) -> {Time, {Ref, T, Opts}}; %% Transport connection hasn't yet been accepted ... -restart(#peer{ref = Ref, - type = accept = T, - options = Opts, - conn = false, - started = Time}) -> +restart(#watchdog{ref = Ref, + type = accept = T, + options = Opts, + peer = false, + started = Time}) -> {Time, {Ref, T, Opts}}; %% ... or it has: a replacement has already been spawned. -restart(#peer{type = accept}) -> +restart(#watchdog{type = accept}) -> false. %% q_restart/2 @@ -1237,9 +1126,9 @@ tc(true, {Ref, Type, Opts}, #state{service_name = SvcName} tc(false = No, _, _) -> %% removed No. -%%% --------------------------------------------------------------------------- -%%% # close/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # close/2 +%% --------------------------------------------------------------------------- %% The watchdog doesn't start a new fsm in the accept case, it %% simply stays alive until someone tells it to die in order for @@ -1248,14 +1137,13 @@ tc(false = No, _, _) -> %% removed %% the accepting watchdog upon reception of a CER from the previously %% connected peer, or us after reconnect_timer timeout. -close(Pid, #state{service_name = SvcName, - peerT = PeerT}) -> - #peer{pid = Pid, - type = accept, - ref = Ref, - options = Opts} - = fetch(PeerT, Pid), - +close(#watchdog{type = connect}, _) -> + ok; +close(#watchdog{type = accept, + pid = Pid, + ref = Ref, + options = Opts}, + #state{service_name = SvcName}) -> c(Pid, diameter_config:have_transport(SvcName, Ref), Opts). %% Tell watchdog to (maybe) die later ... @@ -1273,21 +1161,21 @@ c(Pid, false, _Opts) -> %% which a new connection attempt is expected of a connecting peer. %% The value should be greater than the peer's Tc + jitter. -%%% --------------------------------------------------------------------------- -%%% # reconnect/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # reconnect/2 +%% --------------------------------------------------------------------------- reconnect(Pid, #state{service_name = SvcName, - peerT = PeerT}) -> - #peer{ref = Ref, - type = connect, - options = Opts} - = fetch(PeerT, Pid), + watchdogT = WatchdogT}) -> + #watchdog{ref = Ref, + type = connect, + options = Opts} + = fetch(WatchdogT, Pid), send_event(SvcName, {reconnect, Ref, Opts}). -%%% --------------------------------------------------------------------------- -%%% # call_module/4 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # call_module/4 +%% --------------------------------------------------------------------------- %% Backwards compatibility and never documented/advertised. May be %% removed. @@ -1309,10 +1197,10 @@ call_module(Mod, Req, From, #state{service {reply, {error, Reason}, S} end. -cm([#diameter_app{module = ModX, alias = Alias}], Req, From, Svc) -> - MFA = {ModX, handle_call, [Req, From, Svc]}, +cm([#diameter_app{alias = Alias} = App], Req, From, Svc) -> + Args = [Req, From, Svc], - try state_cb(MFA, Alias) of + try state_cb(App, handle_call, Args) of {noreply = T, ModS} -> mod_state(Alias, ModS), T; @@ -1320,11 +1208,13 @@ cm([#diameter_app{module = ModX, alias = Alias}], Req, From, Svc) -> mod_state(Alias, ModS), {T, RC}; T -> - diameter_lib:error_report({invalid, T}, MFA), + diameter_lib:error_report({invalid, T}, + {App, handle_call, Args}), invalid catch E: Reason -> - diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA), + diameter_lib:error_report({failure, {E, Reason, ?STACK}}, + {App, handle_call, Args}), failure end; @@ -1334,1270 +1224,16 @@ cm([], _, _, _) -> cm([_,_|_], _, _, _) -> multiple. -%%% --------------------------------------------------------------------------- -%%% # send_request/6 -%%% --------------------------------------------------------------------------- - -%% Send an outgoing request in its dedicated process. -%% -%% Note that both encode of the outgoing request and of the received -%% answer happens in this process. It's also this process that replies -%% to the caller. The service process only handles the state-retaining -%% callbacks. -%% -%% The mod field of the #diameter_app{} here includes any extra -%% arguments passed to diameter:call/2. - -send_request({TPid, Caps, App} = T, Mask, Msg, Opts, Caller, SvcName) -> - #diameter_app{module = ModX} - = App, - - Pkt = make_prepare_packet(Mask, Msg), - - send_req(cb(ModX, prepare_request, [Pkt, SvcName, {TPid, Caps}]), - Pkt, - T, - Opts, - Caller, - SvcName, - []). - -send_req({send, P}, Pkt, T, Opts, Caller, SvcName, Fs) -> - send_req(make_request_packet(P, Pkt), T, Opts, Caller, SvcName, Fs); - -send_req({discard, Reason} , _, _, _, _, _, _) -> - {error, Reason}; - -send_req(discard, _, _, _, _, _, _) -> - {error, discarded}; - -send_req({eval_packet, RC, F}, Pkt, T, Opts, Caller, SvcName, Fs) -> - send_req(RC, Pkt, T, Opts, Caller, SvcName, [F|Fs]); - -send_req(E, _, {_, _, App}, _, _, _, _) -> - ?ERROR({invalid_return, prepare_request, App, E}). - -%% make_prepare_packet/2 -%% -%% Turn an outgoing request as passed to call/4 into a diameter_packet -%% record in preparation for a prepare_request callback. - -make_prepare_packet(_, Bin) - when is_binary(Bin) -> - #diameter_packet{header = diameter_codec:decode_header(Bin), - bin = Bin}; - -make_prepare_packet(Mask, #diameter_packet{msg = [#diameter_header{} = Hdr - | Avps]} - = Pkt) -> - Pkt#diameter_packet{msg = [make_prepare_header(Mask, Hdr) | Avps]}; - -make_prepare_packet(Mask, #diameter_packet{header = Hdr} = Pkt) -> - Pkt#diameter_packet{header = make_prepare_header(Mask, Hdr)}; - -make_prepare_packet(Mask, Msg) -> - make_prepare_packet(Mask, #diameter_packet{msg = Msg}). - -%% make_prepare_header/2 - -make_prepare_header(Mask, undefined) -> - Seq = diameter_session:sequence(Mask), - make_prepare_header(#diameter_header{end_to_end_id = Seq, - hop_by_hop_id = Seq}); - -make_prepare_header(Mask, #diameter_header{end_to_end_id = undefined, - hop_by_hop_id = undefined} - = H) -> - Seq = diameter_session:sequence(Mask), - make_prepare_header(H#diameter_header{end_to_end_id = Seq, - hop_by_hop_id = Seq}); - -make_prepare_header(Mask, #diameter_header{end_to_end_id = undefined} = H) -> - Seq = diameter_session:sequence(Mask), - make_prepare_header(H#diameter_header{end_to_end_id = Seq}); - -make_prepare_header(Mask, #diameter_header{hop_by_hop_id = undefined} = H) -> - Seq = diameter_session:sequence(Mask), - make_prepare_header(H#diameter_header{hop_by_hop_id = Seq}); - -make_prepare_header(_, Hdr) -> - make_prepare_header(Hdr). - -%% make_prepare_header/1 - -make_prepare_header(#diameter_header{version = undefined} = Hdr) -> - make_prepare_header(Hdr#diameter_header{version = ?DIAMETER_VERSION}); - -make_prepare_header(#diameter_header{} = Hdr) -> - Hdr; - -make_prepare_header(T) -> - ?ERROR({invalid_header, T}). - -%% make_request_packet/2 -%% -%% Reconstruct a diameter_packet from the return value of -%% prepare_request or prepare_retransmit callback. - -make_request_packet(Bin, _) - when is_binary(Bin) -> - make_prepare_packet(false, Bin); - -make_request_packet(#diameter_packet{msg = [#diameter_header{} | _]} - = Pkt, - _) -> - Pkt; - -%% Returning a diameter_packet with no header from a prepare_request -%% or prepare_retransmit callback retains the header passed into it. -%% This is primarily so that the end to end and hop by hop identifiers -%% are retained. -make_request_packet(#diameter_packet{header = Hdr} = Pkt, - #diameter_packet{header = Hdr0}) -> - Pkt#diameter_packet{header = fold_record(Hdr0, Hdr)}; - -make_request_packet(Msg, Pkt) -> - Pkt#diameter_packet{msg = Msg}. - -%% fold_record/2 - -fold_record(undefined, R) -> - R; -fold_record(Rec, R) -> - diameter_lib:fold_tuple(2, Rec, R). - -%% send_req/6 - -send_req(Pkt, {TPid, Caps, App}, Opts, Caller, SvcName, Fs) -> - #diameter_app{alias = Alias, - dictionary = Dict, - module = ModX, - options = [{answer_errors, AE} | _]} - = App, - - EPkt = encode(Dict, Pkt, Fs), - - #options{filter = Filter, - timeout = Timeout} - = Opts, - - Req = #request{packet = Pkt, - from = Caller, - handler = self(), - transport = TPid, - caps = Caps, - app = Alias, - filter = Filter, - dictionary = Dict, - module = ModX}, - - try - TRef = send_request(TPid, EPkt, Req, Timeout), - ack(Caller), - handle_answer(SvcName, AE, recv_answer(Timeout, SvcName, {TRef, Req})) - after - erase_request(EPkt) - end. - -%% Tell caller a send has been attempted. -ack({Pid, Ref}) -> - Pid ! Ref. - -%% recv_answer/3 - -recv_answer(Timeout, - SvcName, - {TRef, #request{from = {_, Ref}, packet = RPkt} = Req} - = T) -> - - %% Matching on TRef below ensures we ignore messages that pertain - %% to a previous transport prior to failover. The answer message - %% includes the #request{} since it's not necessarily Req; that - %% is, from the last peer to which we've transmitted. - - receive - {answer = A, Ref, Rq, Pkt} -> %% Answer from peer - {A, Rq, Pkt}; - {timeout = Reason, TRef, _} -> %% No timely reply - {error, Req, Reason}; - {failover = Reason, TRef, false} -> %% No alternate peer - {error, Req, Reason}; - {failover, TRef, Transport} -> %% Resend to alternate peer - try_retransmit(Timeout, SvcName, Req, Transport); - {failover, TRef} -> %% May have missed failover notification - Seqs = diameter_codec:sequence_numbers(RPkt), - Pid = whois(SvcName), - is_pid(Pid) andalso (Pid ! {failover, TRef, Seqs}), - recv_answer(Timeout, SvcName, T) - end. -%% Note that failover starts a new timer and that expiry of an old -%% timer value is ignored. This means that an answer could be accepted -%% from a peer after timeout in the case of failover. - -try_retransmit(Timeout, SvcName, Req, Transport) -> - try retransmit(Transport, Req, SvcName, Timeout) of - T -> recv_answer(Timeout, SvcName, T) - catch - ?FAILURE(Reason) -> {error, Req, Reason} - end. - -%% handle_error/3 - -handle_error(Req, Reason, SvcName) -> - #request{module = ModX, - packet = Pkt, - transport = TPid, - caps = Caps} - = Req, - cb(ModX, handle_error, [Reason, msg(Pkt), SvcName, {TPid, Caps}]). - -msg(#diameter_packet{msg = undefined, bin = Bin}) -> - Bin; -msg(#diameter_packet{msg = Msg}) -> - Msg. - -%% encode/3 - -encode(Dict, Pkt, Fs) -> - P = encode(Dict, Pkt), - eval_packet(P, Fs), - P. - -%% encode/2 - -%% Note that prepare_request can return a diameter_packet containing -%% header or transport_data. Even allow the returned record to contain -%% an encoded binary. This isn't the usual case but could some in -%% handy, for test at least. (For example, to send garbage.) - -%% The normal case: encode the returned message. -encode(Dict, #diameter_packet{msg = Msg, bin = undefined} = Pkt) -> - D = pick_dictionary([Dict, ?BASE], Msg), - diameter_codec:encode(D, Pkt); - -%% Callback has returned an encoded binary: just send. -encode(_, #diameter_packet{} = Pkt) -> - Pkt. - -%% pick_dictionary/2 - -%% Pick the first dictionary that declares the application id in the -%% specified header. -pick_dictionary(Ds, [#diameter_header{application_id = Id} | _]) -> - pd(Ds, fun(D) -> Id = D:id() end); - -%% Pick the first dictionary that knows the specified message name. -pick_dictionary(Ds, [MsgName|_]) -> - pd(Ds, fun(D) -> D:msg2rec(MsgName) end); - -%% Pick the first dictionary that knows the name of the specified -%% message record. -pick_dictionary(Ds, Rec) -> - Name = element(1, Rec), - pd(Ds, fun(D) -> D:rec2msg(Name) end). - -pd([D|Ds], F) -> - try - F(D), - D - catch - error:_ -> - pd(Ds, F) - end; - -pd([], _) -> - ?ERROR(no_dictionary). - -%% send_request/4 - -send_request(TPid, #diameter_packet{bin = Bin} = Pkt, Req, Timeout) - when node() == node(TPid) -> - %% Store the outgoing request before sending to avoid a race with - %% reply reception. - TRef = store_request(TPid, Bin, Req, Timeout), - send(TPid, Pkt), - TRef; - -%% Send using a remote transport: spawn a process on the remote node -%% to relay the answer. -send_request(TPid, #diameter_packet{} = Pkt, Req, Timeout) -> - TRef = erlang:start_timer(Timeout, self(), timeout), - T = {TPid, Pkt, Req, Timeout, TRef}, - spawn(node(TPid), ?MODULE, send, [T]), - TRef. - -%% send/1 - -send({TPid, Pkt, #request{handler = Pid} = Req, Timeout, TRef}) -> - Ref = send_request(TPid, Pkt, Req#request{handler = self()}, Timeout), - Pid ! reref(receive T -> T end, Ref, TRef). - -reref({T, Ref, R}, Ref, TRef) -> - {T, TRef, R}; -reref(T, _, _) -> - T. - -%% send/2 - -send(Pid, Pkt) -> - Pid ! {send, Pkt}. - -%% retransmit/4 - -retransmit({TPid, Caps, #diameter_app{alias = Alias} = App} = T, - #request{app = Alias, packet = Pkt0} - = Req, - SvcName, - Timeout) -> - have_request(Pkt0, TPid) %% Don't failover to a peer we've - andalso ?THROW(timeout), %% already sent to. - - #diameter_packet{header = Hdr0} = Pkt0, - Hdr = Hdr0#diameter_header{is_retransmitted = true}, - Pkt = Pkt0#diameter_packet{header = Hdr}, - - resend_req(cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]), - T, - Req#request{packet = Pkt}, - Timeout, - []). - -resend_req({send, P}, T, #request{packet = Pkt} = Req, Timeout, Fs) -> - retransmit(make_request_packet(P, Pkt), T, Req, Timeout, Fs); - -resend_req({discard, Reason}, _, _, _, _) -> - ?THROW(Reason); - -resend_req(discard, _, _, _, _) -> - ?THROW(discarded); - -resend_req({eval_packet, RC, F}, T, Req, Timeout, Fs) -> - resend_req(RC, T, Req, Timeout, [F|Fs]); - -resend_req(T, {_, _, App}, _, _, _) -> - ?ERROR({invalid_return, prepare_retransmit, App, T}). - -%% retransmit/6 - -retransmit(Pkt, {TPid, Caps, _}, #request{dictionary = D} = Req0, Tmo, Fs) -> - EPkt = encode(D, Pkt, Fs), - - Req = Req0#request{transport = TPid, - packet = Pkt, - caps = Caps}, - - ?LOG(retransmission, Req), - TRef = send_request(TPid, EPkt, Req, Tmo), - {TRef, Req}. - -%% store_request/4 - -store_request(TPid, Bin, Req, Timeout) -> - Seqs = diameter_codec:sequence_numbers(Bin), - TRef = erlang:start_timer(Timeout, self(), timeout), - ets:insert(?REQUEST_TABLE, {Seqs, Req, TRef}), - ets:member(?REQUEST_TABLE, TPid) - orelse (self() ! {failover, TRef}), %% possibly missed failover - TRef. - -%% lookup_request/2 - -lookup_request(Msg, TPid) - when is_pid(TPid) -> - lookup(Msg, TPid, '_'); - -lookup_request(Msg, TRef) - when is_reference(TRef) -> - lookup(Msg, '_', TRef). - -lookup(Msg, TPid, TRef) -> - Seqs = diameter_codec:sequence_numbers(Msg), - Spec = [{{Seqs, #request{transport = TPid, _ = '_'}, TRef}, - [], - ['$_']}], - case ets:select(?REQUEST_TABLE, Spec) of - [{_, Req, _}] -> - Req; - [] -> - false - end. - -%% erase_request/1 - -erase_request(Pkt) -> - ets:delete(?REQUEST_TABLE, diameter_codec:sequence_numbers(Pkt)). - -%% match_requests/1 - -match_requests(TPid) -> - Pat = {'_', #request{transport = TPid, _ = '_'}, '_'}, - ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}]). - -%% have_request/2 - -have_request(Pkt, TPid) -> - Seqs = diameter_codec:sequence_numbers(Pkt), - Pat = {Seqs, #request{transport = TPid, _ = '_'}, '_'}, - '$end_of_table' /= ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}], 1). - -%% request_peer_up/1 - -request_peer_up(TPid) -> - ets:insert(?REQUEST_TABLE, {TPid}). - -%% request_peer_down/2 - -request_peer_down(TPid, S) -> - ets:delete(?REQUEST_TABLE, TPid), - lists:foreach(fun(T) -> failover(T,S) end, match_requests(TPid)). -%% Note that a request process can store its request after failover -%% notifications are sent here: store_request/4 sends the notification -%% in that case. Note also that we'll send as many notifications to a -%% given handler as there are peers its sent to. All but one of these -%% will be ignored. - -%%% --------------------------------------------------------------------------- -%%% recv_request/3 -%%% --------------------------------------------------------------------------- - -recv_request(TPid, Pkt, {ConnT, SvcName, Apps, Mask}) -> - try ets:lookup(ConnT, TPid) of - [C] -> - recv_request(C, TPid, Pkt, SvcName, Apps, Mask); - [] -> %% transport has gone down - ok - catch - error: badarg -> %% service has gone down (and taken table with it) - ok - end. - -%% recv_request/5 - -recv_request(#conn{apps = SApps, caps = Caps}, - TPid, - Pkt, - SvcName, - Apps, - Mask) -> - #diameter_caps{origin_host = {OH,_}, - origin_realm = {OR,_}} - = Caps, - - #diameter_packet{header = #diameter_header{application_id = Id}} - = Pkt, - - recv_request(find_recv_app(Id, SApps), - {SvcName, OH, OR}, - TPid, - Apps, - Mask, - Caps, - Pkt). - -%% find_recv_app/2 - -%% No one should be sending the relay identifier. -find_recv_app(?APP_ID_RELAY, _) -> - false; - -%% With any other id we either support it locally or as a relay. -find_recv_app(Id, SApps) -> - keyfind([Id, ?APP_ID_RELAY], 1, SApps). - -%% keyfind/3 - -keyfind([], _, _) -> - false; -keyfind([Key | Rest], Pos, L) -> - case lists:keyfind(Key, Pos, L) of - false -> - keyfind(Rest, Pos, L); - T -> - T - end. - -%% recv_request/7 - -recv_request({Id, Alias}, T, TPid, Apps, Mask, Caps, Pkt) -> - #diameter_app{dictionary = Dict} - = A - = find_app(Alias, Apps), - recv_request(T, - {TPid, Caps}, - A, - Mask, - diameter_codec:decode(Id, Dict, Pkt)); -%% Note that the decode is different depending on whether or not Id is -%% ?APP_ID_RELAY. - -%% DIAMETER_APPLICATION_UNSUPPORTED 3007 -%% A request was sent for an application that is not supported. - -recv_request(false, T, TPid, _, _, _, Pkt) -> - As = collect_avps(Pkt), - protocol_error(3007, T, TPid, Pkt#diameter_packet{avps = As}). - -collect_avps(Pkt) -> - case diameter_codec:collect_avps(Pkt) of - {_Bs, As} -> - As; - As -> - As - end. - -%% recv_request/5 - -%% Wrong number of bits somewhere in the message: reply. -%% -%% DIAMETER_INVALID_AVP_BITS 3009 -%% A request was received that included an AVP whose flag bits are -%% set to an unrecognized value, or that is inconsistent with the -%% AVP's definition. -%% -recv_request(T, {TPid, _}, _, _, #diameter_packet{errors = [Bs | _]} = Pkt) - when is_bitstring(Bs) -> - protocol_error(3009, T, TPid, Pkt); - -%% Either we support this application but don't recognize the command -%% or we're a relay and the command isn't proxiable. -%% -%% DIAMETER_COMMAND_UNSUPPORTED 3001 -%% The Request contained a Command-Code that the receiver did not -%% recognize or support. This MUST be used when a Diameter node -%% receives an experimental command that it does not understand. -%% -recv_request(T, - {TPid, _}, - #diameter_app{id = Id}, - _, - #diameter_packet{header = #diameter_header{is_proxiable = P}, - msg = M} - = Pkt) - when ?APP_ID_RELAY /= Id, undefined == M; - ?APP_ID_RELAY == Id, not P -> - protocol_error(3001, T, TPid, Pkt); - -%% Error bit was set on a request. -%% -%% DIAMETER_INVALID_HDR_BITS 3008 -%% A request was received whose bits in the Diameter header were -%% either set to an invalid combination, or to a value that is -%% inconsistent with the command code's definition. -%% -recv_request(T, - {TPid, _}, - _, - _, - #diameter_packet{header = #diameter_header{is_error = true}} - = Pkt) -> - protocol_error(3008, T, TPid, Pkt); - -%% A message in a locally supported application or a proxiable message -%% in the relay application. Don't distinguish between the two since -%% each application has its own callback config. That is, the user can -%% easily distinguish between the two cases. -recv_request(T, TC, App, Mask, Pkt) -> - request_cb(T, TC, App, Mask, examine(Pkt)). - -%% Note that there may still be errors but these aren't protocol -%% (3xxx) errors that lead to an answer-message. - -request_cb({SvcName, _OH, _OR} = T, TC, App, Mask, Pkt) -> - request_cb(cb(App, handle_request, [Pkt, SvcName, TC]), - App, - Mask, - T, - TC, - [], - Pkt). - -%% examine/1 -%% -%% Look for errors in a decoded message. Length errors result in -%% decode failure in diameter_codec. - -examine(#diameter_packet{header = #diameter_header{version - = ?DIAMETER_VERSION}} - = Pkt) -> - Pkt; - -%% DIAMETER_UNSUPPORTED_VERSION 5011 -%% This error is returned when a request was received, whose version -%% number is unsupported. - -examine(#diameter_packet{errors = Es} = Pkt) -> - Pkt#diameter_packet{errors = [5011 | Es]}. -%% It's odd/unfortunate that this isn't a protocol error. - -%% request_cb/7 - -%% A reply may be an answer-message, constructed either here or by -%% the handle_request callback. The header from the incoming request -%% is passed into the encode so that it can retrieve the relevant -%% command code in this case. It will also then ignore Dict and use -%% the base encoder. -request_cb({reply, Ans}, - #diameter_app{dictionary = Dict}, - _, - _, - {TPid, _}, - Fs, - Pkt) -> - reply(Ans, Dict, TPid, Fs, Pkt); - -%% An 3xxx result code, for which the E-bit is set in the header. -request_cb({protocol_error, RC}, _, _, T, {TPid, _}, Fs, Pkt) - when 3000 =< RC, RC < 4000 -> - protocol_error(RC, T, TPid, Fs, Pkt); - -%% RFC 3588 says we must reply 3001 to anything unrecognized or -%% unsupported. 'noreply' is undocumented (and inappropriately named) -%% backwards compatibility for this, protocol_error the documented -%% alternative. -request_cb(noreply, _, _, T, {TPid, _}, Fs, Pkt) -> - protocol_error(3001, T, TPid, Fs, Pkt); - -%% Relay a request to another peer. This is equivalent to doing an -%% explicit call/4 with the message in question except that (1) a loop -%% will be detected by examining Route-Record AVP's, (3) a -%% Route-Record AVP will be added to the outgoing request and (3) the -%% End-to-End Identifier will default to that in the -%% #diameter_header{} without the need for an end_to_end_identifier -%% option. -%% -%% relay and proxy are similar in that they require the same handling -%% with respect to Route-Record and End-to-End identifier. The -%% difference is that a proxy advertises specific applications, while -%% a relay advertises the relay application. If a callback doesn't -%% want to distinguish between the cases in the callback return value -%% then 'resend' is a neutral alternative. -%% -request_cb({A, Opts}, - #diameter_app{id = Id} - = App, - Mask, - T, - TC, - Fs, - Pkt) - when A == relay, Id == ?APP_ID_RELAY; - A == proxy, Id /= ?APP_ID_RELAY; - A == resend -> - resend(Opts, App, Mask, T, TC, Fs, Pkt); - -request_cb(discard, _, _, _, _, _, _) -> - ok; - -request_cb({eval_packet, RC, F}, App, Mask, T, TC, Fs, Pkt) -> - request_cb(RC, App, Mask, T, TC, [F|Fs], Pkt); - -request_cb({eval, RC, F}, App, Mask, T, TC, Fs, Pkt) -> - request_cb(RC, App, Mask, T, TC, Fs, Pkt), - diameter_lib:eval(F). - -%% protocol_error/5 - -protocol_error(RC, {_, OH, OR}, TPid, Fs, Pkt) -> - #diameter_packet{avps = Avps, errors = Es} = Pkt, - ?LOG({error, RC}, Pkt), - reply(answer_message({OH, OR, RC}, Avps), - ?BASE, - TPid, - Fs, - Pkt#diameter_packet{errors = [RC | Es]}). -%% Note that reply/5 may set the result code once more. It's set in -%% answer_message/2 in case reply/5 doesn't. - -%% protocol_error/4 - -protocol_error(RC, T, TPid, Pkt) -> - protocol_error(RC, T, TPid, [], Pkt). - -%% resend/7 -%% -%% Resend a message as a relay or proxy agent. - -resend(Opts, - #diameter_app{} = App, - Mask, - {_SvcName, OH, _OR} = T, - {_TPid, _Caps} = TC, - Fs, - #diameter_packet{avps = Avps} = Pkt) -> - {Code, _Flags, Vid} = ?BASE:avp_header('Route-Record'), - resend(is_loop(Code, Vid, OH, Avps), Opts, App, Mask, T, TC, Fs, Pkt). - -%% DIAMETER_LOOP_DETECTED 3005 -%% An agent detected a loop while trying to get the message to the -%% intended recipient. The message MAY be sent to an alternate peer, -%% if one is available, but the peer reporting the error has -%% identified a configuration problem. - -resend(true, _, _, _, T, {TPid, _}, Fs, Pkt) -> %% Route-Record loop - protocol_error(3005, T, TPid, Fs, Pkt); - -%% 6.1.8. Relaying and Proxying Requests -%% -%% A relay or proxy agent MUST append a Route-Record AVP to all requests -%% forwarded. The AVP contains the identity of the peer the request was -%% received from. - -resend(false, - Opts, - App, - Mask, - {SvcName, _, _} = T, - {TPid, #diameter_caps{origin_host = {_, OH}}}, - Fs, - #diameter_packet{header = Hdr0, - avps = Avps} - = Pkt) -> - Route = #diameter_avp{data = {?BASE, 'Route-Record', OH}}, - Seq = diameter_session:sequence(Mask), - Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq}, - Msg = [Hdr, Route | Avps], - resend(call(SvcName, App, Msg, Opts), T, TPid, Fs, Pkt). -%% The incoming request is relayed with the addition of a -%% Route-Record. Note the requirement on the return from call/4 below, -%% which places a requirement on the value returned by the -%% handle_answer callback of the application module in question. -%% -%% Note that there's nothing stopping the request from being relayed -%% back to the sender. A pick_peer callback may want to avoid this but -%% a smart peer might recognize the potential loop and choose another -%% route. A less smart one will probably just relay the request back -%% again and force us to detect the loop. A pick_peer that wants to -%% avoid this can specify filter to avoid the possibility. -%% Eg. {neg, {host, OH} where #diameter_caps{origin_host = {OH, _}}. -%% -%% RFC 6.3 says that a relay agent does not modify Origin-Host but -%% says nothing about a proxy. Assume it should behave the same way. - -%% resend/4 -%% -%% Relay a reply to a relayed request. - -%% Answer from the peer: reset the hop by hop identifier and send. -resend(#diameter_packet{bin = B} - = Pkt, - _, - TPid, - Fs, - #diameter_packet{header = #diameter_header{hop_by_hop_id = Id}, - transport_data = TD}) -> - P = Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), - transport_data = TD}, - eval_packet(P, Fs), - send(TPid, P); -%% TODO: counters - -%% Or not: DIAMETER_UNABLE_TO_DELIVER. -resend(_, T, TPid, Fs, Pkt) -> - protocol_error(3002, T, TPid, Fs, Pkt). - -%% is_loop/4 -%% -%% Is there a Route-Record AVP with our Origin-Host? - -is_loop(Code, - Vid, - Bin, - [#diameter_avp{code = Code, vendor_id = Vid, data = Bin} | _]) -> - true; - -is_loop(_, _, _, []) -> - false; - -is_loop(Code, Vid, OH, [_ | Avps]) - when is_binary(OH) -> - is_loop(Code, Vid, OH, Avps); - -is_loop(Code, Vid, OH, Avps) -> - is_loop(Code, Vid, ?BASE:avp(encode, OH, 'Route-Record'), Avps). - -%% reply/5 -%% -%% Send a locally originating reply. - -%% Skip the setting of Result-Code and Failed-AVP's below. This is -%% currently undocumented. -reply([Msg], Dict, TPid, Fs, Pkt) - when is_list(Msg); - is_tuple(Msg) -> - reply(Msg, Dict, TPid, Fs, Pkt#diameter_packet{errors = []}); - -%% No errors or a diameter_header/avp list. -reply(Msg, Dict, TPid, Fs, #diameter_packet{errors = Es} = ReqPkt) - when [] == Es; - is_record(hd(Msg), diameter_header) -> - Pkt = diameter_codec:encode(Dict, make_answer_packet(Msg, ReqPkt)), - eval_packet(Pkt, Fs), - incr(send, Pkt, Dict, TPid), %% count result codes in sent answers - send(TPid, Pkt); - -%% Or not: set Result-Code and Failed-AVP AVP's. -reply(Msg, Dict, TPid, Fs, #diameter_packet{errors = [H|_] = Es} = Pkt) -> - reply(rc(Msg, rc(H), [A || {_,A} <- Es], Dict), - Dict, - TPid, - Fs, - Pkt#diameter_packet{errors = []}). - -eval_packet(Pkt, Fs) -> - lists:foreach(fun(F) -> diameter_lib:eval([F,Pkt]) end, Fs). - -%% make_answer_packet/2 - -%% A reply message clears the R and T flags and retains the P flag. -%% The E flag will be set at encode. 6.2 of 3588 requires the same P -%% flag on an answer as on the request. A #diameter_packet{} returned -%% from a handle_request callback can circumvent this by setting its -%% own header values. -make_answer_packet(#diameter_packet{header = Hdr, - msg = Msg, - transport_data = TD}, - #diameter_packet{header = ReqHdr}) -> - Hdr0 = ReqHdr#diameter_header{version = ?DIAMETER_VERSION, - is_request = false, - is_error = undefined, - is_retransmitted = false}, - #diameter_packet{header = fold_record(Hdr0, Hdr), - msg = Msg, - transport_data = TD}; - -%% Binaries and header/avp lists are sent as-is. -make_answer_packet(Bin, #diameter_packet{transport_data = TD}) - when is_binary(Bin) -> - #diameter_packet{bin = Bin, - transport_data = TD}; -make_answer_packet([#diameter_header{} | _] = Msg, - #diameter_packet{transport_data = TD}) -> - #diameter_packet{msg = Msg, - transport_data = TD}; - -%% Otherwise, preserve transport_data. -make_answer_packet(Msg, #diameter_packet{transport_data = TD} = Pkt) -> - make_answer_packet(#diameter_packet{msg = Msg, transport_data = TD}, Pkt). - -%% rc/1 - -rc({RC, _}) -> - RC; -rc(RC) -> - RC. - -%% rc/4 - -rc(#diameter_packet{msg = Rec} = Pkt, RC, Failed, Dict) -> - Pkt#diameter_packet{msg = rc(Rec, RC, Failed, Dict)}; - -rc(Rec, RC, Failed, Dict) - when is_integer(RC) -> - set(Rec, - lists:append([rc(Rec, {'Result-Code', RC}, Dict), - failed_avp(Rec, Failed, Dict)]), - Dict). - -%% Reply as name and tuple list ... -set([_|_] = Ans, Avps, _) -> - Ans ++ Avps; %% Values nearer tail take precedence. - -%% ... or record. -set(Rec, Avps, Dict) -> - Dict:'#set-'(Avps, Rec). - -%% rc/3 -%% -%% Turn the result code into a list if its optional and only set it if -%% the arity is 1 or {0,1}. In other cases (which probably shouldn't -%% exist in practise) we can't know what's appropriate. - -rc([MsgName | _], {'Result-Code' = K, RC} = T, Dict) -> - case Dict:avp_arity(MsgName, 'Result-Code') of - 1 -> [T]; - {0,1} -> [{K, [RC]}]; - _ -> [] - end; - -rc(Rec, T, Dict) -> - rc([Dict:rec2msg(element(1, Rec))], T, Dict). - -%% failed_avp/3 - -failed_avp(_, [] = No, _) -> - No; - -failed_avp(Rec, Failed, Dict) -> - [fa(Rec, [{'AVP', Failed}], Dict)]. - -%% Reply as name and tuple list ... -fa([MsgName | Values], FailedAvp, Dict) -> - R = Dict:msg2rec(MsgName), - try - Dict:'#info-'(R, {index, 'Failed-AVP'}), - {'Failed-AVP', [FailedAvp]} - catch - error: _ -> - Avps = proplists:get_value('AVP', Values, []), - A = #diameter_avp{name = 'Failed-AVP', - value = FailedAvp}, - {'AVP', [A|Avps]} - end; - -%% ... or record. -fa(Rec, FailedAvp, Dict) -> - try - {'Failed-AVP', [FailedAvp]} - catch - error: _ -> - Avps = Dict:'get-'('AVP', Rec), - A = #diameter_avp{name = 'Failed-AVP', - value = FailedAvp}, - {'AVP', [A|Avps]} - end. - -%% 3. Diameter Header -%% -%% E(rror) - If set, the message contains a protocol error, -%% and the message will not conform to the ABNF -%% described for this command. Messages with the 'E' -%% bit set are commonly referred to as error -%% messages. This bit MUST NOT be set in request -%% messages. See Section 7.2. - -%% 3.2. Command Code ABNF specification -%% -%% e-bit = ", ERR" -%% ; If present, the 'E' bit in the Command -%% ; Flags is set, indicating that the answer -%% ; message contains a Result-Code AVP in -%% ; the "protocol error" class. - -%% 7.1.3. Protocol Errors -%% -%% Errors that fall within the Protocol Error category SHOULD be treated -%% on a per-hop basis, and Diameter proxies MAY attempt to correct the -%% error, if it is possible. Note that these and only these errors MUST -%% only be used in answer messages whose 'E' bit is set. - -%% Thus, only construct answers to protocol errors. Other errors -%% require an message-specific answer and must be handled by the -%% application. - -%% 6.2. Diameter Answer Processing -%% -%% When a request is locally processed, the following procedures MUST be -%% applied to create the associated answer, in addition to any -%% additional procedures that MAY be discussed in the Diameter -%% application defining the command: -%% -%% - The same Hop-by-Hop identifier in the request is used in the -%% answer. -%% -%% - The local host's identity is encoded in the Origin-Host AVP. -%% -%% - The Destination-Host and Destination-Realm AVPs MUST NOT be -%% present in the answer message. -%% -%% - The Result-Code AVP is added with its value indicating success or -%% failure. -%% -%% - If the Session-Id is present in the request, it MUST be included -%% in the answer. -%% -%% - Any Proxy-Info AVPs in the request MUST be added to the answer -%% message, in the same order they were present in the request. -%% -%% - The 'P' bit is set to the same value as the one in the request. -%% -%% - The same End-to-End identifier in the request is used in the -%% answer. -%% -%% Note that the error messages (see Section 7.3) are also subjected to -%% the above processing rules. - -%% 7.3. Error-Message AVP -%% -%% The Error-Message AVP (AVP Code 281) is of type UTF8String. It MAY -%% accompany a Result-Code AVP as a human readable error message. The -%% Error-Message AVP is not intended to be useful in real-time, and -%% SHOULD NOT be expected to be parsed by network entities. - -%% answer_message/2 - -answer_message({OH, OR, RC}, Avps) -> - {Code, _, Vid} = ?BASE:avp_header('Session-Id'), - ['answer-message', {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Result-Code', RC} - | session_id(Code, Vid, Avps)]. - -session_id(Code, Vid, Avps) - when is_list(Avps) -> - try - {value, #diameter_avp{data = D}} = find_avp(Code, Vid, Avps), - [{'Session-Id', [?BASE:avp(decode, D, 'Session-Id')]}] - catch - error: _ -> - [] - end. - -%% find_avp/3 - -find_avp(Code, Vid, Avps) - when is_integer(Code), (undefined == Vid orelse is_integer(Vid)) -> - find(fun(A) -> is_avp(Code, Vid, A) end, Avps). - -%% The final argument here could be a list of AVP's, depending on the case, -%% but we're only searching at the top level. -is_avp(Code, Vid, #diameter_avp{code = Code, vendor_id = Vid}) -> - true; -is_avp(_, _, _) -> - false. - -find(_, []) -> - false; -find(Pred, [H|T]) -> - case Pred(H) of - true -> - {value, H}; - false -> - find(Pred, T) - end. - -%% 7. Error Handling -%% -%% There are certain Result-Code AVP application errors that require -%% additional AVPs to be present in the answer. In these cases, the -%% Diameter node that sets the Result-Code AVP to indicate the error -%% MUST add the AVPs. Examples are: -%% -%% - An unrecognized AVP is received with the 'M' bit (Mandatory bit) -%% set, causes an answer to be sent with the Result-Code AVP set to -%% DIAMETER_AVP_UNSUPPORTED, and the Failed-AVP AVP containing the -%% offending AVP. -%% -%% - An AVP that is received with an unrecognized value causes an -%% answer to be returned with the Result-Code AVP set to -%% DIAMETER_INVALID_AVP_VALUE, with the Failed-AVP AVP containing the -%% AVP causing the error. -%% -%% - A command is received with an AVP that is omitted, yet is -%% mandatory according to the command's ABNF. The receiver issues an -%% answer with the Result-Code set to DIAMETER_MISSING_AVP, and -%% creates an AVP with the AVP Code and other fields set as expected -%% in the missing AVP. The created AVP is then added to the Failed- -%% AVP AVP. -%% -%% The Result-Code AVP describes the error that the Diameter node -%% encountered in its processing. In case there are multiple errors, -%% the Diameter node MUST report only the first error it encountered -%% (detected possibly in some implementation dependent order). The -%% specific errors that can be described by this AVP are described in -%% the following section. - -%% 7.5. Failed-AVP AVP -%% -%% The Failed-AVP AVP (AVP Code 279) is of type Grouped and provides -%% debugging information in cases where a request is rejected or not -%% fully processed due to erroneous information in a specific AVP. The -%% value of the Result-Code AVP will provide information on the reason -%% for the Failed-AVP AVP. -%% -%% The possible reasons for this AVP are the presence of an improperly -%% constructed AVP, an unsupported or unrecognized AVP, an invalid AVP -%% value, the omission of a required AVP, the presence of an explicitly -%% excluded AVP (see tables in Section 10), or the presence of two or -%% more occurrences of an AVP which is restricted to 0, 1, or 0-1 -%% occurrences. -%% -%% A Diameter message MAY contain one Failed-AVP AVP, containing the -%% entire AVP that could not be processed successfully. If the failure -%% reason is omission of a required AVP, an AVP with the missing AVP -%% code, the missing vendor id, and a zero filled payload of the minimum -%% required length for the omitted AVP will be added. - -%%% --------------------------------------------------------------------------- -%%% # handle_answer/3 -%%% --------------------------------------------------------------------------- - -%% Process an answer message in call-specific process. - -handle_answer(SvcName, _, {error, Req, Reason}) -> - handle_error(Req, Reason, SvcName); - -handle_answer(SvcName, - AnswerErrors, - {answer, #request{dictionary = Dict} = Req, Pkt}) -> - answer(examine(diameter_codec:decode(Dict, Pkt)), - SvcName, - AnswerErrors, - Req). - -%% We don't really need to do a full decode if we're a relay and will -%% just resend with a new hop by hop identifier, but might a proxy -%% want to examine the answer? - -answer(Pkt, SvcName, AE, #request{transport = TPid, - dictionary = Dict} - = Req) -> - try - incr(recv, Pkt, Dict, TPid) - of - _ -> a(Pkt, SvcName, AE, Req) - catch - exit: {invalid_error_bit, _} = E -> - a(Pkt#diameter_packet{errors = [E]}, SvcName, AE, Req) - end. - -a(#diameter_packet{errors = Es} = Pkt, SvcName, AE, #request{transport = TPid, - caps = Caps, - packet = P} - = Req) - when [] == Es; - callback == AE -> - cb(Req, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}]); - -a(Pkt, SvcName, report, Req) -> - x(errors, handle_answer, [SvcName, Req, Pkt]); - -a(Pkt, SvcName, discard, Req) -> - x({errors, handle_answer, [SvcName, Req, Pkt]}). - -%% Note that we don't check that the application id in the answer's -%% header is what we expect. (TODO: Does the rfc says anything about -%% this?) - -%% incr/4 -%% -%% Increment a stats counter for an incoming or outgoing message. - -%% TODO: fix -incr(_, #diameter_packet{msg = undefined}, _, _) -> - ok; - -incr(recv = D, #diameter_packet{header = H, errors = [_|_]}, _, TPid) -> - incr(TPid, {diameter_codec:msg_id(H), D, error}); - -incr(Dir, Pkt, Dict, TPid) -> - #diameter_packet{header = #diameter_header{is_error = E} - = Hdr, - msg = Rec} - = Pkt, - - RC = int(get_avp_value(Dict, 'Result-Code', Rec)), - PE = is_protocol_error(RC), - - %% Check that the E bit is set only for 3xxx result codes. - (not (E orelse PE)) - orelse (E andalso PE) - orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]), - - irc(TPid, Hdr, Dir, rc_counter(Dict, Rec, RC)). - -irc(_, _, _, undefined) -> - false; - -irc(TPid, Hdr, Dir, Ctr) -> - incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}). - -%% incr/2 - -incr(TPid, Counter) -> - diameter_stats:incr(Counter, TPid, 1). - -%% error_counter/2 - -%% RFC 3588, 7.6: -%% -%% All Diameter answer messages defined in vendor-specific -%% applications MUST include either one Result-Code AVP or one -%% Experimental-Result AVP. -%% -%% Maintain statistics assuming one or the other, not both, which is -%% surely the intent of the RFC. - -rc_counter(Dict, Rec, undefined) -> - er(get_avp_value(Dict, 'Experimental-Result', Rec)); -rc_counter(_, _, RC) -> - {'Result-Code', RC}. - -%% Outgoing answers may be in any of the forms messages can be sent -%% in. Incoming messages will be records. We're assuming here that the -%% arity of the result code AVP's is 0 or 1. - -er([{_,_,N} = T | _]) - when is_integer(N) -> - T; -er({_,_,N} = T) - when is_integer(N) -> - T; -er(_) -> - undefined. - -%% Extract the first good looking integer. There's no guarantee -%% that what we're looking for has arity 1. -int([N|_]) - when is_integer(N) -> - N; -int(N) - when is_integer(N) -> - N; -int(_) -> - undefined. - -is_protocol_error(RC) -> - 3000 =< RC andalso RC < 4000. - --spec x(any(), atom(), list()) -> no_return(). - -%% Warn and exit request process on errors in an incoming answer. -x(Reason, F, A) -> - diameter_lib:warning_report(Reason, {?MODULE, F, A}), - x(Reason). - -x(T) -> - exit(T). - -%%% --------------------------------------------------------------------------- -%%% # failover/[23] -%%% --------------------------------------------------------------------------- - -%% Failover as a consequence of request_peer_down/2. -failover({_, #request{handler = Pid} = Req, TRef}, S) -> - Pid ! {failover, TRef, rt(Req, S)}. - -%% Failover as a consequence of store_request/4. -failover(TRef, Seqs, S) - when is_reference(TRef) -> - case lookup_request(Seqs, TRef) of - #request{} = Req -> - failover({Seqs, Req, TRef}, S); - false -> - ok - end. - -%% prepare_request returned a binary ... -rt(#request{packet = #diameter_packet{msg = undefined}}, _) -> - false; %% TODO: Not what we should do. - -%% ... or not. -rt(#request{packet = #diameter_packet{msg = Msg}, - dictionary = Dict} - = Req, - S) -> - find_transport(get_destination(Dict, Msg), Req, S). - -%%% --------------------------------------------------------------------------- -%%% # report_status/5 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # report_status/5 +%% --------------------------------------------------------------------------- report_status(Status, - #peer{ref = Ref, - conn = TPid, - type = Type, - options = Opts}, - #conn{apps = [_|_] = As, + #watchdog{ref = Ref, + peer = TPid, + type = Type, + options = Opts}, + #peer{apps = [_|_] = As, caps = Caps}, #state{service_name = SvcName} = S, @@ -2615,9 +1251,9 @@ send_event(SvcName, Info) -> send_event(#diameter_event{service = SvcName} = E) -> lists:foreach(fun({_, Pid}) -> Pid ! E end, subscriptions(SvcName)). -%%% --------------------------------------------------------------------------- -%%% # share_peer/5 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # share_peer/5 +%% --------------------------------------------------------------------------- share_peer(up, Caps, Aliases, TPid, #state{options = [_, {_, true} | _], service_name = Svc}) -> @@ -2626,9 +1262,9 @@ share_peer(up, Caps, Aliases, TPid, #state{options = [_, {_, true} | _], share_peer(_, _, _, _, _) -> ok. -%%% --------------------------------------------------------------------------- -%%% # share_peers/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # share_peers/2 +%% --------------------------------------------------------------------------- share_peers(Pid, #state{options = [_, {_, true} | _], local_peers = PDict}) -> @@ -2640,9 +1276,9 @@ share_peers(_, _) -> sp(Pid, Alias, Peers) -> lists:foreach(fun({P,C}) -> Pid ! {peer, P, [Alias], C} end, Peers). -%%% --------------------------------------------------------------------------- -%%% # remote_peer_up/4 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # remote_peer_up/4 +%% --------------------------------------------------------------------------- remote_peer_up(Pid, Aliases, Caps, #state{options = [_, _, {_, true} | _], service = Svc, @@ -2662,9 +1298,9 @@ rpu(Pid, Caps, PDict, Aliases) -> T = {Pid, Caps}, lists:foreach(fun(A) -> ?Dict:append(A, T, PDict) end, Aliases). -%%% --------------------------------------------------------------------------- -%%% # remote_peer_down/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # remote_peer_down/2 +%% --------------------------------------------------------------------------- remote_peer_down(Pid, #state{options = [_, _, {_, true} | _], shared_peers = PDict}) -> @@ -2673,164 +1309,20 @@ remote_peer_down(Pid, #state{options = [_, _, {_, true} | _], rpd(Pid, Alias, PDict) -> ?Dict:update(Alias, fun(Ps) -> lists:keydelete(Pid, 1, Ps) end, PDict). -%%% --------------------------------------------------------------------------- -%%% find_transport/[34] -%%% -%%% Output: {TransportPid, #diameter_caps{}, #diameter_app{}} -%%% | false -%%% | {error, Reason} -%%% --------------------------------------------------------------------------- - -%% Initial call, from an arbitrary process. -find_transport({alias, Alias}, Msg, Opts, #state{service = Svc} = S) -> - #diameter_service{applications = Apps} = Svc, - ft(find_send_app(Alias, Apps), Msg, Opts, S); - -%% Relay or proxy send. -find_transport(#diameter_app{} = App, Msg, Opts, S) -> - ft(App, Msg, Opts, S). - -ft(#diameter_app{module = Mod, dictionary = Dict} = App, Msg, Opts, S) -> - #options{filter = Filter, - extra = Xtra} - = Opts, - pick_peer(App#diameter_app{module = Mod ++ Xtra}, - get_destination(Dict, Msg), - Filter, - S); -ft(false = No, _, _, _) -> - No. - -%% This can't be used if we're a relay and sending a message -%% in an application not known locally. (TODO) -find_send_app(Alias, Apps) -> - case lists:keyfind(Alias, #diameter_app.alias, Apps) of - #diameter_app{id = ?APP_ID_RELAY} -> - false; - T -> - T - end. - -%% Retransmission, in the service process. -find_transport([_,_] = RH, - Req, - #state{service = #diameter_service{pid = Pid, - applications = Apps}} - = S) - when self() == Pid -> - #request{app = Alias, - filter = Filter, - module = ModX} - = Req, - #diameter_app{} - = App - = lists:keyfind(Alias, #diameter_app.alias, Apps), - - pick_peer(App#diameter_app{module = ModX}, - RH, - Filter, - S). - -%% get_destination/2 - -get_destination(Dict, Msg) -> - [str(get_avp_value(Dict, 'Destination-Realm', Msg)), - str(get_avp_value(Dict, 'Destination-Host', Msg))]. - -%% This is not entirely correct. The avp could have an arity 1, in -%% which case an empty list is a DiameterIdentity of length 0 rather -%% than the list of no values we treat it as by mapping to undefined. -%% This behaviour is documented. -str([]) -> - undefined; -str(T) -> - T. - -%% get_avp_value/3 -%% -%% Find an AVP in a message of one of three forms: -%% -%% - a message record (as generated from a .dia spec) or -%% - a list of an atom message name followed by 2-tuple, avp name/value pairs. -%% - a list of a #diameter_header{} followed by #diameter_avp{} records, -%% -%% In the first two forms a dictionary module is used at encode to -%% identify the type of the AVP and its arity in the message in -%% question. The third form allows messages to be sent as is, without -%% a dictionary, which is needed in the case of relay agents, for one. - -%% Messages will be header/avps list as a relay and the only AVP's we -%% look for are in the common dictionary. This is required since the -%% relay dictionary doesn't inherit the common dictionary (which maybe -%% it should). -get_avp_value(?RELAY, Name, Msg) -> - get_avp_value(?BASE, Name, Msg); - -%% Message sent as a header/avps list, probably a relay case but not -%% necessarily. -get_avp_value(Dict, Name, [#diameter_header{} | Avps]) -> - try - {Code, _, VId} = Dict:avp_header(Name), - [A|_] = lists:dropwhile(fun(#diameter_avp{code = C, vendor_id = V}) -> - C /= Code orelse V /= VId - end, - Avps), - avp_decode(Dict, Name, A) - catch - error: _ -> - undefined - end; - -%% Outgoing message as a name/values list. -get_avp_value(_, Name, [_MsgName | Avps]) -> - case lists:keyfind(Name, 1, Avps) of - {_, V} -> - V; - _ -> - undefined - end; - -%% Record might be an answer message in the common dictionary. -get_avp_value(Dict, Name, Rec) - when Dict /= ?BASE, element(1, Rec) == 'diameter_base_answer-message' -> - get_avp_value(?BASE, Name, Rec); - -%% Message is typically a record but not necessarily: diameter:call/4 -%% can be passed an arbitrary term. -get_avp_value(Dict, Name, Rec) -> - try - Dict:'#get-'(Name, Rec) - catch - error:_ -> - undefined - end. - -avp_decode(Dict, Name, #diameter_avp{value = undefined, - data = Bin}) -> - Dict:avp(decode, Bin, Name); -avp_decode(_, _, #diameter_avp{value = V}) -> - V. - -%%% --------------------------------------------------------------------------- -%%% # pick_peer(App, [DestRealm, DestHost], Filter, #state{}) -%%% -%%% Output: {TransportPid, #diameter_caps{}, App} -%%% | false -%%% | {error, Reason} -%%% --------------------------------------------------------------------------- - -%% Find transports to a given realm/host. +%% --------------------------------------------------------------------------- +%% pick_peer/4 +%% --------------------------------------------------------------------------- pick_peer(#diameter_app{alias = Alias} = App, - [_,_] = RH, + RealmAndHost, Filter, #state{local_peers = L, shared_peers = S, service_name = SvcName, service = #diameter_service{pid = Pid}}) -> - pick_peer(peers(Alias, RH, Filter, L), - peers(Alias, RH, Filter, S), + pick_peer(peers(Alias, RealmAndHost, Filter, L), + peers(Alias, RealmAndHost, Filter, S), Pid, SvcName, App). @@ -2843,7 +1335,12 @@ pick_peer([], [], _, _, _) -> %% App state is mutable but we're not in the service process: go there. pick_peer(Local, Remote, Pid, _SvcName, #diameter_app{mutable = true} = App) when self() /= Pid -> - call_service(Pid, {pick_peer, Local, Remote, App}); + case call_service(Pid, {pick_peer, Local, Remote, App}) of + {TPid, _} = T when is_pid(TPid) -> + T; + {error, _} -> + false + end; %% App state isn't mutable or it is and we're in the service process: %% do the deed. @@ -2851,19 +1348,18 @@ pick_peer(Local, Remote, _Pid, SvcName, - #diameter_app{module = ModX, - alias = Alias, + #diameter_app{alias = Alias, init_state = S, mutable = M} = App) -> - MFA = {ModX, pick_peer, [Local, Remote, SvcName]}, + Args = [Local, Remote, SvcName], - try state_cb(App, MFA) of - {ok, {TPid, #diameter_caps{} = Caps}} when is_pid(TPid) -> - {TPid, Caps, App}; - {{TPid, #diameter_caps{} = Caps}, ModS} when is_pid(TPid), M -> + try state_cb(App, pick_peer, Args) of + {ok, {TPid, #diameter_caps{}} = T} when is_pid(TPid) -> + T; + {{TPid, #diameter_caps{}} = T, ModS} when is_pid(TPid), M -> mod_state(Alias, ModS), - {TPid, Caps, App}; + T; {false = No, ModS} when M -> mod_state(Alias, ModS), No; @@ -2871,15 +1367,17 @@ pick_peer(Local, No; false = No -> No; - {{TPid, #diameter_caps{} = Caps}, S} when is_pid(TPid) -> - {TPid, Caps, App}; %% Accept returned state in the immutable + {{TPid, #diameter_caps{}} = T, S} when is_pid(TPid) -> + T; %% Accept returned state in the immutable {false = No, S} -> %% case as long it isn't changed. No; T -> - diameter_lib:error_report({invalid, T, App}, MFA) + diameter_lib:error_report({invalid, T, App}, + {App, pick_peer, Args}) catch E: Reason -> - diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA) + diameter_lib:error_report({failure, {E, Reason, ?STACK}}, + {App, pick_peer, Args}) end. %% peers/4 @@ -2966,14 +1464,14 @@ eq(Any, Id, PeerId) -> %% transports/1 -transports(#state{peerT = PeerT}) -> - ets:select(PeerT, [{#peer{conn = '$1', _ = '_'}, +transports(#state{watchdogT = WatchdogT}) -> + ets:select(WatchdogT, [{#watchdog{peer = '$1', _ = '_'}, [{'is_pid', '$1'}], ['$1']}]). -%%% --------------------------------------------------------------------------- -%%% # service_info/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # service_info/2 +%% --------------------------------------------------------------------------- %% The config passed to diameter:start_service/2. -define(CAP_INFO, ['Origin-Host', @@ -3021,11 +1519,12 @@ tagged_info(Item, S) undefined end; -tagged_info(TPid, #state{peerT = PT, connT = CT}) +tagged_info(TPid, #state{watchdogT = WatchdogT, peerT = PeerT}) when is_pid(TPid) -> try - [#conn{peer = Pid}] = ets:lookup(CT, TPid), - [#peer{ref = Ref, type = Type, options = Opts}] = ets:lookup(PT, Pid), + [#peer{watchdog = Pid}] = ets:lookup(PeerT, TPid), + [#watchdog{ref = Ref, type = Type, options = Opts}] + = ets:lookup(WatchdogT, Pid), [{ref, Ref}, {type, Type}, {options, Opts}] @@ -3108,11 +1607,11 @@ complete(Pre) -> %% info_stats/1 -info_stats(#state{peerT = PeerT}) -> - MatchSpec = [{#peer{ref = '$1', conn = '$2', _ = '_'}, +info_stats(#state{watchdogT = WatchdogT}) -> + MatchSpec = [{#watchdog{ref = '$1', peer = '$2', _ = '_'}, [{'is_pid', '$2'}], [['$1', '$2']]}], - try ets:select(PeerT, MatchSpec) of + try ets:select(WatchdogT, MatchSpec) of L -> diameter_stats:read(lists:append(L)) catch @@ -3122,7 +1621,8 @@ info_stats(#state{peerT = PeerT}) -> %% info_transport/1 %% %% One entry per configured transport. Statistics for each entry are -%% the accumulated values for the ref and associated peer pids. +%% the accumulated values for the ref and associated watchdog/peer +%% pids. info_transport(S) -> PeerD = peer_dict(S, config_dict(S)), @@ -3155,43 +1655,42 @@ transport([[_,_] | L]) -> %% Possibly many peer entries for a listening transport. Note that all %% have the same options by construction, which is not terribly space -%% efficient. (TODO: all entries for the same Ref should share options.) +%% efficient. transport([[{type, accept}, {options, Opts} | _] | _] = Ls) -> [{type, listen}, {options, Opts}, {accept, [lists:nthtail(2,L) || L <- Ls]}]. -peer_dict(#state{peerT = PeerT, connT = ConnT}, Dict0) -> - try ets:tab2list(PeerT) of +peer_dict(#state{watchdogT = WatchdogT, peerT = PeerT}, Dict0) -> + try ets:tab2list(WatchdogT) of L -> - lists:foldl(fun(T,A) -> peer_acc(ConnT, A, T) end, Dict0, L) + lists:foldl(fun(T,A) -> peer_acc(PeerT, A, T) end, Dict0, L) catch error: badarg -> Dict0 %% service has gone down end. -peer_acc(ConnT, Acc, #peer{pid = Pid, - type = Type, - ref = Ref, - options = Opts, - op_state = OS, - started = T, - conn = TPid}) -> - WS = wd_state(OS), +peer_acc(PeerT, Acc, #watchdog{pid = Pid, + type = Type, + ref = Ref, + options = Opts, + state = WS, + started = At, + peer = TPid}) -> dict:append(Ref, [{type, Type}, {options, Opts}, - {watchdog, {Pid, T, WS}} - | info_conn(ConnT, TPid, WS /= ?WD_DOWN)], + {watchdog, {Pid, At, WS}} + | info_peer(PeerT, TPid, WS)], Acc). -info_conn(ConnT, TPid, true) - when is_pid(TPid) -> - try ets:lookup(ConnT, TPid) of - T -> info_conn(T) +info_peer(PeerT, TPid, WS) + when is_pid(TPid), WS /= ?WD_DOWN -> + try ets:lookup(PeerT, TPid) of + T -> info_peer(T) catch error: badarg -> [] %% service has gone down end; -info_conn(_, _, _) -> +info_peer(_, _, _) -> []. %% The point of extracting the config here is so that 'transport' info @@ -3210,19 +1709,12 @@ config_acc({Ref, T, Opts}, Dict) config_acc(_, Dict) -> Dict. -wd_state({_,S}) -> - S; -wd_state(?STATE_UP) -> - ?WD_OKAY; -wd_state(?STATE_DOWN) -> - ?WD_DOWN. - -info_conn([#conn{pid = Pid, apps = SApps, caps = Caps, started = T}]) -> +info_peer([#peer{pid = Pid, apps = SApps, caps = Caps, started = T}]) -> [{peer, {Pid, T}}, {apps, SApps}, {caps, info_caps(Caps)} | try [{port, info_port(Pid)}] catch _:_ -> [] end]; -info_conn([] = No) -> +info_peer([] = No) -> No. %% Extract information that the processes involved are expected to @@ -3256,22 +1748,7 @@ mk_app(#diameter_app{} = A) -> %% One entry for each outgoing request whose answer is outstanding. info_pending(#state{} = S) -> - MatchSpec = [{{'$1', - #request{transport = '$2', - from = '$3', - app = '$4', - _ = '_'}, - '_'}, - [?ORCOND([{'==', T, '$2'} || T <- transports(S)])], - [{{'$1', [{{app, '$4'}}, - {{transport, '$2'}}, - {{from, '$3'}}]}}]}], - - try - ets:select(?REQUEST_TABLE, MatchSpec) - catch - error: badarg -> [] %% service has gone down - end. + diameter_traffic:pending(transports(S)). %% info_connections/1 %% diff --git a/lib/diameter/src/base/diameter_stats.erl b/lib/diameter/src/base/diameter_stats.erl index 70727d068e..8fd5ded300 100644 --- a/lib/diameter/src/base/diameter_stats.erl +++ b/lib/diameter/src/base/diameter_stats.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -136,7 +136,7 @@ read(Refs, B) -> -spec flush([ref()]) -> [{ref(), {counter(), integer()}}]. - + flush(Refs) -> try call({flush, Refs}) diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl new file mode 100644 index 0000000000..f527f7c754 --- /dev/null +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -0,0 +1,1705 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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% +%% + +%% +%% Implements the handling of incoming and outgoing Diameter messages +%% except CER/CEA, DWR/DWA and DPR/DPA. That is, the messages that a +%% diameter client sends and receives. +%% + +-module(diameter_traffic). + +%% towards diameter +-export([send_request/4]). + +%% towards diameter_watchdog +-export([receive_message/4]). + +%% towards diameter_service +-export([make_recvdata/1, + peer_up/1, + peer_down/1, + failover/1, + pending/1]). + +%% towards ?MODULE +-export([send/1]). %% send from remote node + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). + +-define(RELAY, ?DIAMETER_DICT_RELAY). +-define(BASE, ?DIAMETER_DICT_COMMON). %% Note: the RFC 3588 dictionary + +-define(DEFAULT_TIMEOUT, 5000). %% for outgoing requests + +%% Table containing outgoing requests for which a reply has yet to be +%% received. +-define(REQUEST_TABLE, diameter_request). + +%% Workaround for dialyzer's lack of understanding of match specs. +-type match(T) + :: T | '_' | '$1' | '$2' | '$3' | '$4'. + +%% Record diameter:call/4 options are parsed into. +-record(options, + {filter = none :: diameter:peer_filter(), + extra = [] :: list(), + timeout = ?DEFAULT_TIMEOUT :: 0..16#FFFFFFFF, + detach = false :: boolean()}). + +%% Term passed back to receive_message/4 with every incoming message. +-record(recvdata, + {peerT :: ets:tid(), + service_name :: diameter:service_name(), + apps :: [#diameter_app{}], + sequence :: diameter:sequence()}). + +%% Record stored in diameter_request for each outgoing request. +-record(request, + {ref :: match(reference()), %% used to receive answer + caller :: match(pid()), %% calling process + handler :: match(pid()), %% request process + transport :: match(pid()), %% peer process + caps :: match(#diameter_caps{}), %% of connection + packet :: match(#diameter_packet{})}). %% of request + +%% --------------------------------------------------------------------------- +%% # make_recvdata/1 +%% --------------------------------------------------------------------------- + +make_recvdata([SvcName, PeerT, Apps, Mask | _]) -> + #recvdata{service_name = SvcName, + peerT = PeerT, + apps = Apps, + sequence = Mask}. +%% Take a list so that the caller (diameter_service) can be upgraded +%% first if new members are added. Note that receive_message/4 might +%% still get an old term from any watchdog started in old code. + +%% --------------------------------------------------------------------------- +%% peer_up/1 +%% --------------------------------------------------------------------------- + +%% Insert an element that is used to detect whether or not there has +%% been a failover when inserting an outgoing request. +peer_up(TPid) -> + ets:insert(?REQUEST_TABLE, {TPid}). + +%% --------------------------------------------------------------------------- +%% peer_down/1 +%% --------------------------------------------------------------------------- + +peer_down(TPid) -> + ets:delete(?REQUEST_TABLE, TPid), + failover(TPid). + +%% --------------------------------------------------------------------------- +%% pending/1 +%% --------------------------------------------------------------------------- + +pending(TPids) -> + MatchSpec = [{{'$1', + #request{caller = '$2', + handler = '$3', + transport = '$4', + _ = '_'}, + '_'}, + [?ORCOND([{'==', T, '$4'} || T <- TPids])], + [{{'$1', [{{caller, '$2'}}, + {{handler, '$3'}}, + {{transport, '$4'}}]}}]}], + + try + ets:select(?REQUEST_TABLE, MatchSpec) + catch + error: badarg -> [] %% service has gone down + end. + +%% --------------------------------------------------------------------------- +%% # receive_message/4 +%% +%% Handle an incoming Diameter message. +%% --------------------------------------------------------------------------- + +%% Handle an incoming Diameter message in the watchdog process. This +%% used to come through the service process but this avoids that +%% becoming a bottleneck. + +receive_message(TPid, Pkt, Dict0, RecvData) + when is_pid(TPid) -> + #diameter_packet{header = #diameter_header{is_request = R}} = Pkt, + recv(R, + (not R) andalso lookup_request(Pkt, TPid), + TPid, + Pkt, + Dict0, + RecvData). + +%% Incoming request ... +recv(true, false, TPid, Pkt, Dict0, RecvData) -> + try + spawn(fun() -> recv_request(TPid, Pkt, Dict0, RecvData) end) + catch + error: system_limit = E -> %% discard + ?LOG({error, E}, now()) + end; + +%% ... answer to known request ... +recv(false, #request{ref = Ref, handler = Pid} = Req, _, Pkt, Dict0, _) -> + Pid ! {answer, Ref, Req, Dict0, Pkt}; +%% Note that failover could have happened prior to this message being +%% received and triggering failback. That is, both a failover message +%% and answer may be on their way to the handler process. In the worst +%% case the request process gets notification of the failover and +%% sends to the alternate peer before an answer arrives, so it's +%% always the case that we can receive more than one answer after +%% failover. The first answer received by the request process wins, +%% any others are discarded. + +%% ... or not. +recv(false, false, _, _, _, _) -> + ok. + +%% --------------------------------------------------------------------------- +%% recv_request/4 +%% --------------------------------------------------------------------------- + +recv_request(TPid, + #diameter_packet{header = #diameter_header{application_id = Id}} + = Pkt, + Dict0, + #recvdata{peerT = PeerT, apps = Apps} + = RecvData) -> + send_A(recv_R(diameter_service:find_incoming_app(PeerT, TPid, Id, Apps), + TPid, + Pkt, + Dict0, + RecvData), + TPid, + Dict0, + RecvData). + +%% recv_R/5 + +recv_R({#diameter_app{id = Id, dictionary = Dict} = App, Caps}, + TPid, + Pkt0, + Dict0, + RecvData) -> + Pkt = errors(Id, diameter_codec:decode(Id, Dict, Pkt0)), + {Caps, Pkt, App, recv_R(App, TPid, Dict0, Caps, RecvData, Pkt)}; +%% Note that the decode is different depending on whether or not Id is +%% ?APP_ID_RELAY. + +%% DIAMETER_APPLICATION_UNSUPPORTED 3007 +%% A request was sent for an application that is not supported. + +recv_R(#diameter_caps{} + = Caps, + _TPid, + #diameter_packet{errors = Es} + = Pkt, + _Dict0, + _RecvData) -> + {Caps, Pkt#diameter_packet{avps = collect_avps(Pkt), + errors = [3007 | Es]}}; + +recv_R(false = No, _, _, _, _) -> %% transport has gone down + No. + +collect_avps(Pkt) -> + case diameter_codec:collect_avps(Pkt) of + {_Bs, As} -> + As; + As -> + As + end. + +%% recv_R/6 + +%% Answer errors ourselves ... +recv_R(#diameter_app{options = [_, {request_errors, E} | _]}, + _TPid, + Dict0, + _Caps, + _RecvData, + #diameter_packet{errors = [RC|_]}) %% a detected 3xxx is hd + when E == answer, (Dict0 /= ?BASE orelse 3 == RC div 1000); + E == answer_3xxx, 3 == RC div 1000 -> + {{answer_message, rc(RC)}, [], []}; + +%% ... or make a handle_request callback. Note that +%% Pkt#diameter_packet.msg = undefined in the 3001 case. +recv_R(App, + TPid, + _Dict0, + Caps, + #recvdata{service_name = SvcName}, + Pkt) -> + request_cb(cb(App, handle_request, [Pkt, SvcName, {TPid, Caps}]), + App, + [], + []). + +rc({N,_}) -> + N; +rc(N) -> + N. + +%% errors/1 +%% +%% Look for additional errors in a decoded message, prepending the +%% errors field with the first detected error. It's odd/unfortunate +%% that 501[15] aren't protocol errors. With RFC 3588 this means that +%% a handle_request callback has to formulate the answer. With RFC +%% 6733 it's acceptable for 5xxx to be sent in an answer-message. + +%% DIAMETER_INVALID_MESSAGE_LENGTH 5015 +%% This error is returned when a request is received with an invalid +%% message length. + +errors(_, #diameter_packet{header = #diameter_header{length = Len}, + bin = Bin, + errors = Es} + = Pkt) + when Len < 20; + 0 /= Len rem 4; + 8*Len /= bit_size(Bin) -> + Pkt#diameter_packet{errors = [5015 | Es]}; + +%% DIAMETER_UNSUPPORTED_VERSION 5011 +%% This error is returned when a request was received, whose version +%% number is unsupported. + +errors(_, #diameter_packet{header = #diameter_header{version = V}, + errors = Es} + = Pkt) + when V /= ?DIAMETER_VERSION -> + Pkt#diameter_packet{errors = [5011 | Es]}; + +%% DIAMETER_INVALID_AVP_BITS 3009 +%% A request was received that included an AVP whose flag bits are +%% set to an unrecognized value, or that is inconsistent with the +%% AVP's definition. + +errors(_, #diameter_packet{errors = [Bs | Es]} = Pkt) + when is_bitstring(Bs) -> + Pkt#diameter_packet{errors = [3009 | Es]}; + +%% DIAMETER_COMMAND_UNSUPPORTED 3001 +%% The Request contained a Command-Code that the receiver did not +%% recognize or support. This MUST be used when a Diameter node +%% receives an experimental command that it does not understand. + +errors(Id, #diameter_packet{header = #diameter_header{is_proxiable = P}, + msg = M, + errors = Es} + = Pkt) + when ?APP_ID_RELAY /= Id, undefined == M; %% don't know the command + ?APP_ID_RELAY == Id, not P -> %% command isn't proxiable + Pkt#diameter_packet{errors = [3001 | Es]}; + +%% DIAMETER_INVALID_HDR_BITS 3008 +%% A request was received whose bits in the Diameter header were +%% either set to an invalid combination, or to a value that is +%% inconsistent with the command code's definition. + +errors(_, #diameter_packet{header = #diameter_header{is_request = true, + is_error = true}, + errors = Es} + = Pkt) -> + Pkt#diameter_packet{errors = [3008 | Es]}; + +%% Green. +errors(_, Pkt) -> + Pkt. + +%% request_cb/4 + +%% A reply may be an answer-message, constructed either here or by +%% the handle_request callback. The header from the incoming request +%% is passed into the encode so that it can retrieve the relevant +%% command code in this case. It will also then ignore Dict and use +%% the base encoder. +request_cb({reply, _Ans} = T, _App, EvalPktFs, EvalFs) -> + {T, EvalPktFs, EvalFs}; + +%% An 3xxx result code, for which the E-bit is set in the header. +request_cb({protocol_error, RC}, _App, EvalPktFs, EvalFs) + when 3 == RC div 1000 -> + {{answer_message, RC}, EvalPktFs, EvalFs}; + +request_cb({answer_message, RC} = T, _App, EvalPktFs, EvalFs) + when 3 == RC div 1000; + 5 == RC div 1000 -> + {T, EvalPktFs, EvalFs}; + +%% RFC 3588 says we must reply 3001 to anything unrecognized or +%% unsupported. 'noreply' is undocumented (and inappropriately named) +%% backwards compatibility for this, protocol_error the documented +%% alternative. +request_cb(noreply, _App, EvalPktFs, EvalFs) -> + {{answer_message, 3001}, EvalPktFs, EvalFs}; + +%% Relay a request to another peer. This is equivalent to doing an +%% explicit call/4 with the message in question except that (1) a loop +%% will be detected by examining Route-Record AVP's, (3) a +%% Route-Record AVP will be added to the outgoing request and (3) the +%% End-to-End Identifier will default to that in the +%% #diameter_header{} without the need for an end_to_end_identifier +%% option. +%% +%% relay and proxy are similar in that they require the same handling +%% with respect to Route-Record and End-to-End identifier. The +%% difference is that a proxy advertises specific applications, while +%% a relay advertises the relay application. If a callback doesn't +%% want to distinguish between the cases in the callback return value +%% then 'resend' is a neutral alternative. +%% +request_cb({A, Opts}, #diameter_app{id = Id}, EvalPktFs, EvalFs) + when A == relay, Id == ?APP_ID_RELAY; + A == proxy, Id /= ?APP_ID_RELAY; + A == resend -> + {{call, Opts}, EvalPktFs, EvalFs}; + +request_cb(discard = No, _, _, _) -> + No; + +request_cb({eval_packet, RC, F}, App, Fs, EvalFs) -> + request_cb(RC, App, [F|Fs], EvalFs); + +request_cb({eval, RC, F}, App, EvalPktFs, Fs) -> + request_cb(RC, App, EvalPktFs, [F|Fs]); + +request_cb(T, App, _, _) -> + ?ERROR({invalid_return, T, handle_request, App}). + +%% send_A/4 + +send_A({Caps, Pkt}, TPid, Dict0, _RecvData) -> %% unsupported application + #diameter_packet{errors = [RC|_]} = Pkt, + send_A(answer_message(RC, Caps, Dict0, Pkt), + TPid, + Dict0, + Pkt, + [], + []); + +send_A({Caps, Pkt, App, {T, EvalPktFs, EvalFs}}, TPid, Dict0, RecvData) -> + send_A(answer(T, Caps, Pkt, App, Dict0, RecvData), + TPid, + Dict0, + Pkt, + EvalPktFs, + EvalFs); + +send_A(_, _, _, _) -> + ok. + +%% send_A/6 + +send_A(T, TPid, Dict0, ReqPkt, EvalPktFs, EvalFs) -> + reply(T, TPid, Dict0, EvalPktFs, ReqPkt), + lists:foreach(fun diameter_lib:eval/1, EvalFs). + +%% answer/6 + +answer({reply, Ans}, _Caps, _Pkt, App, Dict0, _RecvData) -> + {dict(App#diameter_app.dictionary, Dict0, Ans), Ans}; + +answer({call, Opts}, Caps, Pkt, App, Dict0, RecvData) -> + #diameter_caps{origin_host = {OH,_}} + = Caps, + #diameter_packet{avps = Avps} + = Pkt, + {Code, _Flags, Vid} = Dict0:avp_header('Route-Record'), + resend(is_loop(Code, Vid, OH, Dict0, Avps), + Opts, + Caps, + Pkt, + App, + Dict0, + RecvData); + +%% RFC 3588 only allows 3xxx errors in an answer-message. RFC 6733 +%% added the possibility of setting 5xxx. +answer({answer_message, RC} = T, Caps, Pkt, App, Dict0, _RecvData) -> + Dict0 /= ?BASE orelse 3 == RC div 1000 + orelse ?ERROR({invalid_return, T, handle_request, App}), + answer_message(RC, Caps, Dict0, Pkt). + +%% dict/3 + +%% An incoming answer, not yet decoded. +dict(Dict, Dict0, #diameter_packet{header + = #diameter_header{is_request = false, + is_error = E}, + msg = undefined}) -> + if E -> Dict0; true -> Dict end; + +dict(Dict, Dict0, [Msg]) -> + dict(Dict, Dict0, Msg); + +dict(Dict, Dict0, #diameter_packet{msg = Msg}) -> + dict(Dict, Dict0, Msg); + +dict(Dict, Dict0, Msg) -> + choose(is_answer_message(Msg, Dict0), Dict0, Dict). + +is_answer_message([Name | _], _) -> + Name == 'answer-message'; + +is_answer_message(Rec, Dict) -> + try + 'answer-message' == Dict:rec2msg(element(1,Rec)) + catch + error:_ -> false + end. + +%% answer_message/4 + +answer_message(RC, + #diameter_caps{origin_host = {OH,_}, + origin_realm = {OR,_}}, + Dict0, + #diameter_packet{avps = Avps} + = Pkt) -> + ?LOG({error, RC}, Pkt), + {Dict0, answer_message(OH, OR, RC, Dict0, Avps)}. + +%% resend/7 + +%% DIAMETER_LOOP_DETECTED 3005 +%% An agent detected a loop while trying to get the message to the +%% intended recipient. The message MAY be sent to an alternate peer, +%% if one is available, but the peer reporting the error has +%% identified a configuration problem. + +resend(true, _Opts, Caps, Pkt, _App, Dict0, _RecvData) -> + answer_message(3005, Caps, Dict0, Pkt); + +%% 6.1.8. Relaying and Proxying Requests +%% +%% A relay or proxy agent MUST append a Route-Record AVP to all requests +%% forwarded. The AVP contains the identity of the peer the request was +%% received from. + +resend(false, + Opts, + #diameter_caps{origin_host = {_,OH}} + = Caps, + #diameter_packet{header = Hdr0, + avps = Avps} + = Pkt, + App, + Dict0, + #recvdata{service_name = SvcName, + sequence = Mask}) -> + Route = #diameter_avp{data = {Dict0, 'Route-Record', OH}}, + Seq = diameter_session:sequence(Mask), + Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq}, + Msg = [Hdr, Route | Avps], + resend(send_request(SvcName, App, Msg, Opts), Caps, Dict0, Pkt). +%% The incoming request is relayed with the addition of a +%% Route-Record. Note the requirement on the return from call/4 below, +%% which places a requirement on the value returned by the +%% handle_answer callback of the application module in question. +%% +%% Note that there's nothing stopping the request from being relayed +%% back to the sender. A pick_peer callback may want to avoid this but +%% a smart peer might recognize the potential loop and choose another +%% route. A less smart one will probably just relay the request back +%% again and force us to detect the loop. A pick_peer that wants to +%% avoid this can specify filter to avoid the possibility. +%% Eg. {neg, {host, OH} where #diameter_caps{origin_host = {OH, _}}. +%% +%% RFC 6.3 says that a relay agent does not modify Origin-Host but +%% says nothing about a proxy. Assume it should behave the same way. + +%% resend/4 +%% +%% Relay a reply to a relayed request. + +%% Answer from the peer: reset the hop by hop identifier and send. +resend(#diameter_packet{bin = B} + = Pkt, + _Caps, + _Dict0, + #diameter_packet{header = #diameter_header{hop_by_hop_id = Id}, + transport_data = TD}) -> + Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), + transport_data = TD}; +%% TODO: counters + +%% Or not: DIAMETER_UNABLE_TO_DELIVER. +resend(_, Caps, Dict0, Pkt) -> + answer_message(3002, Caps, Dict0, Pkt). + +%% is_loop/5 +%% +%% Is there a Route-Record AVP with our Origin-Host? + +is_loop(Code, + Vid, + Bin, + _Dict0, + [#diameter_avp{code = Code, vendor_id = Vid, data = Bin} | _]) -> + true; + +is_loop(_, _, _, _, []) -> + false; + +is_loop(Code, Vid, OH, Dict0, [_ | Avps]) + when is_binary(OH) -> + is_loop(Code, Vid, OH, Dict0, Avps); + +is_loop(Code, Vid, OH, Dict0, Avps) -> + is_loop(Code, Vid, Dict0:avp(encode, OH, 'Route-Record'), Dict0, Avps). + +%% reply/5 + +%% Local answer ... +reply({Dict, Ans}, TPid, Dict0, Fs, ReqPkt) -> + reply(Ans, Dict, TPid, Dict0, Fs, ReqPkt); + +%% ... or relayed. +reply(#diameter_packet{} = Pkt, TPid, _Dict0, Fs, _ReqPkt) -> + eval_packet(Pkt, Fs), + send(TPid, Pkt). + +%% reply/6 +%% +%% Send a locally originating reply. + +%% Skip the setting of Result-Code and Failed-AVP's below. This is +%% undocumented and shouldn't be relied on. +reply([Msg], Dict, TPid, Dict0, Fs, ReqPkt) + when is_list(Msg); + is_tuple(Msg) -> + reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt#diameter_packet{errors = []}); + +%% No errors or a diameter_header/avp list. +reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt) -> + Pkt = encode(Dict, reset(make_answer_packet(Msg, ReqPkt), Dict), Fs), + incr(send, Pkt, Dict, TPid, Dict0), %% count outgoing result codes + send(TPid, Pkt). + +%% reset/2 + +%% Header/avps list: send as is. +reset(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) -> + Pkt; + +%% No errors to set or errors explicitly ignored. +reset(#diameter_packet{errors = Es} = Pkt, _) + when Es == []; + Es == false -> + Pkt; + +%% Otherwise possibly set Result-Code and/or Failed-AVP. +reset(#diameter_packet{msg = Msg, errors = Es} = Pkt, Dict) -> + Pkt#diameter_packet{msg = reset(Msg, Dict, Es)}. + +%% reset/3 + +reset(Msg, Dict, Es) + when is_list(Es) -> + {E3, E5, Fs} = partition(Es), + FailedAVP = failed_avp(Msg, lists:reverse(Fs), Dict), + reset(set(Msg, FailedAVP, Dict), + Dict, + choose(is_answer_message(Msg, Dict), E3, E5)); + +reset(Msg, Dict, N) + when is_integer(N) -> + ResultCode = rc(Msg, {'Result-Code', N}, Dict), + set(Msg, ResultCode, Dict); + +reset(Msg, _, _) -> + Msg. + +partition(Es) -> + lists:foldl(fun pacc/2, {false, false, []}, Es). + +%% Note that the errors list can contain not only integer() and +%% {integer(), #diameter_avp{}} but also #diameter_avp{}. The latter +%% isn't something that's returned by decode but can be set in a reply +%% for encode. + +pacc({RC, #diameter_avp{} = A}, {E3, E5, Acc}) + when is_integer(RC) -> + pacc(RC, {E3, E5, [A|Acc]}); + +pacc(#diameter_avp{} = A, {E3, E5, Acc}) -> + {E3, E5, [A|Acc]}; + +pacc(RC, {false, E5, Acc}) + when 3 == RC div 1000 -> + {RC, E5, Acc}; + +pacc(RC, {E3, false, Acc}) + when 5 == RC div 1000 -> + {E3, RC, Acc}; + +pacc(_, Acc) -> + Acc. + +eval_packet(Pkt, Fs) -> + lists:foreach(fun(F) -> diameter_lib:eval([F,Pkt]) end, Fs). + +%% make_answer_packet/2 + +%% Use decode errors to set Result-Code and/or Failed-AVP unless the +%% the errors field has been explicitly set. Unfortunately, the +%% default value is the empty list rather than 'undefined' so use the +%% atom 'false' for "set nothing". (This is historical and changing +%% the default value would require modules including diameter.hrl to +%% be recompiled.) +make_answer_packet(#diameter_packet{errors = []} + = Pkt, + #diameter_packet{errors = [_|_] = Es} + = ReqPkt) -> + make_answer_packet(Pkt#diameter_packet{errors = Es}, ReqPkt); + +%% A reply message clears the R and T flags and retains the P flag. +%% The E flag will be set at encode. 6.2 of 3588 requires the same P +%% flag on an answer as on the request. A #diameter_packet{} returned +%% from a handle_request callback can circumvent this by setting its +%% own header values. +make_answer_packet(#diameter_packet{header = Hdr, + msg = Msg, + errors = Es, + transport_data = TD}, + #diameter_packet{header = ReqHdr}) -> + Hdr0 = ReqHdr#diameter_header{version = ?DIAMETER_VERSION, + is_request = false, + is_error = undefined, + is_retransmitted = false}, + #diameter_packet{header = fold_record(Hdr0, Hdr), + msg = Msg, + errors = Es, + transport_data = TD}; + +%% Binaries and header/avp lists are sent as-is. +make_answer_packet(Bin, #diameter_packet{transport_data = TD}) + when is_binary(Bin) -> + #diameter_packet{bin = Bin, + transport_data = TD}; +make_answer_packet([#diameter_header{} | _] = Msg, + #diameter_packet{transport_data = TD}) -> + #diameter_packet{msg = Msg, + transport_data = TD}; + +%% Otherwise, preserve transport_data. +make_answer_packet(Msg, #diameter_packet{transport_data = TD} = Pkt) -> + make_answer_packet(#diameter_packet{msg = Msg, transport_data = TD}, Pkt). + +%% Reply as name and tuple list ... +set([_|_] = Ans, Avps, _) -> + Ans ++ Avps; %% Values nearer tail take precedence. + +%% ... or record. +set(Rec, Avps, Dict) -> + Dict:'#set-'(Avps, Rec). + +%% rc/3 +%% +%% Turn the result code into a list if its optional and only set it if +%% the arity is 1 or {0,1}. In other cases (which probably shouldn't +%% exist in practise) we can't know what's appropriate. + +rc([MsgName | _], {'Result-Code' = K, RC} = T, Dict) -> + case Dict:avp_arity(MsgName, 'Result-Code') of + 1 -> [T]; + {0,1} -> [{K, [RC]}]; + _ -> [] + end; + +rc(Rec, T, Dict) -> + rc([Dict:rec2msg(element(1, Rec))], T, Dict). + +%% failed_avp/3 + +failed_avp(_, [] = No, _) -> + No; + +failed_avp(Rec, Failed, Dict) -> + [fa(Rec, [{'AVP', Failed}], Dict)]. + +%% Reply as name and tuple list ... +fa([MsgName | Values], FailedAvp, Dict) -> + R = Dict:msg2rec(MsgName), + try + Dict:'#info-'(R, {index, 'Failed-AVP'}), + {'Failed-AVP', [FailedAvp]} + catch + error: _ -> + Avps = proplists:get_value('AVP', Values, []), + A = #diameter_avp{name = 'Failed-AVP', + value = FailedAvp}, + {'AVP', [A|Avps]} + end; + +%% ... or record. +fa(Rec, FailedAvp, Dict) -> + try + {'Failed-AVP', [FailedAvp]} + catch + error: _ -> + Avps = Dict:'get-'('AVP', Rec), + A = #diameter_avp{name = 'Failed-AVP', + value = FailedAvp}, + {'AVP', [A|Avps]} + end. + +%% 3. Diameter Header +%% +%% E(rror) - If set, the message contains a protocol error, +%% and the message will not conform to the ABNF +%% described for this command. Messages with the 'E' +%% bit set are commonly referred to as error +%% messages. This bit MUST NOT be set in request +%% messages. See Section 7.2. + +%% 3.2. Command Code ABNF specification +%% +%% e-bit = ", ERR" +%% ; If present, the 'E' bit in the Command +%% ; Flags is set, indicating that the answer +%% ; message contains a Result-Code AVP in +%% ; the "protocol error" class. + +%% 7.1.3. Protocol Errors +%% +%% Errors that fall within the Protocol Error category SHOULD be treated +%% on a per-hop basis, and Diameter proxies MAY attempt to correct the +%% error, if it is possible. Note that these and only these errors MUST +%% only be used in answer messages whose 'E' bit is set. + +%% Thus, only construct answers to protocol errors. Other errors +%% require an message-specific answer and must be handled by the +%% application. + +%% 6.2. Diameter Answer Processing +%% +%% When a request is locally processed, the following procedures MUST be +%% applied to create the associated answer, in addition to any +%% additional procedures that MAY be discussed in the Diameter +%% application defining the command: +%% +%% - The same Hop-by-Hop identifier in the request is used in the +%% answer. +%% +%% - The local host's identity is encoded in the Origin-Host AVP. +%% +%% - The Destination-Host and Destination-Realm AVPs MUST NOT be +%% present in the answer message. +%% +%% - The Result-Code AVP is added with its value indicating success or +%% failure. +%% +%% - If the Session-Id is present in the request, it MUST be included +%% in the answer. +%% +%% - Any Proxy-Info AVPs in the request MUST be added to the answer +%% message, in the same order they were present in the request. +%% +%% - The 'P' bit is set to the same value as the one in the request. +%% +%% - The same End-to-End identifier in the request is used in the +%% answer. +%% +%% Note that the error messages (see Section 7.3) are also subjected to +%% the above processing rules. + +%% 7.3. Error-Message AVP +%% +%% The Error-Message AVP (AVP Code 281) is of type UTF8String. It MAY +%% accompany a Result-Code AVP as a human readable error message. The +%% Error-Message AVP is not intended to be useful in real-time, and +%% SHOULD NOT be expected to be parsed by network entities. + +%% answer_message/5 + +answer_message(OH, OR, RC, Dict0, Avps) -> + {Code, _, Vid} = Dict0:avp_header('Session-Id'), + ['answer-message', {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Result-Code', RC} + | session_id(Code, Vid, Dict0, Avps)]. + +session_id(Code, Vid, Dict0, Avps) + when is_list(Avps) -> + try + {value, #diameter_avp{data = D}} = find_avp(Code, Vid, Avps), + [{'Session-Id', [Dict0:avp(decode, D, 'Session-Id')]}] + catch + error: _ -> + [] + end. + +%% find_avp/3 + +find_avp(Code, Vid, Avps) + when is_integer(Code), (undefined == Vid orelse is_integer(Vid)) -> + find(fun(A) -> is_avp(Code, Vid, A) end, Avps). + +%% The final argument here could be a list of AVP's, depending on the case, +%% but we're only searching at the top level. +is_avp(Code, Vid, #diameter_avp{code = Code, vendor_id = Vid}) -> + true; +is_avp(_, _, _) -> + false. + +find(_, []) -> + false; +find(Pred, [H|T]) -> + case Pred(H) of + true -> + {value, H}; + false -> + find(Pred, T) + end. + +%% 7. Error Handling +%% +%% There are certain Result-Code AVP application errors that require +%% additional AVPs to be present in the answer. In these cases, the +%% Diameter node that sets the Result-Code AVP to indicate the error +%% MUST add the AVPs. Examples are: +%% +%% - An unrecognized AVP is received with the 'M' bit (Mandatory bit) +%% set, causes an answer to be sent with the Result-Code AVP set to +%% DIAMETER_AVP_UNSUPPORTED, and the Failed-AVP AVP containing the +%% offending AVP. +%% +%% - An AVP that is received with an unrecognized value causes an +%% answer to be returned with the Result-Code AVP set to +%% DIAMETER_INVALID_AVP_VALUE, with the Failed-AVP AVP containing the +%% AVP causing the error. +%% +%% - A command is received with an AVP that is omitted, yet is +%% mandatory according to the command's ABNF. The receiver issues an +%% answer with the Result-Code set to DIAMETER_MISSING_AVP, and +%% creates an AVP with the AVP Code and other fields set as expected +%% in the missing AVP. The created AVP is then added to the Failed- +%% AVP AVP. +%% +%% The Result-Code AVP describes the error that the Diameter node +%% encountered in its processing. In case there are multiple errors, +%% the Diameter node MUST report only the first error it encountered +%% (detected possibly in some implementation dependent order). The +%% specific errors that can be described by this AVP are described in +%% the following section. + +%% 7.5. Failed-AVP AVP +%% +%% The Failed-AVP AVP (AVP Code 279) is of type Grouped and provides +%% debugging information in cases where a request is rejected or not +%% fully processed due to erroneous information in a specific AVP. The +%% value of the Result-Code AVP will provide information on the reason +%% for the Failed-AVP AVP. +%% +%% The possible reasons for this AVP are the presence of an improperly +%% constructed AVP, an unsupported or unrecognized AVP, an invalid AVP +%% value, the omission of a required AVP, the presence of an explicitly +%% excluded AVP (see tables in Section 10), or the presence of two or +%% more occurrences of an AVP which is restricted to 0, 1, or 0-1 +%% occurrences. +%% +%% A Diameter message MAY contain one Failed-AVP AVP, containing the +%% entire AVP that could not be processed successfully. If the failure +%% reason is omission of a required AVP, an AVP with the missing AVP +%% code, the missing vendor id, and a zero filled payload of the minimum +%% required length for the omitted AVP will be added. + +%% incr/4 +%% +%% Increment a stats counter for result codes in incoming and outgoing +%% answers. + +%% Outgoing message as binary: don't count. (Sending binaries is only +%% partially supported.) +incr(_, #diameter_packet{msg = undefined}, _, _, _) -> + ok; + +%% Incoming with decode errors. +incr(recv = D, #diameter_packet{header = H, errors = [_|_]}, _, TPid, _) -> + incr(TPid, {diameter_codec:msg_id(H), D, error}); + +%% Incoming without errors or outgoing. Outgoing with encode errors +%% never gets here since encode fails. +incr(Dir, Pkt, Dict, TPid, Dict0) -> + #diameter_packet{header = #diameter_header{is_error = E} + = Hdr, + msg = Rec} + = Pkt, + + RC = int(get_avp_value(Dict, 'Result-Code', Rec)), + + %% Exit on an improper Result-Code. + is_result(RC, E, Dict0) + orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]), + + irc(TPid, Hdr, Dir, rc_counter(Dict, Rec, RC)). + +%% No E-bit: can't be 3xxx. +is_result(RC, false, _Dict0) -> + RC < 3000 orelse 4000 =< RC; + +%% E-bit in RFC 3588: only 3xxx. +is_result(RC, true, ?BASE) -> + 3000 =< RC andalso RC < 4000; + +%% E-bit in RFC 6733: 3xxx or 5xxx. +is_result(RC, true, _) -> + 3000 =< RC andalso RC < 4000 + orelse + 5000 =< RC andalso RC < 6000. + +irc(_, _, _, undefined) -> + false; + +irc(TPid, Hdr, Dir, Ctr) -> + incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}). + +%% incr/2 + +incr(TPid, Counter) -> + diameter_stats:incr(Counter, TPid, 1). + +%% rc_counter/2 + +%% RFC 3588, 7.6: +%% +%% All Diameter answer messages defined in vendor-specific +%% applications MUST include either one Result-Code AVP or one +%% Experimental-Result AVP. +%% +%% Maintain statistics assuming one or the other, not both, which is +%% surely the intent of the RFC. + +rc_counter(Dict, Rec, undefined) -> + rcc(get_avp_value(Dict, 'Experimental-Result', Rec)); +rc_counter(_, _, RC) -> + {'Result-Code', RC}. + +%% Outgoing answers may be in any of the forms messages can be sent +%% in. Incoming messages will be records. We're assuming here that the +%% arity of the result code AVP's is 0 or 1. + +rcc([{_,_,N} = T | _]) + when is_integer(N) -> + T; +rcc({_,_,N} = T) + when is_integer(N) -> + T; +rcc(_) -> + undefined. + +%% Extract the first good looking integer. There's no guarantee +%% that what we're looking for has arity 1. +int([N|_]) + when is_integer(N) -> + N; +int(N) + when is_integer(N) -> + N; +int(_) -> + undefined. + +-spec x(any(), atom(), list()) -> no_return(). + +%% Warn and exit request process on errors in an incoming answer. +x(Reason, F, A) -> + diameter_lib:warning_report(Reason, {?MODULE, F, A}), + x(Reason). + +x(T) -> + exit(T). + +%% --------------------------------------------------------------------------- +%% # send_request/4 +%% +%% Handle an outgoing Diameter request. +%% --------------------------------------------------------------------------- + +send_request(SvcName, AppOrAlias, Msg, Options) + when is_list(Options) -> + Rec = make_options(Options), + Ref = make_ref(), + Caller = {self(), Ref}, + ReqF = fun() -> + exit({Ref, send_R(SvcName, AppOrAlias, Msg, Rec, Caller)}) + end, + try spawn_monitor(ReqF) of + {_, MRef} -> + recv_A(MRef, Ref, Rec#options.detach, false) + catch + error: system_limit = E -> + {error, E} + end. +%% The R in send_R is because Diameter request are usually given short +%% names of the form XXR. (eg. CER, DWR, etc.) Similarly, answers have +%% names of the form XXA. + +%% Don't rely on gen_server:call/3 for the timeout handling since it +%% makes no guarantees about not leaving a reply message in the +%% mailbox if we catch its exit at timeout. It currently *can* do so, +%% which is also undocumented. + +recv_A(MRef, _, true, true) -> + erlang:demonitor(MRef, [flush]), + ok; + +recv_A(MRef, Ref, Detach, Sent) -> + receive + Ref -> %% send has been attempted + recv_A(MRef, Ref, Detach, true); + {'DOWN', MRef, process, _, Reason} -> + answer_rc(Reason, Ref, Sent) + end. + +%% send_R/5 has returned ... +answer_rc({Ref, Ans}, Ref, _) -> + Ans; + +%% ... or not. Note that failure/encode are documented return values. +answer_rc(_, _, Sent) -> + {error, choose(Sent, failure, encode)}. + +%% send_R/5 +%% +%% In the process spawned for the outgoing request. + +send_R(SvcName, AppOrAlias, Msg, Opts, Caller) -> + case pick_peer(SvcName, AppOrAlias, Msg, Opts) of + {{_,_,_} = Transport, Mask} -> + send_request(Transport, Mask, Msg, Opts, Caller, SvcName); + false -> + {error, no_connection}; + {error, _} = No -> + No + end. + +%% make_options/1 + +make_options(Options) -> + lists:foldl(fun mo/2, #options{}, Options). + +mo({timeout, T}, Rec) + when is_integer(T), 0 =< T -> + Rec#options{timeout = T}; + +mo({filter, F}, #options{filter = none} = Rec) -> + Rec#options{filter = F}; +mo({filter, F}, #options{filter = {all, Fs}} = Rec) -> + Rec#options{filter = {all, [F | Fs]}}; +mo({filter, F}, #options{filter = F0} = Rec) -> + Rec#options{filter = {all, [F0, F]}}; + +mo({extra, L}, #options{extra = X} = Rec) + when is_list(L) -> + Rec#options{extra = X ++ L}; + +mo(detach, Rec) -> + Rec#options{detach = true}; + +mo(T, _) -> + ?ERROR({invalid_option, T}). + +%% --------------------------------------------------------------------------- +%% # send_request/6 +%% --------------------------------------------------------------------------- + +%% Send an outgoing request in its dedicated process. +%% +%% Note that both encode of the outgoing request and of the received +%% answer happens in this process. It's also this process that replies +%% to the caller. The service process only handles the state-retaining +%% callbacks. +%% +%% The module field of the #diameter_app{} here includes any extra +%% arguments passed to diameter:call/4. + +send_request({TPid, Caps, App} + = Transport, + Mask, + Msg, + Opts, + Caller, + SvcName) -> + Pkt = make_prepare_packet(Mask, Msg), + + send_R(cb(App, prepare_request, [Pkt, SvcName, {TPid, Caps}]), + Pkt, + Transport, + Opts, + Caller, + SvcName, + []). + +send_R({send, Msg}, Pkt, Transport, Opts, Caller, SvcName, Fs) -> + send_R(make_request_packet(Msg, Pkt), + Transport, + Opts, + Caller, + SvcName, + Fs); + +send_R({discard, Reason} , _, _, _, _, _, _) -> + {error, Reason}; + +send_R(discard, _, _, _, _, _, _) -> + {error, discarded}; + +send_R({eval_packet, RC, F}, Pkt, T, Opts, Caller, SvcName, Fs) -> + send_R(RC, Pkt, T, Opts, Caller, SvcName, [F|Fs]); + +send_R(E, _, {_, _, App}, _, _, _, _) -> + ?ERROR({invalid_return, E, prepare_request, App}). + +%% make_prepare_packet/2 +%% +%% Turn an outgoing request as passed to call/4 into a diameter_packet +%% record in preparation for a prepare_request callback. + +make_prepare_packet(_, Bin) + when is_binary(Bin) -> + #diameter_packet{header = diameter_codec:decode_header(Bin), + bin = Bin}; + +make_prepare_packet(Mask, #diameter_packet{msg = [#diameter_header{} = Hdr + | Avps]} + = Pkt) -> + Pkt#diameter_packet{msg = [make_prepare_header(Mask, Hdr) | Avps]}; + +make_prepare_packet(Mask, #diameter_packet{header = Hdr} = Pkt) -> + Pkt#diameter_packet{header = make_prepare_header(Mask, Hdr)}; + +make_prepare_packet(Mask, Msg) -> + make_prepare_packet(Mask, #diameter_packet{msg = Msg}). + +%% make_prepare_header/2 + +make_prepare_header(Mask, undefined) -> + Seq = diameter_session:sequence(Mask), + make_prepare_header(#diameter_header{end_to_end_id = Seq, + hop_by_hop_id = Seq}); + +make_prepare_header(Mask, #diameter_header{end_to_end_id = undefined, + hop_by_hop_id = undefined} + = H) -> + Seq = diameter_session:sequence(Mask), + make_prepare_header(H#diameter_header{end_to_end_id = Seq, + hop_by_hop_id = Seq}); + +make_prepare_header(Mask, #diameter_header{end_to_end_id = undefined} = H) -> + Seq = diameter_session:sequence(Mask), + make_prepare_header(H#diameter_header{end_to_end_id = Seq}); + +make_prepare_header(Mask, #diameter_header{hop_by_hop_id = undefined} = H) -> + Seq = diameter_session:sequence(Mask), + make_prepare_header(H#diameter_header{hop_by_hop_id = Seq}); + +make_prepare_header(_, Hdr) -> + make_prepare_header(Hdr). + +%% make_prepare_header/1 + +make_prepare_header(#diameter_header{version = undefined} = Hdr) -> + make_prepare_header(Hdr#diameter_header{version = ?DIAMETER_VERSION}); + +make_prepare_header(#diameter_header{} = Hdr) -> + Hdr; + +make_prepare_header(T) -> + ?ERROR({invalid_header, T}). + +%% make_request_packet/2 +%% +%% Reconstruct a diameter_packet from the return value of +%% prepare_request or prepare_retransmit callback. + +make_request_packet(Bin, _) + when is_binary(Bin) -> + make_prepare_packet(false, Bin); + +make_request_packet(#diameter_packet{msg = [#diameter_header{} | _]} + = Pkt, + _) -> + Pkt; + +%% Returning a diameter_packet with no header from a prepare_request +%% or prepare_retransmit callback retains the header passed into it. +%% This is primarily so that the end to end and hop by hop identifiers +%% are retained. +make_request_packet(#diameter_packet{header = Hdr} = Pkt, + #diameter_packet{header = Hdr0}) -> + Pkt#diameter_packet{header = fold_record(Hdr0, Hdr)}; + +make_request_packet(Msg, Pkt) -> + Pkt#diameter_packet{msg = Msg}. + +%% fold_record/2 + +fold_record(undefined, R) -> + R; +fold_record(Rec, R) -> + diameter_lib:fold_tuple(2, Rec, R). + +%% send_R/6 + +send_R(Pkt0, + {TPid, Caps, #diameter_app{dictionary = Dict} = App}, + Opts, + {Pid, Ref}, + SvcName, + Fs) -> + Pkt = encode(Dict, Pkt0, Fs), + + #options{timeout = Timeout} + = Opts, + + Req = #request{ref = Ref, + caller = Pid, + handler = self(), + transport = TPid, + caps = Caps, + packet = Pkt0}, + + try + TRef = send_request(TPid, Pkt, Req, SvcName, Timeout), + Pid ! Ref, %% tell caller a send has been attempted + handle_answer(SvcName, + App, + recv_A(Timeout, SvcName, App, Opts, {TRef, Req})) + after + erase_requests(Pkt) + end. + +%% recv_A/5 + +recv_A(Timeout, SvcName, App, Opts, {TRef, #request{ref = Ref} = Req}) -> + %% Matching on TRef below ensures we ignore messages that pertain + %% to a previous transport prior to failover. The answer message + %% includes the #request{} since it's not necessarily Req; that + %% is, from the last peer to which we've transmitted. + receive + {answer = A, Ref, Rq, Dict0, Pkt} -> %% Answer from peer + {A, Rq, Dict0, Pkt}; + {timeout = Reason, TRef, _} -> %% No timely reply + {error, Req, Reason}; + {failover, TRef} -> %% Service says peer has gone down + retransmit(pick_peer(SvcName, App, Req, Opts), + Req, + Opts, + SvcName, + Timeout) + end. + +%% handle_answer/3 + +handle_answer(SvcName, App, {error, Req, Reason}) -> + handle_error(App, Req, Reason, SvcName); + +handle_answer(SvcName, + #diameter_app{dictionary = Dict, + id = Id} + = App, + {answer, Req, Dict0, Pkt}) -> + Mod = dict(Dict, Dict0, Pkt), + handle_A(errors(Id, diameter_codec:decode(Mod, Pkt)), + SvcName, + Mod, + Dict0, + App, + Req). + +%% We don't really need to do a full decode if we're a relay and will +%% just resend with a new hop by hop identifier, but might a proxy +%% want to examine the answer? + +handle_A(Pkt, SvcName, Dict, Dict0, App, #request{transport = TPid} = Req) -> + try + incr(recv, Pkt, Dict, TPid, Dict0) %% count incoming result codes + of + _ -> answer(Pkt, SvcName, App, Req) + catch + exit: {invalid_error_bit, RC} -> + #diameter_packet{errors = Es} + = Pkt, + E = {5004, #diameter_avp{name = 'Result-Code', value = RC}}, + answer(Pkt#diameter_packet{errors = [E|Es]}, SvcName, App, Req) + end. + +answer(Pkt, + SvcName, + #diameter_app{module = ModX, + options = [{answer_errors, AE} | _]}, + Req) -> + a(Pkt, SvcName, ModX, AE, Req). + +a(#diameter_packet{errors = Es} + = Pkt, + SvcName, + ModX, + AE, + #request{transport = TPid, + caps = Caps, + packet = P}) + when [] == Es; + callback == AE -> + cb(ModX, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}]); + +a(Pkt, SvcName, _, report, Req) -> + x(errors, handle_answer, [SvcName, Req, Pkt]); + +a(Pkt, SvcName, _, discard, Req) -> + x({errors, handle_answer, [SvcName, Req, Pkt]}). + +%% Note that we don't check that the application id in the answer's +%% header is what we expect. (TODO: Does the rfc says anything about +%% this?) + +%% Note that failover starts a new timer and that expiry of an old +%% timer value is ignored. This means that an answer could be accepted +%% from a peer after timeout in the case of failover. + +retransmit({{_,_,App} = Transport, _Mask}, Req, Opts, SvcName, Timeout) -> + try retransmit(Transport, Req, SvcName, Timeout) of + T -> recv_A(Timeout, SvcName, App, Opts, T) + catch + ?FAILURE(Reason) -> {error, Req, Reason} + end; + +retransmit(_, Req, _, _, _) -> %% no alternate peer + {error, Req, failover}. + +%% pick_peer/4 + +%% Retransmission after failover: call-specific arguments have already +%% been appended in App. +pick_peer(SvcName, + App, + #request{packet = #diameter_packet{msg = Msg}}, + Opts) -> + pick_peer(SvcName, App, Msg, Opts#options{extra = []}); + +pick_peer(_, _, undefined, _) -> + false; + +pick_peer(SvcName, + AppOrAlias, + Msg, + #options{filter = Filter, extra = Xtra}) -> + diameter_service:pick_peer(SvcName, + AppOrAlias, + {fun(D) -> get_destination(D, Msg) end, + Filter, + Xtra}). + +%% handle_error/4 + +handle_error(App, + #request{packet = Pkt, + transport = TPid, + caps = Caps}, + Reason, + SvcName) -> + cb(App, handle_error, [Reason, msg(Pkt), SvcName, {TPid, Caps}]). + +msg(#diameter_packet{msg = undefined, bin = Bin}) -> + Bin; +msg(#diameter_packet{msg = Msg}) -> + Msg. + +%% encode/3 + +encode(Dict, Pkt, Fs) -> + P = encode(Dict, Pkt), + eval_packet(P, Fs), + P. + +%% encode/2 + +%% Note that prepare_request can return a diameter_packet containing a +%% header or transport_data. Even allow the returned record to contain +%% an encoded binary. This isn't the usual case and doesn't properly +%% support retransmission but is useful for test. + +%% A message to be encoded. +encode(Dict, #diameter_packet{bin = undefined} = Pkt) -> + diameter_codec:encode(Dict, Pkt); + +%% An encoded binary: just send. +encode(_, #diameter_packet{} = Pkt) -> + Pkt. + +%% send_request/5 + +send_request(TPid, #diameter_packet{bin = Bin} = Pkt, Req, _SvcName, Timeout) + when node() == node(TPid) -> + %% Store the outgoing request before sending to avoid a race with + %% reply reception. + TRef = store_request(TPid, Bin, Req, Timeout), + send(TPid, Pkt), + TRef; + +%% Send using a remote transport: spawn a process on the remote node +%% to relay the answer. +send_request(TPid, #diameter_packet{} = Pkt, Req, SvcName, Timeout) -> + TRef = erlang:start_timer(Timeout, self(), TPid), + T = {TPid, Pkt, Req, SvcName, Timeout, TRef}, + spawn(node(TPid), ?MODULE, send, [T]), + TRef. + +%% send/1 + +send({TPid, Pkt, #request{handler = Pid} = Req, SvcName, Timeout, TRef}) -> + Ref = send_request(TPid, + Pkt, + Req#request{handler = self()}, + SvcName, + Timeout), + Pid ! reref(receive T -> T end, Ref, TRef). + +reref({T, Ref, R}, Ref, TRef) -> + {T, TRef, R}; +reref(T, _, _) -> + T. + +%% send/2 + +send(Pid, Pkt) -> + Pid ! {send, Pkt}. + +%% retransmit/4 + +retransmit({TPid, Caps, App} + = Transport, + #request{packet = Pkt0} + = Req, + SvcName, + Timeout) -> + have_request(Pkt0, TPid) %% Don't failover to a peer we've + andalso ?THROW(timeout), %% already sent to. + + #diameter_packet{header = Hdr0} = Pkt0, + Hdr = Hdr0#diameter_header{is_retransmitted = true}, + Pkt = Pkt0#diameter_packet{header = Hdr}, + + retransmit(cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]), + Transport, + Req#request{packet = Pkt}, + SvcName, + Timeout, + []). + +retransmit({send, Msg}, + Transport, + #request{packet = Pkt} + = Req, + SvcName, + Timeout, + Fs) -> + resend_request(make_request_packet(Msg, Pkt), + Transport, + Req, + SvcName, + Timeout, + Fs); + +retransmit({discard, Reason}, _, _, _, _, _) -> + ?THROW(Reason); + +retransmit(discard, _, _, _, _, _) -> + ?THROW(discarded); + +retransmit({eval_packet, RC, F}, Transport, Req, SvcName, Timeout, Fs) -> + retransmit(RC, Transport, Req, SvcName, Timeout, [F|Fs]); + +retransmit(T, {_, _, App}, _, _, _, _) -> + ?ERROR({invalid_return, T, prepare_retransmit, App}). + +resend_request(Pkt0, + {TPid, Caps, #diameter_app{dictionary = Dict}}, + Req0, + SvcName, + Tmo, + Fs) -> + Pkt = encode(Dict, Pkt0, Fs), + + Req = Req0#request{transport = TPid, + packet = Pkt0, + caps = Caps}, + + ?LOG(retransmission, Req), + TRef = send_request(TPid, Pkt, Req, SvcName, Tmo), + {TRef, Req}. + +%% store_request/4 + +store_request(TPid, Bin, Req, Timeout) -> + Seqs = diameter_codec:sequence_numbers(Bin), + TRef = erlang:start_timer(Timeout, self(), timeout), + ets:insert(?REQUEST_TABLE, {Seqs, Req, TRef}), + ets:member(?REQUEST_TABLE, TPid) + orelse (self() ! {failover, TRef}), %% failover/1 may have missed + TRef. + +%% lookup_request/2 + +lookup_request(Msg, TPid) -> + Seqs = diameter_codec:sequence_numbers(Msg), + Spec = [{{Seqs, #request{transport = TPid, _ = '_'}, '_'}, + [], + ['$_']}], + case ets:select(?REQUEST_TABLE, Spec) of + [{_, Req, _}] -> + Req; + [] -> + false + end. + +%% erase_requests/1 + +erase_requests(Pkt) -> + ets:delete(?REQUEST_TABLE, diameter_codec:sequence_numbers(Pkt)). + +%% match_requests/1 + +match_requests(TPid) -> + Pat = {'_', #request{transport = TPid, _ = '_'}, '_'}, + ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}]). + +%% have_request/2 + +have_request(Pkt, TPid) -> + Seqs = diameter_codec:sequence_numbers(Pkt), + Pat = {Seqs, #request{transport = TPid, _ = '_'}, '_'}, + '$end_of_table' /= ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}], 1). + +%% --------------------------------------------------------------------------- +%% # failover/1-2 +%% --------------------------------------------------------------------------- + +failover(TPid) + when is_pid(TPid) -> + lists:foreach(fun failover/1, match_requests(TPid)); +%% Note that a request process can store its request after failover +%% notifications are sent here: store_request/4 sends the notification +%% in that case. + +%% Failover as a consequence of request_peer_down/1: inform the +%% request process. +failover({_, Req, TRef}) -> + #request{handler = Pid, + packet = #diameter_packet{msg = M}} + = Req, + M /= undefined andalso (Pid ! {failover, TRef}). +%% Failover is not performed when msg = binary() since sending +%% pre-encoded binaries is only partially supported. (Mostly for +%% test.) + +%% get_destination/2 + +get_destination(Dict, Msg) -> + [str(get_avp_value(Dict, D, Msg)) || D <- ['Destination-Realm', + 'Destination-Host']]. + +%% This is not entirely correct. The avp could have an arity 1, in +%% which case an empty list is a DiameterIdentity of length 0 rather +%% than the list of no values we treat it as by mapping to undefined. +%% This behaviour is documented. +str([]) -> + undefined; +str(T) -> + T. + +%% get_avp_value/3 +%% +%% Find an AVP in a message of one of three forms: +%% +%% - a message record (as generated from a .dia spec) or +%% - a list of an atom message name followed by 2-tuple, avp name/value pairs. +%% - a list of a #diameter_header{} followed by #diameter_avp{} records, +%% +%% In the first two forms a dictionary module is used at encode to +%% identify the type of the AVP and its arity in the message in +%% question. The third form allows messages to be sent as is, without +%% a dictionary, which is needed in the case of relay agents, for one. + +%% Messages will be header/avps list as a relay and the only AVP's we +%% look for are in the common dictionary. This is required since the +%% relay dictionary doesn't inherit the common dictionary (which maybe +%% it should). +get_avp_value(?RELAY, Name, Msg) -> + get_avp_value(?BASE, Name, Msg); + +%% Message sent as a header/avps list, probably a relay case but not +%% necessarily. +get_avp_value(Dict, Name, [#diameter_header{} | Avps]) -> + try + {Code, _, VId} = Dict:avp_header(Name), + [A|_] = lists:dropwhile(fun(#diameter_avp{code = C, vendor_id = V}) -> + C /= Code orelse V /= VId + end, + Avps), + avp_decode(Dict, Name, A) + catch + error: _ -> + undefined + end; + +%% Outgoing message as a name/values list. +get_avp_value(_, Name, [_MsgName | Avps]) -> + case lists:keyfind(Name, 1, Avps) of + {_, V} -> + V; + _ -> + undefined + end; + +%% Message is typically a record but not necessarily. +get_avp_value(Dict, Name, Rec) -> + try + Dict:'#get-'(Name, Rec) + catch + error:_ -> + undefined + end. + +avp_decode(Dict, Name, #diameter_avp{value = undefined, + data = Bin}) -> + Dict:avp(decode, Bin, Name); +avp_decode(_, _, #diameter_avp{value = V}) -> + V. + +cb(#diameter_app{module = [_|_] = M}, F, A) -> + eval(M, F, A); +cb([_|_] = M, F, A) -> + eval(M, F, A). + +eval([M|X], F, A) -> + apply(M, F, A ++ X). + +choose(true, X, _) -> X; +choose(false, _, X) -> X. diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl index a5429c967c..073a415d10 100644 --- a/lib/diameter/src/base/diameter_watchdog.erl +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -45,6 +45,8 @@ -define(DEFAULT_TW_INIT, 30000). %% RFC 3539 ch 3.4.1 -define(NOMASK, {0,32}). %% default sequence mask +-define(BASE, ?DIAMETER_DICT_COMMON). + -record(watchdog, {%% PCB - Peer Control Block; see RFC 3539, Appendix A status = initial :: initial | okay | suspect | down | reopen, @@ -56,33 +58,36 @@ %% end PCB parent = self() :: pid(), %% service process transport :: pid() | undefined, %% peer_fsm process - tref :: reference(), %% reference for current watchdog timer - message_data, %% term passed into diameter_service with message + tref :: reference(), %% reference for current watchdog timer + dictionary :: module(), %% common dictionary + receive_data :: term(), + %% term passed into diameter_service with incoming message sequence :: diameter:sequence(), %% mask restrict :: {diameter:restriction(), boolean()}, shutdown = false :: boolean()}). +%% --------------------------------------------------------------------------- %% start/2 %% %% Start a monitor before the watchdog is allowed to proceed to ensure %% that a failed capabilities exchange produces the desired exit %% reason. +%% --------------------------------------------------------------------------- --spec start(Type, {RecvData, [Opt], SvcName, SvcOpts, #diameter_service{}}) +-spec start(Type, {RecvData, [Opt], SvcOpts, #diameter_service{}}) -> {reference(), pid()} when Type :: {connect|accept, diameter:transport_ref()}, RecvData :: term(), Opt :: diameter:transport_opt(), - SvcOpts :: [diameter:service_opt()], - SvcName :: diameter:service_name(). + SvcOpts :: [diameter:service_opt()]. start({_,_} = Type, T) -> - Ref = make_ref(), - {ok, Pid} = diameter_watchdog_sup:start_child({Ref, {Type, self(), T}}), + Ack = make_ref(), + {ok, Pid} = diameter_watchdog_sup:start_child({Ack, Type, self(), T}), try {erlang:monitor(process, Pid), Pid} after - Pid ! Ref + send(Pid, Ack) end. start_link(T) -> @@ -101,39 +106,95 @@ init(T) -> proc_lib:init_ack({ok, self()}), gen_server:enter_loop(?MODULE, [], i(T)). -i({Ref, {_, Pid, _} = T}) -> - MRef = erlang:monitor(process, Pid), - receive - Ref -> - make_state(T); - {'DOWN', MRef, process, _, _} = D -> - exit({shutdown, D}) - end. - -make_state({T, Pid, {RecvData, - Opts, - SvcName, - SvcOpts, - #diameter_service{applications = Apps, - capabilities = Caps} - = Svc}}) -> +i({Ack, T, Pid, {RecvData, + Opts, + SvcOpts, + #diameter_service{applications = Apps, + capabilities = Caps} + = Svc}}) -> + erlang:monitor(process, Pid), + wait(Ack, Pid), random:seed(now()), putr(restart, {T, Opts, Svc}), %% save seeing it in trace putr(dwr, dwr(Caps)), %% {_,_} = Mask = proplists:get_value(sequence, SvcOpts), Restrict = proplists:get_value(restrict_connections, SvcOpts), Nodes = restrict_nodes(Restrict), + Dict0 = common_dictionary(Apps), #watchdog{parent = Pid, - transport = monitor(diameter_peer_fsm:start(T, - Opts, - {Mask, Nodes, Svc})), + transport = start(T, Opts, Mask, Nodes, Dict0, Svc), tw = proplists:get_value(watchdog_timer, Opts, ?DEFAULT_TW_INIT), - message_data = {RecvData, SvcName, Apps, Mask}, + receive_data = RecvData, + dictionary = Dict0, sequence = Mask, restrict = {Restrict, lists:member(node(), Nodes)}}. +wait(Ref, Pid) -> + receive + Ref -> + ok; + {'DOWN', _, process, Pid, _} = D -> + exit({shutdown, D}) + end. + +%% start/5 + +start(T, Opts, Mask, Nodes, Dict0, Svc) -> + {_MRef, Pid} + = diameter_peer_fsm:start(T, Opts, {Mask, Nodes, Dict0, Svc}), + Pid. + +%% common_dictionary/1 +%% +%% Determine the dictionary of the Diameter common application with +%% Application Id 0. Fail on config errors. + +common_dictionary(Apps) -> + case + orddict:fold(fun dict0/3, + false, + lists:foldl(fun(#diameter_app{dictionary = M}, D) -> + orddict:append(M:id(), M, D) + end, + orddict:new(), + Apps)) + of + {value, Mod} -> + Mod; + false -> + %% A transport should configure a common dictionary but + %% don't require it. Not configuring a common dictionary + %% means a user won't be able either send of receive + %% messages in the common dictionary: incoming request + %% will be answered with 3007 and outgoing requests cannot + %% be sent. The dictionary returned here is oly used for + %% messages diameter sends and receives: CER/CEA, DPR/DPA + %% and DWR/DWA. + ?BASE + end. + +%% Each application should be represented by a single dictionary. +dict0(Id, [_,_|_] = Ms, _) -> + config_error({multiple_dictionaries, Ms, {application_id, Id}}); + +%% An explicit common dictionary. +dict0(?APP_ID_COMMON, [Mod], _) -> + {value, Mod}; + +%% A pure relay, in which case the common application is implicit. +%% This uses the fact that the common application will already have +%% been folded. +dict0(?APP_ID_RELAY, _, false) -> + {value, ?BASE}; + +dict0(_, _, Acc) -> + Acc. + +config_error(T) -> + ?ERROR({configuration_error, T}). + %% handle_call/3 handle_call(_, _, State) -> @@ -151,41 +212,59 @@ handle_info(T, #watchdog{} = State) -> ok -> {noreply, State}; #watchdog{} = S -> - event(State, S), + close(T, State), %% service expects 'close' message + event(T, State, S), %% before 'watchdog' {noreply, S}; stop -> ?LOG(stop, T), - event(State, State#watchdog{status = down}), + event(T, State, State#watchdog{status = down}), {stop, {shutdown, T}, State} - end; + end. -handle_info(T, S) -> - handle_info(T, upgrade(S)). +close({'DOWN', _, process, TPid, {shutdown, Reason}}, + #watchdog{transport = TPid, + parent = Pid}) -> + send(Pid, {close, self(), Reason}); -upgrade(S) -> - #watchdog{} = list_to_tuple(tuple_to_list(S) - ++ [?NOMASK, {nodes, true}, false]). +close(_, _) -> + ok. -event(#watchdog{status = T}, #watchdog{status = T}) -> +event(_, #watchdog{status = T}, #watchdog{status = T}) -> ok; -event(#watchdog{transport = undefined}, #watchdog{transport = undefined}) -> +event(_, #watchdog{transport = undefined}, #watchdog{transport = undefined}) -> ok; -event(#watchdog{status = From, transport = F, parent = Pid}, +event(Msg, + #watchdog{status = From, transport = F, parent = Pid}, #watchdog{status = To, transport = T}) -> - E = {tpid(F,T), From, To}, - notify(Pid, E), + TPid = tpid(F,T), + E = {[TPid | data(Msg, TPid, From, To)], From, To}, + send(Pid, {watchdog, self(), E}), ?LOG(transition, {self(), E}). +data(Msg, TPid, reopen, okay) -> + {recv, TPid, 'DWA', _Pkt} = Msg, %% assert + {TPid, T} = eraser(open), + [T]; + +data({open, TPid, _Hosts, T}, TPid, _From, To) + when To == okay; + To == reopen -> + [T]; + +data(_, _, _, _) -> + []. + tpid(_, Pid) when is_pid(Pid) -> Pid; + tpid(Pid, _) -> Pid. -notify(Pid, E) -> - Pid ! {watchdog, self(), E}. +send(Pid, T) -> + Pid ! T. %% terminate/2 @@ -215,15 +294,13 @@ transition(close, #watchdog{}) -> ok; %% Service is asking for the peer to be taken down gracefully. -transition({shutdown, Pid}, #watchdog{parent = Pid, - transport = undefined, - status = S}) -> - down = S, %% sanity check +transition({shutdown, Pid, _}, #watchdog{parent = Pid, + transport = undefined}) -> stop; -transition({shutdown = T, Pid}, #watchdog{parent = Pid, - transport = TPid} - = S) -> - TPid ! {T, self()}, +transition({shutdown = T, Pid, Reason}, #watchdog{parent = Pid, + transport = TPid} + = S) -> + send(TPid, {T, self(), Reason}), S#watchdog{shutdown = true}; %% Parent process has died, @@ -234,13 +311,9 @@ transition({'DOWN', _, process, Pid, _Reason}, %% Transport has accepted a connection. transition({accepted = T, TPid}, #watchdog{transport = TPid, parent = Pid}) -> - Pid ! {T, self(), TPid}, + send(Pid, {T, self(), TPid}), ok; -%% Transport is telling us that its impending death isn't failure. -transition({close, TPid, _Reason}, #watchdog{transport = TPid}) -> - stop; - %% STATE Event Actions New State %% ===== ------ ------- ---------- %% INITIAL Connection up SetWatchdog() OKAY @@ -255,15 +328,13 @@ transition({close, TPid, _Reason}, #watchdog{transport = TPid}) -> %% know the identity of the peer (ie. now) that we know that we're in %% state down rather than initial. -transition({open, TPid, Hosts, T} = Open, +transition({open, TPid, Hosts, _} = Open, #watchdog{transport = TPid, status = initial, - parent = Pid, restrict = {_, R}} = S) -> case okay(getr(restart), Hosts, R) of okay -> - open(Pid, {TPid, T}), set_watchdog(S#watchdog{status = okay}); reopen -> transition(Open, S#watchdog{status = down}) @@ -274,17 +345,15 @@ transition({open, TPid, Hosts, T} = Open, %% SetWatchdog() %% Pending = TRUE REOPEN -transition({open = P, TPid, _Hosts, T}, +transition({open = Key, TPid, _Hosts, T}, #watchdog{transport = TPid, - parent = Pid, status = down} = S) -> %% Store the info we need to notify the parent to reopen the %% connection after the requisite DWA's are received, at which %% time we eraser(open). The reopen message is a later addition, %% to communicate the new capabilities as soon as they're known. - putr(P, {TPid, T}), - Pid ! {reopen, self(), {TPid, T}}, + putr(Key, {TPid, T}), set_watchdog(send_watchdog(S#watchdog{status = reopen, num_dwa = 0})); @@ -296,26 +365,18 @@ transition({open = P, TPid, _Hosts, T}, %% REOPEN Connection down CloseConnection() %% SetWatchdog() DOWN -transition({'DOWN', _, process, TPid, _}, +transition({'DOWN', _, process, TPid, _Reason}, #watchdog{transport = TPid, - status = S, - shutdown = D}) - when S == initial; - D -> + shutdown = true}) -> stop; -transition({'DOWN', _, process, TPid, _}, - #watchdog{transport = TPid} +transition({'DOWN', _, process, TPid, _Reason}, + #watchdog{transport = TPid, + status = T} = S) -> - failover(S), - close(S), - set_watchdog(S#watchdog{status = down, + set_watchdog(S#watchdog{status = case T of initial -> T; _ -> down end, pending = false, transport = undefined}); -%% Any outstanding pending (or other messages from the transport) will -%% have arrived before 'DOWN' since the message comes from the same -%% process. Note that we could also get this message in the initial -%% state. %% Incoming message. transition({recv, TPid, Name, Pkt}, #watchdog{transport = TPid} = S) -> @@ -331,15 +392,11 @@ transition({timeout, _, tw}, #watchdog{}) -> %% State query. transition({state, Pid}, #watchdog{status = S}) -> - Pid ! {self(), S}, + send(Pid, {self(), S}), ok. %% =========================================================================== -monitor(Pid) -> - erlang:monitor(process, Pid), - Pid. - putr(Key, Val) -> put({?MODULE, Key}, Val). @@ -349,16 +406,16 @@ getr(Key) -> eraser(Key) -> erase({?MODULE, Key}). -%% encode/2 +%% encode/3 -encode(Msg, Mask) -> +encode(Msg, Mask, Dict) -> Seq = diameter_session:sequence(Mask), Hdr = #diameter_header{version = ?DIAMETER_VERSION, end_to_end_id = Seq, hop_by_hop_id = Seq}, Pkt = #diameter_packet{header = Hdr, msg = Msg}, - #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Pkt), + #diameter_packet{bin = Bin} = diameter_codec:encode(Dict, Pkt), Bin. %% okay/3 @@ -386,7 +443,7 @@ okay([{_,P}]) -> %% ... or it has. okay(C) -> - [_|_] = [P ! close || {_,P} <- C, self() /= P], + [_|_] = [send(P, close) || {_,P} <- C, self() /= P], reopen. %% set_watchdog/1 @@ -408,36 +465,14 @@ tw(T) tw({M,F,A}) -> apply(M,F,A). -%% open/2 - -open(Pid, {_,_} = T) -> - Pid ! {connection_up, self(), T}. - -%% failover/1 - -failover(#watchdog{status = okay, - parent = Pid}) -> - Pid ! {connection_down, self()}; - -failover(_) -> - ok. - -%% close/1 - -close(#watchdog{status = down}) -> - ok; - -close(#watchdog{parent = Pid}) -> - {{T, _}, _, _} = getr(restart), - T == accept andalso (Pid ! {close, self()}). - %% send_watchdog/1 send_watchdog(#watchdog{pending = false, transport = TPid, + dictionary = Dict0, sequence = Mask} = S) -> - TPid ! {send, encode(getr(dwr), Mask)}, + send(TPid, {send, encode(getr(dwr), Mask, Dict0)}), ?LOG(send, 'DWR'), S#watchdog{pending = true}. @@ -465,8 +500,9 @@ rcv(N, _, _) false; rcv(_, Pkt, #watchdog{transport = TPid, - message_data = T}) -> - diameter_service:receive_message(TPid, Pkt, T). + dictionary = Dict0, + receive_data = T}) -> + diameter_traffic:receive_message(TPid, Pkt, Dict0, T). throwaway(S) -> throw({?MODULE, throwaway, S}). @@ -518,12 +554,10 @@ rcv(_, #watchdog{status = okay} = S) -> %% SetWatchdog() OKAY rcv('DWA', #watchdog{status = suspect} = S) -> - failback(S), set_watchdog(S#watchdog{status = okay, pending = false}); rcv(_, #watchdog{status = suspect} = S) -> - failback(S), set_watchdog(S#watchdog{status = okay}); %% REOPEN Receive DWA & Pending = FALSE @@ -531,10 +565,8 @@ rcv(_, #watchdog{status = suspect} = S) -> %% Failback() OKAY rcv('DWA', #watchdog{status = reopen, - num_dwa = 2 = N, - parent = Pid} + num_dwa = 2 = N} = S) -> - open(Pid, eraser(open)), S#watchdog{status = okay, num_dwa = N+1, pending = false}; @@ -553,11 +585,6 @@ rcv('DWA', #watchdog{status = reopen, rcv(_, #watchdog{status = reopen} = S) -> throwaway(S). -%% failback/1 - -failback(#watchdog{parent = Pid}) -> - Pid ! {connection_up, self()}. - %% timeout/1 %% %% The caller sets the watchdog on the return value. @@ -582,7 +609,6 @@ timeout(#watchdog{status = T, timeout(#watchdog{status = okay, pending = true} = S) -> - failover(S), S#watchdog{status = suspect}; %% SUSPECT Timer expires CloseConnection() @@ -599,7 +625,6 @@ timeout(#watchdog{status = T, when T == suspect; T == reopen, P, N < 0 -> exit(TPid, {shutdown, watchdog_timeout}), - close(S), S#watchdog{status = down}; %% REOPEN Timer expires & NumDWA = -1 @@ -633,7 +658,9 @@ timeout(#watchdog{status = reopen, %% process has died. We only need to handle state down since we start %% the first watchdog when transitioning out of initial. -timeout(#watchdog{status = down} = S) -> +timeout(#watchdog{status = T} = S) + when T == initial; + T == down -> restart(S). %% restart/1 @@ -655,15 +682,15 @@ restart(S) -> %% state down rather then initial when receiving notification of an %% open connection. -restart({{connect, _} = T, Opts, Svc}, #watchdog{parent = Pid, - sequence = Mask, - restrict = {R,_}} - = S) -> - Pid ! {reconnect, self()}, +restart({{connect, _} = T, Opts, Svc}, + #watchdog{parent = Pid, + sequence = Mask, + restrict = {R,_}, + dictionary = Dict0} + = S) -> + send(Pid, {reconnect, self()}), Nodes = restrict_nodes(R), - S#watchdog{transport = monitor(diameter_peer_fsm:start(T, - Opts, - {Mask, Nodes, Svc})), + S#watchdog{transport = start(T, Opts, Mask, Nodes, Dict0, Svc), restrict = {R, lists:member(node(), Nodes)}}; %% No restriction on the number of connections to the same peer: just diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl index 1e31c40afe..80036879ea 100644 --- a/lib/diameter/src/compiler/diameter_codegen.erl +++ b/lib/diameter/src/compiler/diameter_codegen.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -128,8 +128,8 @@ gen(hrl, Spec, Mod, Path) -> gen(erl, Spec, Mod, Path) -> Forms = [{?attribute, module, Mod}, - {?attribute, compile, [{parse_transform, diameter_exprecs}]}, - {?attribute, compile, [{parse_transform, diameter_nowarn}]}, + {?attribute, compile, {parse_transform, diameter_exprecs}}, + {?attribute, compile, nowarn_unused_function}, {?attribute, export, [{name, 0}, {id, 0}, {vendor_id, 0}, diff --git a/lib/diameter/src/compiler/diameter_exprecs.erl b/lib/diameter/src/compiler/diameter_exprecs.erl index 191f53f29d..cc8458efa1 100644 --- a/lib/diameter/src/compiler/diameter_exprecs.erl +++ b/lib/diameter/src/compiler/diameter_exprecs.erl @@ -18,7 +18,7 @@ %% %% -%% Parse transform for generating record access functions +%% Parse transform for generating record access functions. %% %% This parse transform can be used to reduce compile-time %% dependencies in large systems. @@ -39,21 +39,21 @@ %% %% export_records([RecName, ...]) %% -%% causes this transform to lay out access functions for the exported -%% records: +%% causes this transform to insert functions for the exported records: %% %% -module(foo) %% -compile({parse_transform, diameter_exprecs}). %% %% -record(r, {a, b, c}). -%% -export_records([a]). +%% -export_records([r]). %% %% -export(['#info-'/1, '#info-'/2, -%% '#new-'/1, '#new-'/2, -%% '#get-'/2, '#set-'/2, -%% '#new-a'/0, '#new-a'/1, -%% '#get-a'/2, '#set-a'/2, -%% '#info-a'/1]). +%% '#new-'/1, '#new-'/2, +%% '#get-'/1', '#get-'/2, +%% '#set-'/2, +%% '#new-r'/0, '#new-r'/1, +%% '#get-r'/2, '#set-r'/2, +%% '#info-r'/1]). %% %% '#info-'(RecName) -> %% '#info-'(RecName, fields). @@ -61,15 +61,23 @@ %% '#info-'(r, Info) -> %% '#info-r'(Info). %% +%% '#new-'([r | Vals]) -> '#new-r'(Vals); %% '#new-'(r) -> #r{}. -%% '#new-'(r, Vals) -> '#new-r'(Vals) +%% +%% '#new-'(r, Vals) -> '#new-r'(Vals). %% %% '#new-r'() -> #r{}. %% '#new-r'(Vals) -> '#set-r'(Vals, #r{}). %% +%% '#get-'(#r{} = Rec) -> +%% [r | '#get-r'(Rec)]. +%% %% '#get-'(Attrs, #r{} = Rec) -> %% '#get-r'(Attrs, Rec). %% +%% '#get-r'(#r{} = Rec) -> +%% lists:zip([a,b,c], tl(tuple_to_list(Rec))). +%% %% '#get-r'(Attrs, Rec) when is_list(Attrs) -> %% ['#get-r'(A, Rec) || A <- Attrs]; %% '#get-r'(a, Rec) -> Rec#r.a; @@ -116,6 +124,7 @@ a_export(Exports) -> {fname(info), 2}, {fname(new), 1}, {fname(new), 2}, + {fname(get), 1}, {fname(get), 2}, {fname(set), 2} | lists:flatmap(fun export/1, Exports)]}. @@ -124,6 +133,7 @@ export(Rname) -> New = fname(new, Rname), [{New, 0}, {New, 1}, + {fname(get, Rname), 1}, {fname(get, Rname), 2}, {fname(set, Rname), 2}, {fname(info, Rname), 1}]. @@ -135,6 +145,7 @@ f_accessors(Es, Rs) -> '#info-/2'(Es), '#new-/1'(Es), '#new-/2'(Es), + '#get-/1'(Es), '#get-/2'(Es), '#set-/2'(Es) | lists:flatmap(fun(N) -> accessors(N, fields(N, Rs)) end, Es)]. @@ -142,6 +153,7 @@ f_accessors(Es, Rs) -> accessors(Rname, Fields) -> ['#new-X/0'(Rname), '#new-X/1'(Rname), + '#get-X/1'(Rname, Fields), '#get-X/2'(Rname, Fields), '#set-X/2'(Rname, Fields), '#info-X/1'(Rname, Fields)]. @@ -183,12 +195,15 @@ fname(Op, Rname) -> '#new-/1'(Exports) -> {?function, fname(new), 1, - lists:map(fun 'new-'/1, Exports) ++ [?BADARG(1)]}. + lists:flatmap(fun 'new-'/1, Exports) ++ [?BADARG(1)]}. 'new-'(R) -> - {?clause, [?ATOM(R)], - [], - [{?record, R, []}]}. + [{?clause, [?ATOM(R)], + [], + [{?record, R, []}]}, + {?clause, [{?cons, ?ATOM(R), ?VAR('Vals')}], + [], + [?CALL(fname(new, R), [?VAR('Vals')])]}]. '#new-/2'(Exports) -> {?function, fname(new), 2, @@ -199,6 +214,15 @@ fname(Op, Rname) -> [], [?CALL(fname(new, R), [?VAR('Vals')])]}. +'#get-/1'(Exports) -> + {?function, fname(get), 1, + lists:map(fun 'get--'/1, Exports) ++ [?BADARG(1)]}. + +'get--'(R) -> + {?clause, [{?match, {?record, R, []}, ?VAR('Rec')}], + [], + [{?cons, ?ATOM(R), ?CALL(fname(get, R), [?VAR('Rec')])}]}. + '#get-/2'(Exports) -> {?function, fname(get), 2, lists:map(fun 'get-'/1, Exports) ++ [?BADARG(2)]}. @@ -245,6 +269,14 @@ fname(Op, Rname) -> [{?record, ?VAR('Rec'), Rname, [{?record_field, ?ATOM(Attr), ?VAR('V')}]}]}. +'#get-X/1'(Rname, Fields) -> + FName = fname(get, Rname), + Values = ?CALL(tl, [?CALL(tuple_to_list, [?VAR('Rec')])]), + {?function, FName, 1, + [{?clause, [?VAR('Rec')], + [], + [?APPLY(lists, zip, [?TERM(Fields), Values])]}]}. + '#get-X/2'(Rname, Fields) -> FName = fname(get, Rname), {?function, FName, 2, diff --git a/lib/diameter/src/compiler/diameter_forms.hrl b/lib/diameter/src/compiler/diameter_forms.hrl index 4cd86c32aa..1a0f3492ea 100644 --- a/lib/diameter/src/compiler/diameter_forms.hrl +++ b/lib/diameter/src/compiler/diameter_forms.hrl @@ -36,6 +36,7 @@ -define(clause, ?F(clause)). -define(function, ?F(function)). -define(call, ?F(call)). +-define(cons, ?F(cons)). -define('fun', ?F('fun')). -define(generate, ?F(generate)). -define(lc, ?F(lc)). diff --git a/lib/diameter/src/compiler/diameter_nowarn.erl b/lib/diameter/src/compiler/diameter_nowarn.erl deleted file mode 100644 index 6c17af6563..0000000000 --- a/lib/diameter/src/compiler/diameter_nowarn.erl +++ /dev/null @@ -1,41 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. 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% -%% - -%% -%% A parse transform to work around dialyzer currently not -%% understanding nowarn_unused_function except on individual -%% functions. The include of diameter_gen.hrl by generated dictionary -%% modules contains code that may not be called depending on the -%% dictionary. (The relay dictionary for example.) -%% -%% Even called functions may contain cases that aren't used for a -%% particular dictionary. This also causes dialyzer to complain but -%% there's no way to silence it in this case. -%% - --module(diameter_nowarn). - --export([parse_transform/2]). - -parse_transform(Forms, _Options) -> - [{attribute, ?LINE, compile, {nowarn_unused_function, {F,A}}} - || {function, _, F, A, _} <- Forms] - ++ Forms. -%% Note that dialyzer also doesn't understand {nowarn_unused_function, FAs} -%% with FAs a list of tuples. diff --git a/lib/diameter/src/dict/acct_rfc6733.dia b/lib/diameter/src/dict/acct_rfc6733.dia new file mode 100644 index 0000000000..7d6d11a71e --- /dev/null +++ b/lib/diameter/src/dict/acct_rfc6733.dia @@ -0,0 +1,72 @@ +;; +;; %CopyrightBegin% +;; +;; Copyright Ericsson AB 2013. 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% +;; + +@id 3 +@name diameter_gen_acct_rfc6733 +@prefix diameter_base_accounting +@vendor 0 IETF + +@inherits diameter_gen_base_rfc6733 + +@messages + + ACR ::= < Diameter Header: 271, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Destination-Host ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + ACA ::= < Diameter Header: 271, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + [ Failed-AVP ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ AVP ] diff --git a/lib/diameter/src/dict/base_rfc6733.dia b/lib/diameter/src/dict/base_rfc6733.dia new file mode 100644 index 0000000000..e1d1f18d86 --- /dev/null +++ b/lib/diameter/src/dict/base_rfc6733.dia @@ -0,0 +1,415 @@ +;; +;; %CopyrightBegin% +;; +;; Copyright Ericsson AB 2013. 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% +;; + +@id 0 +@name diameter_gen_base_rfc6733 +@prefix diameter_base +@vendor 0 IETF + +@avp_types + + Acct-Interim-Interval 85 Unsigned32 M + Accounting-Realtime-Required 483 Enumerated M + Acct-Multi-Session-Id 50 UTF8String M + Accounting-Record-Number 485 Unsigned32 M + Accounting-Record-Type 480 Enumerated M + Acct-Session-Id 44 OctetString M + Accounting-Sub-Session-Id 287 Unsigned64 M + Acct-Application-Id 259 Unsigned32 M + Auth-Application-Id 258 Unsigned32 M + Auth-Request-Type 274 Enumerated M + Authorization-Lifetime 291 Unsigned32 M + Auth-Grace-Period 276 Unsigned32 M + Auth-Session-State 277 Enumerated M + Re-Auth-Request-Type 285 Enumerated M + Class 25 OctetString M + Destination-Host 293 DiamIdent M + Destination-Realm 283 DiamIdent M + Disconnect-Cause 273 Enumerated M + Error-Message 281 UTF8String - + Error-Reporting-Host 294 DiamIdent - + Event-Timestamp 55 Time M + Experimental-Result 297 Grouped M + Experimental-Result-Code 298 Unsigned32 M + Failed-AVP 279 Grouped M + Firmware-Revision 267 Unsigned32 - + Host-IP-Address 257 Address M + Inband-Security-Id 299 Unsigned32 M + Multi-Round-Time-Out 272 Unsigned32 M + Origin-Host 264 DiamIdent M + Origin-Realm 296 DiamIdent M + Origin-State-Id 278 Unsigned32 M + Product-Name 269 UTF8String - + Proxy-Host 280 DiamIdent M + Proxy-Info 284 Grouped M + Proxy-State 33 OctetString M + Redirect-Host 292 DiamURI M + Redirect-Host-Usage 261 Enumerated M + Redirect-Max-Cache-Time 262 Unsigned32 M + Result-Code 268 Unsigned32 M + Route-Record 282 DiamIdent M + Session-Id 263 UTF8String M + Session-Timeout 27 Unsigned32 M + Session-Binding 270 Unsigned32 M + Session-Server-Failover 271 Enumerated M + Supported-Vendor-Id 265 Unsigned32 M + Termination-Cause 295 Enumerated M + User-Name 1 UTF8String M + Vendor-Id 266 Unsigned32 M + Vendor-Specific-Application-Id 260 Grouped M + +@messages + + CER ::= < Diameter Header: 257, REQ > + { Origin-Host } + { Origin-Realm } + 1* { Host-IP-Address } + { Vendor-Id } + { Product-Name } + [ Origin-State-Id ] + * [ Supported-Vendor-Id ] + * [ Auth-Application-Id ] + * [ Inband-Security-Id ] + * [ Acct-Application-Id ] + * [ Vendor-Specific-Application-Id ] + [ Firmware-Revision ] + * [ AVP ] + + CEA ::= < Diameter Header: 257 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + 1* { Host-IP-Address } + { Vendor-Id } + { Product-Name } + [ Origin-State-Id ] + [ Error-Message ] + [ Failed-AVP ] + * [ Supported-Vendor-Id ] + * [ Auth-Application-Id ] + * [ Inband-Security-Id ] + * [ Acct-Application-Id ] + * [ Vendor-Specific-Application-Id ] + [ Firmware-Revision ] + * [ AVP ] + + DPR ::= < Diameter Header: 282, REQ > + { Origin-Host } + { Origin-Realm } + { Disconnect-Cause } + * [ AVP ] + + DPA ::= < Diameter Header: 282 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ Error-Message ] + [ Failed-AVP ] + * [ AVP ] + + DWR ::= < Diameter Header: 280, REQ > + { Origin-Host } + { Origin-Realm } + [ Origin-State-Id ] + * [ AVP ] + + DWA ::= < Diameter Header: 280 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ Error-Message ] + [ Failed-AVP ] + [ Origin-State-Id ] + * [ AVP ] + + answer-message ::= < Diameter Header: code, ERR [PXY] > + 0*1 < Session-Id > + { Origin-Host } + { Origin-Realm } + { Result-Code } + [ Origin-State-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + [ Failed-AVP ] + [ Experimental-Result ] + * [ Proxy-Info ] + * [ AVP ] + + RAR ::= < Diameter Header: 258, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Destination-Host } + { Auth-Application-Id } + { Re-Auth-Request-Type } + [ User-Name ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + RAA ::= < Diameter Header: 258, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + [ Origin-State-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + [ Failed-AVP ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + STR ::= < Diameter Header: 275, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Auth-Application-Id } + { Termination-Cause } + [ User-Name ] + [ Destination-Host ] + * [ Class ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + STA ::= < Diameter Header: 275, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + * [ Class ] + [ Error-Message ] + [ Error-Reporting-Host ] + [ Failed-AVP ] + [ Origin-State-Id ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + ASR ::= < Diameter Header: 274, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Destination-Host } + { Auth-Application-Id } + [ User-Name ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + ASA ::= < Diameter Header: 274, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + [ Origin-State-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + [ Failed-AVP ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + ACR ::= < Diameter Header: 271, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Destination-Host ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + ACA ::= < Diameter Header: 271, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + [ Failed-AVP ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ AVP ] + +@enum Disconnect-Cause + + REBOOTING 0 + BUSY 1 + DO_NOT_WANT_TO_TALK_TO_YOU 2 + +@enum Redirect-Host-Usage + + DONT_CACHE 0 + ALL_SESSION 1 + ALL_REALM 2 + REALM_AND_APPLICATION 3 + ALL_APPLICATION 4 + ALL_HOST 5 + ALL_USER 6 + +@enum Auth-Request-Type + + AUTHENTICATE_ONLY 1 + AUTHORIZE_ONLY 2 + AUTHORIZE_AUTHENTICATE 3 + +@enum Auth-Session-State + + STATE_MAINTAINED 0 + NO_STATE_MAINTAINED 1 + +@enum Re-Auth-Request-Type + + AUTHORIZE_ONLY 0 + AUTHORIZE_AUTHENTICATE 1 + +@enum Termination-Cause + + LOGOUT 1 + SERVICE_NOT_PROVIDED 2 + BAD_ANSWER 3 + ADMINISTRATIVE 4 + LINK_BROKEN 5 + AUTH_EXPIRED 6 + USER_MOVED 7 + SESSION_TIMEOUT 8 + +@enum Session-Server-Failover + + REFUSE_SERVICE 0 + TRY_AGAIN 1 + ALLOW_SERVICE 2 + TRY_AGAIN_ALLOW_SERVICE 3 + +@enum Accounting-Record-Type + + EVENT_RECORD 1 + START_RECORD 2 + INTERIM_RECORD 3 + STOP_RECORD 4 + +@enum Accounting-Realtime-Required + + DELIVER_AND_GRANT 1 + GRANT_AND_STORE 2 + GRANT_AND_LOSE 3 + +@define Result-Code + + ;; 7.1.1. Informational + MULTI_ROUND_AUTH 1001 + + ;; 7.1.2. Success + SUCCESS 2001 + LIMITED_SUCCESS 2002 + + ;; 7.1.3. Protocol Errors + COMMAND_UNSUPPORTED 3001 + UNABLE_TO_DELIVER 3002 + REALM_NOT_SERVED 3003 + TOO_BUSY 3004 + LOOP_DETECTED 3005 + REDIRECT_INDICATION 3006 + APPLICATION_UNSUPPORTED 3007 + INVALID_HDR_BITS 3008 + INVALID_AVP_BITS 3009 + UNKNOWN_PEER 3010 + + ;; 7.1.4. Transient Failures + AUTHENTICATION_REJECTED 4001 + OUT_OF_SPACE 4002 + ELECTION_LOST 4003 + + ;; 7.1.5. Permanent Failures + AVP_UNSUPPORTED 5001 + UNKNOWN_SESSION_ID 5002 + AUTHORIZATION_REJECTED 5003 + INVALID_AVP_VALUE 5004 + MISSING_AVP 5005 + RESOURCES_EXCEEDED 5006 + CONTRADICTING_AVPS 5007 + AVP_NOT_ALLOWED 5008 + AVP_OCCURS_TOO_MANY_TIMES 5009 + NO_COMMON_APPLICATION 5010 + UNSUPPORTED_VERSION 5011 + UNABLE_TO_COMPLY 5012 + INVALID_BIT_IN_HEADER 5013 + INVALID_AVP_LENGTH 5014 + INVALID_MESSAGE_LENGTH 5015 + INVALID_AVP_BIT_COMBO 5016 + NO_COMMON_SECURITY 5017 + +@grouped + + Proxy-Info ::= < AVP Header: 284 > + { Proxy-Host } + { Proxy-State } + * [ AVP ] + + Failed-AVP ::= < AVP Header: 279 > + 1* {AVP} + + Experimental-Result ::= < AVP Header: 297 > + { Vendor-Id } + { Experimental-Result-Code } + + Vendor-Specific-Application-Id ::= < AVP Header: 260 > + { Vendor-Id } + [ Auth-Application-Id ] + [ Acct-Application-Id ] diff --git a/lib/diameter/src/modules.mk b/lib/diameter/src/modules.mk index 25207625be..f8d3cf1d6f 100644 --- a/lib/diameter/src/modules.mk +++ b/lib/diameter/src/modules.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2012. All Rights Reserved. +# Copyright Ericsson AB 2010-2013. 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 @@ -17,11 +17,13 @@ # # %CopyrightEnd% -# Runtime dictionary files in ./dict. Modules will be generated from -# these are included in the app file. +# Runtime dictionary files in ./dict. Modules generated from these are +# included in the app file. DICTS = \ base_rfc3588 \ + base_rfc6733 \ base_accounting \ + acct_rfc6733 \ relay # The yecc grammar for the dictionary parser. @@ -49,6 +51,7 @@ RT_MODULES = \ base/diameter_stats \ base/diameter_sup \ base/diameter_sync \ + base/diameter_traffic \ base/diameter_types \ base/diameter_watchdog \ base/diameter_watchdog_sup \ @@ -67,7 +70,6 @@ CT_MODULES = \ base/diameter_info \ compiler/diameter_codegen \ compiler/diameter_exprecs \ - compiler/diameter_nowarn \ compiler/diameter_dict_scanner \ compiler/diameter_dict_util \ compiler/diameter_make diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index 3cb13d7043..8b8c2a6694 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -289,7 +289,7 @@ ports() -> Ts = diameter_reg:match({?MODULE, '_', '_'}), [{type(T), N, Pid} || {{?MODULE, T, {_, {_, S}}}, Pid} <- Ts, {ok, N} <- [inet:port(S)]]. - + ports(Ref) -> Ts = diameter_reg:match({?MODULE, '_', {Ref, '_'}}), [{type(T), N, Pid} || {{?MODULE, T, {R, {_, S}}}, Pid} <- Ts, @@ -484,8 +484,8 @@ transition({diameter, {close, Pid}}, #transport{parent = Pid}) -> %% TLS over SCTP is described in RFC 3436 but has limitations as %% described in RFC 6083. The latter describes DTLS over SCTP, which %% addresses these limitations, DTLS itself being described in RFC -%% 4347. TLS is primarily used over TCP, which the current RFC 3588 -%% draft acknowledges by equating TLS with TLS/TCP and DTLS/SCTP. +%% 4347. TLS is primarily used over TCP, which RFC 6733 acknowledges +%% by equating TLS with TLS/TCP and DTLS/SCTP. transition({diameter, {tls, _Ref, _Type, _Bool}}, _) -> stop; @@ -585,8 +585,7 @@ recv({_, #sctp_assoc_change{state = comm_up, socket = Sock} = S) -> Ref = getr(?REF_KEY), - is_reference(Ref) %% started in new code - andalso publish(T, Ref, Id, Sock), + publish(T, Ref, Id, Sock), up(S#transport{assoc_id = Id, streams = {IS, OS}}); diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl index 7ec7b1c5e7..132088b514 100644 --- a/lib/diameter/src/transport/diameter_tcp.erl +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -52,7 +52,10 @@ -define(DEFAULT_PORT, 3868). %% RFC 3588, ch 2.1 -define(LISTENER_TIMEOUT, 30000). --define(FRAGMENT_TIMEOUT, 1000). +-define(DEFAULT_FRAGMENT_TIMEOUT, 1000). + +-define(IS_UINT32(N), (is_integer(N) andalso 0 =< N andalso 0 == N bsr 32)). +-define(IS_TIMEOUT(N), (infinity == N orelse ?IS_UINT32(N))). %% cb_info passed to ssl. -define(TCP_CB(Mod), {Mod, tcp, tcp_closed, tcp_error}). @@ -72,7 +75,6 @@ {parent :: pid(), transport = self() :: pid()}). --type tref() :: reference(). %% timer reference -type length() :: 0..16#FFFFFF. %% message length from Diameter header -type size() :: non_neg_integer(). %% accumulated binary size -type frag() :: {length(), size(), binary(), list(binary())} @@ -83,8 +85,11 @@ {socket :: inet:socket() | ssl:sslsocket(), %% accept/connect socket parent :: pid(), %% of process that started us module :: module(), %% gen_tcp-like module - frag = <<>> :: binary() | {tref(), frag()}, %% message fragment - ssl :: boolean() | [term()]}). %% ssl options + frag = <<>> :: frag(), %% message fragment + ssl :: boolean() | [term()], %% ssl options + timeout :: infinity | 0..16#FFFFFFFF, %% fragment timeout + tref = false :: false | reference(), %% fragment timer reference + flush = false :: boolean()}). %% flush fragment at timeout? %% The usual transport using gen_tcp can be replaced by anything %% sufficiently gen_tcp-like by passing a 'module' option as the first %% (for simplicity) transport option. The transport_module diameter_etcp @@ -161,7 +166,12 @@ i({T, Ref, Mod, Pid, Opts, Addrs}) %% that does nothing but kill us with the parent until call %% returns. {ok, MPid} = diameter_tcp_sup:start_child(#monitor{parent = Pid}), - {SslOpts, Rest} = ssl(Opts), + {SslOpts, Rest0} = ssl(Opts), + {OwnOpts, Rest} = own(Rest0), + Tmo = proplists:get_value(fragment_timer, + OwnOpts, + ?DEFAULT_FRAGMENT_TIMEOUT), + ?IS_TIMEOUT(Tmo) orelse ?ERROR({fragment_timer, Tmo}), Sock = i(T, Ref, Mod, Pid, SslOpts, Rest, Addrs), MPid ! {stop, self()}, %% tell the monitor to die M = if SslOpts -> ssl; true -> Mod end, @@ -170,7 +180,8 @@ i({T, Ref, Mod, Pid, Opts, Addrs}) #transport{parent = Pid, module = M, socket = Sock, - ssl = SslOpts}; + ssl = SslOpts, + timeout = Tmo}; %% Put the reference in the process dictionary since we now use it %% advertise the ssl socket after TLS upgrade. @@ -196,6 +207,10 @@ i({listen, LRef, APid, {Mod, Opts, Addrs}}) -> erlang:monitor(process, APid), start_timer(#listener{socket = LSock}). +own(Opts) -> + {Own, Rest} = proplists:split(Opts, [fragment_timer]), + {lists:append(Own), Rest}. + ssl(Opts) -> {[SslOpts], Rest} = proplists:split(Opts, [ssl_options]), {ssl_opts(SslOpts), Rest}. @@ -368,8 +383,6 @@ handle_info(T, #monitor{} = S) -> %% # code_change/3 %% --------------------------------------------------------------------------- -code_change(_, {transport, _, _, _, _} = S, _) -> - {ok, #transport{} = list_to_tuple(tuple_to_list(S) ++ [false])}; code_change(_, State, _) -> {ok, State}. @@ -452,6 +465,7 @@ t(T,S) -> %% Initial incoming message when we might need to upgrade to TLS: %% don't request another message until we know. + transition({tcp, Sock, Bin}, #transport{socket = Sock, parent = Pid, frag = Head, @@ -459,13 +473,13 @@ transition({tcp, Sock, Bin}, #transport{socket = Sock, ssl = Opts} = S) when is_list(Opts) -> - case recv1(Head, Bin) of + case rcv(Head, Bin) of {Msg, B} when is_binary(Msg) -> diameter_peer:recv(Pid, Msg), S#transport{frag = B}; Frag -> setopts(M, Sock), - S#transport{frag = Frag} + start_fragment_timer(S#transport{frag = Frag}) end; %% Incoming message. @@ -476,7 +490,7 @@ transition({P, Sock, Bin}, #transport{socket = Sock, when P == tcp, not B; P == ssl, B -> setopts(M, Sock), - recv(Bin, S); + start_fragment_timer(recv(Bin, S)); %% Capabilties exchange has decided on whether or not to run over TLS. transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid} @@ -487,7 +501,7 @@ transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid} = tls_handshake(Type, B, S), Pid ! {diameter, {tls, Ref}}, setopts(M, Sock), - NS#transport{ssl = B}; + start_fragment_timer(NS#transport{ssl = B}); transition({C, Sock}, #transport{socket = Sock, ssl = B}) @@ -520,8 +534,8 @@ transition({diameter, {close, Pid}}, #transport{parent = Pid, stop; %% Timeout for reception of outstanding packets. -transition({timeout, TRef, flush}, S) -> - flush(TRef, S); +transition({timeout, TRef, flush}, #transport{tref = TRef} = S) -> + flush(S#transport{tref = false}); %% Request for the local port number. transition({resolve_port, Pid}, #transport{socket = Sock, @@ -559,9 +573,7 @@ tls_handshake(Type, true, #transport{socket = Sock, = S) -> {ok, SSock} = tls(Type, Sock, [{cb_info, ?TCP_CB(M)} | Opts]), Ref = getr(?REF_KEY), - is_reference(Ref) %% started in new code - andalso - (true = diameter_reg:add_new({?MODULE, Type, {Ref, SSock}})), + true = diameter_reg:add_new({?MODULE, Type, {Ref, SSock}}), S#transport{socket = SSock, module = ssl}; @@ -576,30 +588,25 @@ tls(accept, Sock, Opts) -> %% recv/2 %% -%% Reassemble fragmented messages and extract multple message sent +%% Reassemble fragmented messages and extract multiple message sent %% using Nagle. recv(Bin, #transport{parent = Pid, frag = Head} = S) -> - case recv1(Head, Bin) of + case rcv(Head, Bin) of {Msg, B} when is_binary(Msg) -> diameter_peer:recv(Pid, Msg), recv(B, S#transport{frag = <<>>}); Frag -> - S#transport{frag = Frag} + S#transport{frag = Frag, + flush = false} end. -%% recv1/2 +%% rcv/2 %% No previous fragment. -recv1(<<>>, Bin) -> +rcv(<<>>, Bin) -> rcv(Bin); -recv1({TRef, Head}, Bin) -> - erlang:cancel_timer(TRef), - rcv(Head, Bin). - -%% rcv/2 - %% Not even the first four bytes of the header. rcv(Head, Bin) when is_binary(Head) -> @@ -614,22 +621,22 @@ rcv({Len, N, Head, Acc}, Bin) -> %% Extract a message for which we have all bytes. rcv(Len, N, Head, Acc) when Len =< N -> - rcv1(Len, bin(Head, Acc)); + recv1(Len, bin(Head, Acc)); %% Wait for more packets. rcv(Len, N, Head, Acc) -> - {start_timer(), {Len, N, Head, Acc}}. + {Len, N, Head, Acc}. -%% rcv/2 +%% rcv/1 %% Nothing left. rcv(<<>> = Bin) -> Bin; -%% Well, this isn't good. Chances are things will go south from here -%% but if we're lucky then the bytes we have extend to an intended -%% message boundary and we can recover by simply discarding them, -%% which is the result of receiving them. +%% The Message Length isn't even sufficient for a header. Chances are +%% things will go south from here but if we're lucky then the bytes we +%% have extend to an intended message boundary and we can recover by +%% simply receiving them. Make it so. rcv(<<_:1/binary, Len:24, _/binary>> = Bin) when Len < 20 -> {Bin, <<>>}; @@ -637,23 +644,23 @@ rcv(<<_:1/binary, Len:24, _/binary>> = Bin) %% Enough bytes to extract a message. rcv(<<_:1/binary, Len:24, _/binary>> = Bin) when Len =< size(Bin) -> - rcv1(Len, Bin); + recv1(Len, Bin); %% Or not: wait for more packets. rcv(<<_:1/binary, Len:24, _/binary>> = Head) -> - {start_timer(), {Len, size(Head), Head, []}}; + {Len, size(Head), Head, []}; %% Not even 4 bytes yet. rcv(Head) -> - {start_timer(), Head}. + Head. -%% rcv1/2 +%% recv1/2 -rcv1(Len, Bin) -> +recv1(Len, Bin) -> <<Msg:Len/binary, Rest/binary>> = Bin, {Msg, Rest}. -%% bin/[12] +%% bin/1-2 bin(Head, Acc) -> list_to_binary([Head | lists:reverse(Acc)]). @@ -664,7 +671,7 @@ bin(Bin) when is_binary(Bin) -> Bin. -%% start_timer/0 +%% flush/1 %% An erroneously large message length may leave us with a fragment %% that lingers if the peer doesn't have anything more to send. Start @@ -677,14 +684,30 @@ bin(Bin) %% since all messages with length problems are discarded this should %% also eventually lead to watchdog failover. -start_timer() -> - erlang:start_timer(?FRAGMENT_TIMEOUT, self(), flush). +%% No fragment to flush. +flush(#transport{frag = <<>>} = S) -> + S; -flush(TRef, #transport{parent = Pid, frag = {TRef, Head}} = S) -> - diameter_peer:recv(Pid, bin(Head)), - S#transport{frag = <<>>}; -flush(_, S) -> - S. +%% Messages have been received since last timer expiry. +flush(#transport{flush = false} = S) -> + start_fragment_timer(S#transport{flush = true}); + +%% No messages since last expiry. +flush(#transport{frag = Frag, parent = Pid} = S) -> + diameter_peer:recv(Pid, bin(Frag)), + S#transport{frag = <<>>}. + +%% start_fragment_timer/1 +%% +%% Start a timer only if there's none running and a message to flush. + +start_fragment_timer(#transport{frag = B, tref = TRef} = S) + when B == <<>>; + TRef /= false -> + S; + +start_fragment_timer(#transport{timeout = Tmo} = S) -> + S#transport{tref = erlang:start_timer(Tmo, self(), flush)}. %% accept/2 diff --git a/lib/diameter/test/.gitignore b/lib/diameter/test/.gitignore index df38dfc5e3..4f19542bbe 100644 --- a/lib/diameter/test/.gitignore +++ b/lib/diameter/test/.gitignore @@ -1,3 +1,4 @@ /log /depend.mk +/coverspec diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile index aa4b7eaeb1..061f0bcbef 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -56,7 +56,8 @@ DATA_DIRS = $(sort $(dir $(DATA))) ERL_COMPILE_FLAGS += +warn_export_vars \ +warn_unused_vars \ -I ../include \ - -I ../src/gen + -I ../src/gen \ + $(STRICT_FLAGS) # ---------------------------------------------------- # Targets @@ -64,6 +65,9 @@ ERL_COMPILE_FLAGS += +warn_export_vars \ all debug opt: $(TARGET_FILES) +strict: + $(MAKE) opt STRICT_FLAGS=-Werror + # Require success ... run: $(SUITES) @@ -73,7 +77,7 @@ any: opt clean: rm -f $(TARGET_FILES) - rm -f depend.mk + rm -f depend.mk coverspec realclean: clean rm -rf log @@ -114,7 +118,7 @@ help: @echo " Echo some relevant variables." @echo ======================================== -.PHONY: all any run clean debug docs help info opt realclean +.PHONY: all any run clean debug docs help info opt realclean strict # ---------------------------------------------------- # Special Targets @@ -132,10 +136,21 @@ $(SUITES): log opt | awk '{print} / FAILED /{rc=1} END{exit rc}' rc=0 # Shorter in sed but requires a GNU extension (ie. Q). +cover: log opt coverspec + $(ERL) -noinput \ + -pa $(realpath ../ebin) \ + -sname diameter_cover \ + -s diameter_ct cover \ + -s init stop \ + | awk '{print} / FAILED /{rc=1} END{exit rc}' rc=0 + +coverspec: diameter.cover + sed -f [email protected] $< > $@ + log: mkdir $@ -.PHONY: $(SUITES) +.PHONY: $(SUITES) cover # ---------------------------------------------------- # Release Targets diff --git a/lib/diameter/test/coverspec.sed b/lib/diameter/test/coverspec.sed new file mode 100644 index 0000000000..5e81621593 --- /dev/null +++ b/lib/diameter/test/coverspec.sed @@ -0,0 +1,33 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2013. 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% +# + +# +# Morph diameter.cover into a legitimate cover spec. All that's being +# retained is the list of excluded modules. This is used by Makefile +# when running cover locally. +# + +/^{incl_app,/{ + i\ +{level, details}.\ +{incl_dirs, ["../ebin"]}. + d +} + +/^{excl_mods,/s@ .*@@ diff --git a/lib/diameter/test/depend.sed b/lib/diameter/test/depend.sed index 95dca44984..7e0d6e40e5 100644 --- a/lib/diameter/test/depend.sed +++ b/lib/diameter/test/depend.sed @@ -38,4 +38,4 @@ s@^-include("@@ s@".*@@ G -s@^\(.*\)\n\(.*\)@$(EBIN)/\2.$(EMULATOR): \1@ +s@^\(.*\)\n\(.*\)@\2.$(EMULATOR): \1@ diff --git a/lib/diameter/test/diameter_3xxx_SUITE.erl b/lib/diameter/test/diameter_3xxx_SUITE.erl new file mode 100644 index 0000000000..89c78d8b57 --- /dev/null +++ b/lib/diameter/test/diameter_3xxx_SUITE.erl @@ -0,0 +1,509 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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% +%% + +%% +%% Tests of application_opt() request_errors. There's some overlap +%% between this suite and the traffic suite but latter exercises more +%% config. +%% + +-module(diameter_3xxx_SUITE). + +-export([suite/0, + all/0, + groups/0, + init_per_suite/1, + end_per_suite/1, + init_per_group/2, + end_per_group/2, + init_per_testcase/2, + end_per_testcase/2]). + +%% testcases +-export([start/1, + send_unknown_application/1, + send_unknown_command/1, + send_ok/1, + send_invalid_avp_bits/1, + send_missing_avp/1, + send_ignore_missing_avp/1, + send_double_error/1, + send_3xxx/1, + send_5xxx/1, + stop/1]). + +%% diameter callbacks +-export([peer_up/3, + peer_down/3, + pick_peer/5, + prepare_request/4, + handle_answer/5, + handle_error/5, + handle_request/3]). + +-include("diameter.hrl"). +-include("diameter_gen_base_rfc6733.hrl"). +%% Use the fact that STR/STA is identical in RFC's 3588 and 6733. + +%% =========================================================================== + +-define(util, diameter_util). +-define(testcase(), proplists:get_value(testcase, get(?MODULE))). +-define(group(Config), begin + put(?MODULE, Config), + ?util:name(proplists:get_value(group, Config)) + end). + +-define(L, atom_to_list). +-define(A, list_to_atom). + +-define(CLIENT, "CLIENT"). +-define(SERVER, "SERVER"). +-define(REALM, "erlang.org"). +-define(HOST(Host, Realm), Host ++ [$.|Realm]). + +-define(ERRORS, [answer, answer_3xxx, callback]). +-define(RFCS, [rfc3588, rfc6733]). +-define(DICT(RFC), ?A("diameter_gen_base_" ++ ?L(RFC))). +-define(DICT, ?DICT(rfc6733)). + +-define(COMMON, ?DIAMETER_APP_ID_COMMON). + +%% Config for diameter:start_service/2. +-define(SERVICE(Name, Errors, RFC), + [{'Origin-Host', Name ++ "." ++ ?REALM}, + {'Origin-Realm', ?REALM}, + {'Host-IP-Address', [{127,0,0,1}]}, + {'Vendor-Id', 12345}, + {'Product-Name', "OTP/diameter"}, + {'Auth-Application-Id', [?COMMON]}, + {application, [{dictionary, ?DICT(RFC)}, + {module, ?MODULE}, + {answer_errors, callback}, + {request_errors, Errors}]}]). + +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 60}}]. + +all() -> + [{group, ?util:name([E,D])} || E <- ?ERRORS, D <- ?RFCS]. + +groups() -> + Tc = tc(), + [{?util:name([E,D]), [], [start] ++ Tc ++ [stop]} + || E <- ?ERRORS, D <- ?RFCS]. + +init_per_suite(Config) -> + ok = diameter:start(), + Config. + +end_per_suite(_Config) -> + ok = diameter:stop(). + +init_per_group(Group, Config) -> + [{group, Group} | Config]. + +end_per_group(_, _) -> + ok. + +init_per_testcase(Name, Config) -> + [{testcase, Name} | Config]. + +end_per_testcase(_, _) -> + ok. + +tc() -> + [send_unknown_application, + send_unknown_command, + send_ok, + send_invalid_avp_bits, + send_missing_avp, + send_ignore_missing_avp, + send_double_error, + send_3xxx, + send_5xxx]. + +%% =========================================================================== + +%% start/1 + +start(Config) -> + Group = proplists:get_value(group, Config), + [Errors, RFC] = ?util:name(Group), + ok = diameter:start_service(?SERVER, ?SERVICE(?L(Group), + Errors, + RFC)), + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, + callback, + rfc6733)), + LRef = ?util:listen(?SERVER, tcp), + ?util:connect(?CLIENT, tcp, LRef). + +%% stop/1 + +stop(_Config) -> + ok = diameter:remove_transport(?CLIENT, true), + ok = diameter:remove_transport(?SERVER, true), + ok = diameter:stop_service(?SERVER), + ok = diameter:stop_service(?CLIENT). + +%% send_unknown_application/1 +%% +%% Send an unknown application that a callback (which shouldn't take +%% place) fails on. + +%% diameter answers. +send_unknown_application([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3007, + %% UNSUPPORTED_APPLICATION + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_unknown_application(Config) -> + send_unknown_application(?group(Config)). + +%% send_unknown_command/1 +%% +%% Send a unknown command that a callback discards. + +%% handle_request discards the request. +send_unknown_command([callback, _]) -> + {error, timeout} = call(); + +%% diameter answers. +send_unknown_command([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3001, + %% UNSUPPORTED_COMMAND + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_unknown_command(Config) -> + send_unknown_command(?group(Config)). + +%% send_ok/1 +%% +%% Send a correct STR that a callback answers with 5002. + +%% Callback answers. +send_ok([_,_]) -> + #diameter_base_STA{'Result-Code' = 5002, %% UNKNOWN_SESSION_ID + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_ok(Config) -> + send_ok(?group(Config)). + +%% send_invalid_avp_bits/1 +%% +%% Send a request with an incorrect length on the optional +%% Origin-State-Id that a callback ignores. + +%% Callback answers. +send_invalid_avp_bits([callback, _]) -> + #diameter_base_STA{'Result-Code' = 2001, %% SUCCESS + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +%% diameter answers. +send_invalid_avp_bits([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3009, %% INVALID_AVP_BITS + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_invalid_avp_bits(Config) -> + send_invalid_avp_bits(?group(Config)). + +%% send_missing_avp/1 +%% +%% Send a request with a missing AVP that a callback answers. + +%% diameter answers. +send_missing_avp([answer, rfc6733]) -> + #'diameter_base_answer-message'{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +%% Callback answers. +send_missing_avp([_,_]) -> + #diameter_base_STA{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +send_missing_avp(Config) -> + send_missing_avp(?group(Config)). + +%% send_ignore_missing_avp/1 +%% +%% Send a request with a missing AVP that a callback ignores. + +%% diameter answers. +send_ignore_missing_avp([answer, rfc6733]) -> + #'diameter_base_answer-message'{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +%% Callback answers, ignores the error +send_ignore_missing_avp([_,_]) -> + #diameter_base_STA{'Result-Code' = 2001, %% SUCCESS + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_ignore_missing_avp(Config) -> + send_ignore_missing_avp(?group(Config)). + +%% send_double_error/1 +%% +%% Send a request with both an incorrect length on the optional +%% Origin-State-Id and a missing AVP. + +%% Callback answers with STA. +send_double_error([callback, _]) -> + #diameter_base_STA{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +%% diameter answers with answer-message. +send_double_error([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3009, %% INVALID_AVP_BITS + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +send_double_error(Config) -> + send_double_error(?group(Config)). + +%% send_3xxx/1 +%% +%% Send a request that's answered with a 3xxx result code. + +%% Callback answers. +send_3xxx([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3999, + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_3xxx(Config) -> + send_3xxx(?group(Config)). + +%% send_5xxx/1 +%% +%% Send a request that's answered with a 5xxx result code. + +%% Callback answers but fails since 5xxx isn't allowed in an RFC 3588 +%% answer-message. +send_5xxx([_, rfc3588]) -> + {error, timeout} = call(); + +%% Callback answers. +send_5xxx([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 5999, + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_5xxx(Config) -> + send_5xxx(?group(Config)). + +%% =========================================================================== + +call() -> + Name = ?testcase(), + diameter:call(?CLIENT, + ?DICT, + #diameter_base_STR + {'Termination-Cause' = ?LOGOUT, + 'Auth-Application-Id' = ?COMMON, + 'Class' = [?L(Name)]}, + [{extra, [Name]}]). + +%% =========================================================================== +%% diameter callbacks + +%% peer_up/3 + +peer_up(_SvcName, _Peer, State) -> + State. + +%% peer_down/3 + +peer_down(_SvcName, _Peer, State) -> + State. + +%% pick_peer/5 + +pick_peer([Peer], _, ?CLIENT, _State, _Name) -> + {ok, Peer}. + +%% prepare_request/4 + +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name) -> + {send, prepare(Pkt, Caps, Name)}. + +prepare(Pkt0, Caps, send_unknown_application) -> + Req = sta(Pkt0, Caps), + #diameter_packet{bin = <<H:8/binary, 0:32, T/binary>>} + = Pkt + = diameter_codec:encode(?DICT, Pkt0#diameter_packet{msg = Req}), + + Pkt#diameter_packet{bin = <<H/binary, 23:32, T/binary>>}; + +prepare(Pkt0, Caps, send_unknown_command) -> + Req = sta(Pkt0, Caps), + #diameter_packet{bin = <<H:5/binary, 275:24, T/binary>>} + = Pkt + = diameter_codec:encode(?DICT, Pkt0#diameter_packet{msg = Req}), + + Pkt#diameter_packet{bin = <<H/binary, 572:24, T/binary>>}; + +prepare(Pkt, Caps, T) + when T == send_ok; + T == send_3xxx; + T == send_5xxx -> + sta(Pkt, Caps); + +prepare(Pkt0, Caps, send_invalid_avp_bits) -> + Req0 = sta(Pkt0, Caps), + %% Append an Origin-State-Id with an incorrect AVP Length in order + %% to force 3009. + Req = Req0#diameter_base_STR{'Origin-State-Id' = [7]}, + #diameter_packet{bin = Bin} + = Pkt + = diameter_codec:encode(?DICT, Pkt0#diameter_packet{msg = Req}), + Offset = size(Bin) - 12 + 5, + <<H:Offset/binary, Len:24, T/binary>> = Bin, + Pkt#diameter_packet{bin = <<H/binary, (Len + 2):24, T/binary>>}; + +prepare(Pkt0, Caps, send_double_error) -> + dehost(prepare(Pkt0, Caps, send_invalid_avp_bits)); + +prepare(Pkt, Caps, T) + when T == send_missing_avp; + T == send_ignore_missing_avp -> + Req = sta(Pkt, Caps), + dehost(diameter_codec:encode(?DICT, Pkt#diameter_packet{msg = Req})). + +sta(Pkt, Caps) -> + #diameter_packet{msg = Req} + = Pkt, + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, DR}} + = Caps, + Req#diameter_base_STR{'Session-Id' = diameter:session_id(OH), + 'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Destination-Realm' = DR}. + +%% Strip Origin-Host. +dehost(#diameter_packet{bin = Bin} = Pkt) -> + <<V, Len:24, H:16/binary, T0/binary>> + = Bin, + {SessionId, T1} = split_avp(T0), + {OriginHost, T} = split_avp(T1), + Delta = size(OriginHost), + Pkt#diameter_packet{bin = <<V, (Len - Delta):24, H/binary, + SessionId/binary, + T/binary>>}. + +%% handle_answer/5 + +handle_answer(Pkt, _Req, ?CLIENT, _Peer, _Name) -> + Pkt#diameter_packet.msg. + +%% handle_error/5 + +handle_error(Reason, _Req, ?CLIENT, _Peer, _Name) -> + {error, Reason}. + +split_avp(<<_:5/binary, Len:24, _/binary>> = Bin) -> + L = pad(Len), + <<Avp:L/binary, T/binary>> = Bin, + {Avp, T}. + +pad(N) + when 0 == N rem 4 -> + N; +pad(N) -> + N - (N rem 4) + 4. + +%% handle_request/3 + +handle_request(#diameter_packet{header = #diameter_header{application_id = 0}, + msg = Msg}, + ?SERVER, + {_, Caps}) -> + request(Msg, Caps). + +request(undefined, _) -> %% unknown command + discard; + +request(#diameter_base_STR{'Class' = [Name]} = Req, Caps) -> + request(?A(Name), Req, Caps). + +request(send_ok, Req, Caps) -> + {reply, #diameter_packet{msg = answer(Req, Caps), + errors = [5002]}}; %% UNKNOWN_SESSION_ID + +request(send_3xxx, _Req, _Caps) -> + {answer_message, 3999}; + +request(send_5xxx, _Req, _Caps) -> + {answer_message, 5999}; + +request(send_invalid_avp_bits, Req, Caps) -> + #diameter_base_STR{'Origin-State-Id' = []} + = Req, + %% Default errors field but a non-answer-message and only 3xxx + %% errors detected means diameter sets neither Result-Code nor + %% Failed-AVP. + {reply, #diameter_packet{msg = answer(Req, Caps)}}; + +request(T, Req, Caps) + when T == send_double_error; + T == send_missing_avp -> + {reply, answer(Req, Caps)}; + +request(send_ignore_missing_avp, Req, Caps) -> + {reply, #diameter_packet{msg = answer(Req, Caps), + errors = false}}. %% ignore errors + +answer(Req, Caps) -> + #diameter_base_STR{'Session-Id' = SId} + = Req, + #diameter_caps{origin_host = {OH,_}, + origin_realm = {OR,_}} + = Caps, + #diameter_base_STA{'Session-Id' = SId, + 'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Result-Code' = 2001}. %% SUCCESS diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl index 53332af626..209f72adf1 100644 --- a/lib/diameter/test/diameter_app_SUITE.erl +++ b/lib/diameter/test/diameter_app_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -48,7 +48,6 @@ diameter_dict_parser, diameter_dict_util, diameter_exprecs, - diameter_nowarn, diameter_make]). -define(HELP_MODULES, [diameter_dbg, diff --git a/lib/diameter/test/diameter_capx_SUITE.erl b/lib/diameter/test/diameter_capx_SUITE.erl index ae128b8203..a4e4195a19 100644 --- a/lib/diameter/test/diameter_capx_SUITE.erl +++ b/lib/diameter/test/diameter_capx_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -27,6 +27,8 @@ -export([suite/0, all/0, groups/0, + init_per_group/2, + end_per_group/2, init_per_testcase/2, end_per_testcase/2]). @@ -53,7 +55,6 @@ peer_down/4]). -include("diameter.hrl"). --include("diameter_gen_base_rfc3588.hrl"). %% =========================================================================== @@ -78,8 +79,10 @@ | [{application, [{alias, A}, {dictionary, D}, {module, [?MODULE, A]}]} - || {A,D} <- [{common, ?DIAMETER_DICT_COMMON}, - {accounting, ?DIAMETER_DICT_ACCOUNTING}]]]). + || {A,D} <- [{base3588, diameter_gen_base_rfc3588}, + {acct3588, diameter_gen_base_accounting}, + {base6733, diameter_gen_base_rfc6733}, + {acct6733, diameter_gen_acct_rfc6733}]]]). -define(A, list_to_atom). -define(L, atom_to_list). @@ -88,13 +91,12 @@ -define(caps, #diameter_caps). -define(packet, #diameter_packet). --define(cea, #diameter_base_CEA). --define(answer_message, #'diameter_base_answer-message'). - -define(fail(T), erlang:error({T, process_info(self(), messages)})). -define(TIMEOUT, 10000). +-define(DICTS, [rfc3588, rfc6733]). + %% =========================================================================== suite() -> @@ -102,15 +104,15 @@ suite() -> all() -> [start, start_services, - add_listeners, - {group, all}, - {group, all, [parallel]}, - remove_listeners, + add_listeners] + ++ [{group, D, P} || D <- ?DICTS, P <- [[], [parallel]]] + ++ [remove_listeners, stop_services, stop]. groups() -> - [{all, [], lists:flatmap(fun tc/1, tc())}]. + Tc = lists:flatmap(fun tc/1, tc()), + [{D, [], Tc} || D <- ?DICTS]. %% Generate a unique hostname for each testcase so that watchdogs %% don't prevent a connection from being brought up immediately. @@ -118,6 +120,12 @@ init_per_testcase(Name, Config) -> Uniq = ["." ++ integer_to_list(N) || N <- tuple_to_list(now())], [{host, lists:flatten([?L(Name) | Uniq])} | Config]. +init_per_group(Name, Config) -> + [{rfc, Name} | Config]. + +end_per_group(_, _) -> + ok. + end_per_testcase(N, _) when N == start; N == start_services; @@ -126,6 +134,7 @@ end_per_testcase(N, _) N == stop_services; N == stop -> ok; + end_per_testcase(Name, Config) -> CRef = ?util:read_priv(Config, Name), ok = diameter:remove_transport(?CLIENT, CRef). @@ -155,14 +164,19 @@ start_services(_Config) -> %% to both this and the common application. Share a common service just %% to simplify config, and because we can. add_listeners(Config) -> - Acct = listen(?SERVER, - [{capabilities, [{'Origin-Host', ?HOST("acct-srv")}, - {'Auth-Application-Id', []}]}, - {applications, [accounting]}, - {capabilities_cb, [fun server_capx/3, acct]}]), - Base = listen(?SERVER, - [{capabilities, [{'Origin-Host', ?HOST("base-srv")}]}, - {capabilities_cb, [fun server_capx/3, base]}]), + Acct = [listen(?SERVER, + [{capabilities, [{'Origin-Host', ?HOST(H)}, + {'Auth-Application-Id', []}]}, + {applications, [A]}, + {capabilities_cb, [fun server_capx/3, acct]}]) + || {A,H} <- [{acct3588, "acct3588-srv"}, + {acct6733, "acct6733-srv"}]], + Base = [listen(?SERVER, + [{capabilities, [{'Origin-Host', ?HOST(H)}]}, + {applications, A}, + {capabilities_cb, [fun server_capx/3, base]}]) + || {A,H} <- [{[base3588, acct3588], "base3588-srv"}, + {[base6733, acct6733], "base6733-srv"}]], ?util:write_priv(Config, ?MODULE, {Base, Acct}). %% lref/2 reads remove_listeners(_Config) -> @@ -195,8 +209,9 @@ c_no_common_application(Config) -> client_closed(Config, "acct-srv", fun no_common_application/1, 5010). no_common_application(Config) -> + [Common, _Acct] = apps(Config), connect(Config, acct, [{capabilities, [{'Acct-Application-Id', []}]}, - {applications, [common]}]). + {applications, [Common]}]). %% ==================== %% Ask the base server to speak accounting with an unknown security @@ -209,9 +224,10 @@ c_no_common_security(Config) -> client_closed(Config, "base-srv", fun no_common_security/1, 5017). no_common_security(Config) -> + [Common, _Acct] = apps(Config), connect(Config, base, [{capabilities, [{'Acct-Application-Id', []}, {'Inband-Security-Id', [17, 18]}]}, - {applications, [common]}]). + {applications, [Common]}]). %% ==================== %% Have the base server reject a decent CER with the protocol error @@ -221,18 +237,19 @@ s_unknown_peer(Config) -> server_reject(Config, fun base/1, 3010). c_unknown_peer(Config) -> + Dict0 = dict0(Config), true = diameter:subscribe(?CLIENT), - OH = ?HOST("base-srv"), + OH = host(Config, "base-srv"), {CRef, _} = base(Config), - {'CEA', ?caps{}, - ?packet{msg = ?answer_message{'Origin-Host' = OH, - 'Result-Code' = 3010}}} - = client_recv(CRef). + {'CEA', ?caps{}, ?packet{msg = Msg}} = client_recv(CRef), + + ['diameter_base_answer-message' | _] = Dict0:'#get-'(Msg), + [OH, 3010] = Dict0:'#get-'(['Origin-Host', 'Result-Code'], Msg). base(Config) -> - connect(Config, base, []). + connect(Config, base, [{applications, apps(Config)}]). %% ==================== %% Have the base server reject a decent CER with the non-protocol @@ -266,18 +283,23 @@ s_client_reject(Config) -> end. c_client_reject(Config) -> + Dict0 = dict0(Config), true = diameter:subscribe(?CLIENT), - OH = ?HOST("acct-srv"), + OH = host(Config, "acct-srv"), {CRef, _} = client_reject(Config), {'CEA', {capabilities_cb, _, discard}, ?caps{origin_host = {_, OH}}, - ?packet{msg = ?cea{'Result-Code' = 2001}}} - = client_recv(CRef). + ?packet{msg = CEA}} + = client_recv(CRef), + + [diameter_base_CEA | _] = Dict0:'#get-'(CEA), + [2001] = Dict0:'#get-'(['Result-Code'], CEA). client_reject(Config) -> - connect(Config, acct, [{capabilities_cb, fun client_capx/2}]). + connect(Config, acct, [{capabilities_cb, fun client_capx/2}, + {applications, apps(Config)}]). %% =========================================================================== @@ -327,13 +349,21 @@ server_reject(Config, F, RC) -> client_closed(Config, Host, F, RC) -> true = diameter:subscribe(?CLIENT), - OH = ?HOST(Host), + OH = host(Config, Host), {CRef, _} = F(Config), {'CEA', RC, ?caps{origin_host = {_, OH}}, ?packet{}} = client_recv(CRef). +srv(Config, Host) -> + "rfc" ++ N = atom_to_list(proplists:get_value(rfc, Config)), + [H, "srv" = S] = string:tokens(Host, "-"), + H ++ N ++ "-" ++ S. + +host(Config, Name) -> + ?HOST(srv(Config, Name)). + %% client_recv/1 client_recv(CRef) -> @@ -364,6 +394,18 @@ client_capx(_, ?caps{origin_host = {[_,$_|"client_reject." ++ _], _}}) -> %% =========================================================================== +dict0(Config) -> + case proplists:get_value(rfc, Config) of + rfc3588 -> diameter_gen_base_rfc3588; + rfc6733 -> diameter_gen_base_rfc6733 + end. + +apps(Config) -> + case proplists:get_value(rfc, Config) of + rfc3588 -> [base3588, acct3588]; + rfc6733 -> [base6733, acct6733] + end. + host(Config) -> {_, H} = lists:keyfind(host, 1, Config), ?HOST(H). @@ -394,26 +436,32 @@ opts(PortNr, Opts) -> {port, 0}]} | Opts]. +lref(rfc3588, [LRef, _]) -> + LRef; +lref(rfc6733, [_, LRef]) -> + LRef; + lref(Config, T) -> - case ?util:read_priv(Config, ?MODULE) of - {LRef, _} when T == base -> - LRef; - {_, LRef} when T == acct -> - LRef - end. + lref(proplists:get_value(rfc, Config), + case ?util:read_priv(Config, ?MODULE) of + {R, _} when T == base -> + R; + {_, R} when T == acct -> + R + end). %% =========================================================================== %% diameter callbacks peer_up(?SERVER, - {_, ?caps{origin_host = {"acct-srv." ++ _, + {_, ?caps{origin_host = {"acct" ++ _, [_,$_|"client_reject." ++ _]}}}, State, _) -> State. peer_down(?SERVER, - {_, ?caps{origin_host = {"acct-srv." ++ _, + {_, ?caps{origin_host = {"acct" ++ _, [_,$_|"client_reject." ++ _]}}}, State, _) -> diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl index fbd38067a8..18bd2cc190 100644 --- a/lib/diameter/test/diameter_codec_test.erl +++ b/lib/diameter/test/diameter_codec_test.erl @@ -27,7 +27,8 @@ -include("diameter.hrl"). --define(BASE, diameter_gen_base_rfc3588). +-define(RFC3588, diameter_gen_base_rfc3588). +-define(RFC6733, diameter_gen_base_rfc6733). -define(BOOL, [true, false]). -define(A, list_to_atom). @@ -158,7 +159,8 @@ gen(M, messages, {Name, Code, Flags, _, _}) -> Name = case M:msg_name(Code, lists:member('REQ', Flags)) of N when Name /= 'answer-message' -> N; - '' when Name == 'answer-message', M == ?BASE -> + '' when Name == 'answer-message', (M == ?RFC3588 + orelse M == ?RFC6733) -> Name end, [] = arity(M, Name, Rname); diff --git a/lib/diameter/test/diameter_ct.erl b/lib/diameter/test/diameter_ct.erl index ded50bf6c5..1697287a22 100644 --- a/lib/diameter/test/diameter_ct.erl +++ b/lib/diameter/test/diameter_ct.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -23,16 +23,23 @@ %% Module used to run suites from Makefile. %% --export([run/1]). +-export([run/1, + cover/0]). %% The makefile looks for signs of failure so ignore the ct:run_test/1 %% return value. -run([Suite]) -> +run(Suites) -> + ct_run([{suite, Suites}]). + +cover() -> + ct_run([{spec, "./testspec"}]). + +ct_run(Opts) -> Start = info(), - ct:run_test([{suite, Suite}, - {logdir, "./log"}, - {auto_compile, false}]), + ct:run_test([{logdir, "./log"}, + {auto_compile, false} + | Opts]), info(Start , info()). info() -> diff --git a/lib/diameter/test/diameter_event_SUITE.erl b/lib/diameter/test/diameter_event_SUITE.erl index 7c1c76f22a..18bdcb1f54 100644 --- a/lib/diameter/test/diameter_event_SUITE.erl +++ b/lib/diameter/test/diameter_event_SUITE.erl @@ -121,7 +121,6 @@ down(Config) -> {applications, [?DICT_ACCT]}, {reconnect_timer, 5000}]), start = event(Svc), - {watchdog, Ref, _, {initial, down}, _} = event(Svc), {closed, Ref, {'CEA', ?NO_COMMON_APP, _, #diameter_packet{}}, _} = event(Svc), {reconnect, Ref, _} = event(Svc). @@ -132,7 +131,6 @@ cea_timeout(Config) -> {Svc, Ref} = connect(Config, [{capx_timeout, ?SERVER_CAPX_TMO div 2}, {reconnect_timer, 2*?SERVER_CAPX_TMO}]), start = event(Svc), - {watchdog, Ref, _, {initial, down}, _} = event(Svc), {closed, Ref, {'CEA', timeout}, _} = event(Svc). stop(_Config) -> diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl index bb820a8bf2..0ea8ae2d4e 100644 --- a/lib/diameter/test/diameter_failover_SUITE.erl +++ b/lib/diameter/test/diameter_failover_SUITE.erl @@ -103,9 +103,9 @@ -define(SUCCESS, 2001). %% Value of Termination-Cause determines client/server behaviour. --define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). --define(MOVED, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_USER_MOVED'). --define(TIMEOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_SESSION_TIMEOUT'). +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). +-define(MOVED, ?'DIAMETER_BASE_TERMINATION-CAUSE_USER_MOVED'). +-define(TIMEOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_SESSION_TIMEOUT'). %% =========================================================================== diff --git a/lib/diameter/test/diameter_gen_sctp_SUITE.erl b/lib/diameter/test/diameter_gen_sctp_SUITE.erl index 2fde7b9fdb..51ccb1e6ec 100644 --- a/lib/diameter/test/diameter_gen_sctp_SUITE.erl +++ b/lib/diameter/test/diameter_gen_sctp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -355,7 +355,7 @@ open(Opts) -> gen_sctp:open([{ip, ?ADDR}, {port, 0}, {active, true}, binary, {recbuf, 1 bsl 16}, {sndbuf, 1 bsl 16} | Opts]). - + %% assoc/1 assoc(Sock) -> diff --git a/lib/diameter/test/diameter_length_SUITE.erl b/lib/diameter/test/diameter_length_SUITE.erl new file mode 100644 index 0000000000..ffb19d2288 --- /dev/null +++ b/lib/diameter/test/diameter_length_SUITE.erl @@ -0,0 +1,289 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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% +%% + +%% +%% Tests of transport_opt() length_errors. +%% + +-module(diameter_length_SUITE). + +-export([suite/0, + all/0, + groups/0, + init_per_suite/1, + end_per_suite/1, + init_per_group/2, + end_per_group/2, + init_per_testcase/2, + end_per_testcase/2]). + +%% testcases +-export([start/1, + send/1, + stop/1]). + +%% diameter callbacks +-export([peer_up/3, + peer_down/3, + pick_peer/5, + prepare_request/4, + handle_answer/5, + handle_error/5, + handle_request/3]). + +-include("diameter.hrl"). +-include("diameter_gen_base_rfc3588.hrl"). + +%% =========================================================================== + +-define(util, diameter_util). + +-define(CLIENT, "CLIENT"). +-define(SERVER, "SERVER"). +-define(REALM, "erlang.org"). +-define(HOST(Host, Realm), Host ++ [$.|Realm]). +-define(DICT, diameter_gen_base_rfc3588). + +%% Config for diameter:start_service/2. +-define(SERVICE(Name), + [{'Origin-Host', Name ++ "." ++ ?REALM}, + {'Origin-Realm', ?REALM}, + {'Host-IP-Address', [{127,0,0,1}]}, + {'Vendor-Id', 12345}, + {'Product-Name', "OTP/diameter"}, + {'Auth-Application-Id', [?DIAMETER_APP_ID_COMMON]}, + {application, [{dictionary, ?DICT}, + {module, ?MODULE}, + {answer_errors, callback}]}]). + +-define(SUCCESS, + ?'DIAMETER_BASE_RESULT-CODE_SUCCESS'). +-define(MISSING_AVP, + ?'DIAMETER_BASE_RESULT-CODE_MISSING_AVP'). +-define(INVALID_MESSAGE_LENGTH, + ?'DIAMETER_BASE_RESULT-CODE_INVALID_MESSAGE_LENGTH'). + +-define(LOGOUT, + ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). + +-define(GROUPS, [exit, handle, discard]). + +-define(L, atom_to_list). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 60}}]. + +all() -> + [{group, G} || G <- ?GROUPS]. + +groups() -> + [{G, [], [start, send, stop]} || G <- ?GROUPS]. + +init_per_suite(Config) -> + ok = diameter:start(), + Config. + +end_per_suite(_Config) -> + ok = diameter:stop(). + +init_per_group(Group, Config) -> + [{group, Group} | Config]. + +end_per_group(_, _) -> + ok. + +init_per_testcase(_Name, Config) -> + Config. + +end_per_testcase(_, _) -> + ok. + +origin(exit) -> 0; +origin(handle) -> 1; +origin(discard) -> 2; + +origin(0) -> exit; +origin(1) -> handle; +origin(2) -> discard. + +%% =========================================================================== + +%% start/1 + +start(Config) -> + Group = proplists:get_value(group, Config), + ok = diameter:start_service(?SERVER, ?SERVICE(?L(Group))), + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)), + LRef = ?util:listen(?SERVER, + tcp, + [{length_errors, Group}]), + ?util:connect(?CLIENT, + tcp, + LRef, + [{capabilities, [{'Origin-State-Id', origin(Group)}]}]). + +%% stop/1 + +stop(_Config) -> + ok = diameter:remove_transport(?CLIENT, true), + ok = diameter:remove_transport(?SERVER, true), + ok = diameter:stop_service(?SERVER), + ok = diameter:stop_service(?CLIENT). + +%% send/1 + +%% Server transport exits on messages of insuffient length. +send(exit) -> + %% Transport exit is followed by failover but there's only one + %% transport to choose from. + {error, failover} = call(4); + +%% Server transport receives messages of insufficient length. +send(handle) -> + %% Message Length too large: diameter_tcp flushes the request + %% when no additional bytes arrive. + #diameter_base_STA{'Result-Code' = ?INVALID_MESSAGE_LENGTH} + = call(4), + %% Another request answered as it should. + #diameter_base_STA{'Result-Code' = ?SUCCESS} + = call(0), + %% Message Length conveniently small: the trailing optional + %% Origin-State-Id isn't included in the received request. + #diameter_base_STA{'Result-Code' = ?SUCCESS} + = call(-12), + %% Server receives Origin-State-Id AVP as the first 12 bytes of + %% the next request: AVP <<Code:32, Flags:8, Len:24, Data:32>> is + %% interpreted as header <<Version:8, Len:24, Flags:8, Code:24, + %% ApplId: 32>>. In particular, the AVP Length 12 = 00001100 is + %% interpreted as Command Flags, so R=0 and the request is + %% interpreted as an unsolicited answer. Increase Message Length + %% to have the server receive all bytes sent thusfar. + {error, timeout} + = call(12), + %% Another request answered as it should. + #diameter_base_STA{'Result-Code' = ?SUCCESS} + = call(0), + %% Shorten Message Length so much that that the server doesn't + %% receive the required Termination-Cause AVP. + #diameter_base_STA{'Result-Code' = ?MISSING_AVP} + = call(-24); + +%% Server transport discards message of insufficient length. +send(discard) -> + %% First request times out when the server discards it but a + %% second succeeds since the transport remains up. + {error, timeout} + = call(4), + #diameter_base_STA{'Result-Code' = ?SUCCESS} + = call(0); + +send(Config) -> + send(proplists:get_value(group, Config)). + +%% =========================================================================== + +call(Delta) -> + diameter:call(?CLIENT, + ?DICT, + #diameter_base_STR + {'Termination-Cause' = ?LOGOUT, + 'Auth-Application-Id' = ?DIAMETER_APP_ID_COMMON, + 'Origin-State-Id' = [7]}, + [{extra, [Delta]}]). + +%% =========================================================================== +%% diameter callbacks + +%% peer_up/3 + +peer_up(_SvcName, _Peer, State) -> + State. + +%% peer_down/3 + +peer_down(_SvcName, _Peer, State) -> + State. + +%% pick_peer/5 + +pick_peer([Peer], _, ?CLIENT, _State, _Delta) -> + {ok, Peer}. + +%% prepare_request/4 + +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Delta) -> + {send, resize(Delta, prepare(Pkt, Caps))}. + +prepare(#diameter_packet{msg = Req0} = Pkt, Caps) -> + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, DR}} + = Caps, + Req = Req0#diameter_base_STR{'Session-Id' = diameter:session_id(OH), + 'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Destination-Realm' = DR}, + diameter_codec:encode(?DICT, Pkt#diameter_packet{msg = Req}). + +resize(0, Pkt) -> + Pkt; +resize(Delta, #diameter_packet{bin = Bin} = Pkt) -> + Pkt#diameter_packet{bin = resize(Delta, Bin)}; + +resize(Delta, <<V, Len:24, T/binary>>) -> + <<V, (Len + Delta):24, T/binary>>. + +%% handle_answer/5 + +handle_answer(Pkt, _Req, ?CLIENT, _Peer, _Delta) -> + Pkt#diameter_packet.msg. + +%% handle_error/5 + +handle_error(Reason, _Req, ?CLIENT, _Peer, _Delta) -> + {error, Reason}. + +%% handle_request/3 + +handle_request(Pkt, ?SERVER, {_Ref, Caps}) -> + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, _}, + origin_state_id = {_,[Id]}} + = Caps, + answer(origin(Id), + Pkt, + #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Session-Id' = diameter:session_id(OH), + 'Origin-Host' = OH, + 'Origin-Realm' = OR}). + +answer(Group, #diameter_packet{errors = Es}, Ans) -> + answer(Group, Es, Ans); + +%% No errors: just answer. +answer(_, [], Ans) -> + {reply, Ans}; + +%% Otherwise an invalid length should only reach the callback if +%% length_errors = handle. +answer(Group, [RC|_], Ans) + when RC == ?INVALID_MESSAGE_LENGTH, Group == handle; + RC /= ?INVALID_MESSAGE_LENGTH -> + {reply, Ans}. diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl index f10d82bdf8..614eb4d4ca 100644 --- a/lib/diameter/test/diameter_relay_SUITE.erl +++ b/lib/diameter/test/diameter_relay_SUITE.erl @@ -107,7 +107,7 @@ -define(LOOP_DETECTED, 3005). -define(UNABLE_TO_DELIVER, 3002). --define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). -define(AUTHORIZE_ONLY, ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_ONLY'). %% =========================================================================== diff --git a/lib/diameter/test/diameter_stats_SUITE.erl b/lib/diameter/test/diameter_stats_SUITE.erl index 8b7d8cb1b6..af52afb59c 100644 --- a/lib/diameter/test/diameter_stats_SUITE.erl +++ b/lib/diameter/test/diameter_stats_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -69,7 +69,7 @@ reg(_) -> true = ?stat:reg(Ref), false = ?stat:reg(Ref). %% duplicate -incr(_) -> +incr(_) -> Ref = '_', Ctr = x, false = ?stat:incr(Ctr), %% not registered, diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl index 6cc34b20c5..92a1113758 100644 --- a/lib/diameter/test/diameter_tls_SUITE.erl +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -122,7 +122,7 @@ {capabilities, Caps}]}). -define(SUCCESS, 2001). --define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). %% =========================================================================== diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index b03a9ce4d1..781ed234cc 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -80,7 +80,9 @@ send_multiple_filters_2/1, send_multiple_filters_3/1, send_anything/1, + outstanding/1, remove_transports/1, + empty/1, stop_services/1, stop/1]). @@ -97,11 +99,21 @@ -include("diameter.hrl"). -include("diameter_gen_base_rfc3588.hrl"). -include("diameter_gen_base_accounting.hrl"). +%% The listening transports use RFC 3588 dictionaries, the client +%% transports use either 3588 or 6733. (So can't use the record +%% definitions in the latter case.) %% =========================================================================== -define(util, diameter_util). +-define(A, list_to_atom). +-define(L, atom_to_list). + +%% Don't use is_record/2 since dictionary hrl's aren't included. +%% (Since they define conflicting reqcords with the same names.) +-define(is_record(Rec, Name), (Name == element(1, Rec))). + -define(ADDR, {127,0,0,1}). -define(CLIENT, "CLIENT"). @@ -111,9 +123,6 @@ -define(EXTRA, an_extra_argument). --define(BASE, ?DIAMETER_DICT_COMMON). --define(ACCT, ?DIAMETER_DICT_ACCOUNTING). - %% Sequence mask for End-to-End and Hop-by-Hop identifiers. -define(CLIENT_MASK, {1,26}). %% 1 in top 6 bits @@ -123,9 +132,14 @@ %% How to send answers, in a diameter_packet or not. -define(CONTAINERS, [pkt, msg]). -%% Send over multiple connections that are mapped onto -%% [{E,P} || E <- ?ENCODINGS, P <- ?CONTAINERS]. --define(CONNECTIONS, [c0,c1,c2,c3]). +%% Which common dictionary to use in the clients. +-define(RFCS, [rfc3588, rfc6733]). + +-record(group, + {client_encoding, + client_dict0, + server_encoding, + server_container}). %% Not really what we should be setting unless the message is sent in %% the common application but diameter doesn't care. @@ -134,6 +148,17 @@ %% An Application-ID the server doesn't support. -define(BAD_APP, 42). +%% A common match when receiving answers in a client. +-define(answer_message(SessionId, ResultCode), + ['answer-message', + {'Session-Id', SessionId}, + {'Origin-Host', _}, + {'Origin-Realm', _}, + {'Result-Code', ResultCode} + | _]). +-define(answer_message(ResultCode), + ?answer_message(_, ResultCode)). + %% Config for diameter:start_service/2. -define(SERVICE(Name), [{'Origin-Host', Name ++ "." ++ ?REALM}, @@ -147,30 +172,33 @@ | [{application, [{dictionary, D}, {module, ?MODULE}, {answer_errors, callback}]} - || D <- [?BASE, ?ACCT]]]). + || D <- [diameter_gen_base_rfc3588, + diameter_gen_base_accounting, + diameter_gen_base_rfc6733, + diameter_gen_acct_rfc6733]]]). -define(SUCCESS, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). + ?'DIAMETER_BASE_RESULT-CODE_SUCCESS'). -define(COMMAND_UNSUPPORTED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_COMMAND_UNSUPPORTED'). + ?'DIAMETER_BASE_RESULT-CODE_COMMAND_UNSUPPORTED'). -define(TOO_BUSY, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_TOO_BUSY'). + ?'DIAMETER_BASE_RESULT-CODE_TOO_BUSY'). -define(APPLICATION_UNSUPPORTED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_APPLICATION_UNSUPPORTED'). + ?'DIAMETER_BASE_RESULT-CODE_APPLICATION_UNSUPPORTED'). -define(INVALID_HDR_BITS, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_HDR_BITS'). + ?'DIAMETER_BASE_RESULT-CODE_INVALID_HDR_BITS'). -define(INVALID_AVP_BITS, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_AVP_BITS'). + ?'DIAMETER_BASE_RESULT-CODE_INVALID_AVP_BITS'). -define(AVP_UNSUPPORTED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_AVP_UNSUPPORTED'). + ?'DIAMETER_BASE_RESULT-CODE_AVP_UNSUPPORTED'). -define(UNSUPPORTED_VERSION, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_UNSUPPORTED_VERSION'). + ?'DIAMETER_BASE_RESULT-CODE_UNSUPPORTED_VERSION'). -define(REALM_NOT_SERVED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_REALM_NOT_SERVED'). + ?'DIAMETER_BASE_RESULT-CODE_REALM_NOT_SERVED'). -define(UNABLE_TO_DELIVER, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_UNABLE_TO_DELIVER'). + ?'DIAMETER_BASE_RESULT-CODE_UNABLE_TO_DELIVER'). -define(INVALID_AVP_LENGTH, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_AVP_LENGTH'). + ?'DIAMETER_BASE_RESULT-CODE_INVALID_AVP_LENGTH'). -define(EVENT_RECORD, ?'DIAMETER_BASE_ACCOUNTING-RECORD-TYPE_EVENT_RECORD'). @@ -180,16 +208,11 @@ ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_AUTHENTICATE'). -define(LOGOUT, - ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). + ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). -define(BAD_ANSWER, - ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_BAD_ANSWER'). + ?'DIAMETER_BASE_TERMINATION-CAUSE_BAD_ANSWER'). -define(USER_MOVED, - ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_USER_MOVED'). - --define(A, list_to_atom). --define(L, atom_to_list). - --define(NAME(A,B), ?A(?L(A) ++ "," ++ ?L(B))). + ?'DIAMETER_BASE_TERMINATION-CAUSE_USER_MOVED'). %% =========================================================================== @@ -198,20 +221,27 @@ suite() -> all() -> [start, start_services, add_transports, result_codes] - ++ [{group, ?util:name([R,C,A]), P} || R <- ?ENCODINGS, - C <- ?CONTAINERS, - A <- ?ENCODINGS, - P <- [[], [parallel]]] - ++ [remove_transports, stop_services, stop]. + ++ [{group, ?util:name([R,D,A,C]), P} || R <- ?ENCODINGS, + D <- ?RFCS, + A <- ?ENCODINGS, + C <- ?CONTAINERS, + P <- [[], [parallel]]] + ++ [outstanding, remove_transports, empty, stop_services, stop]. groups() -> Ts = tc(), - [{?util:name([R,C,A]), [], Ts} || R <- ?ENCODINGS, - C <- ?CONTAINERS, - A <- ?ENCODINGS]. + [{?util:name([R,D,A,C]), [], Ts} || R <- ?ENCODINGS, + D <- ?RFCS, + A <- ?ENCODINGS, + C <- ?CONTAINERS]. init_per_group(Name, Config) -> - [{group, Name} | Config]. + [R,D,A,C] = ?util:name(Name), + G = #group{client_encoding = R, + client_dict0 = dict0(D), + server_encoding = A, + server_container = C}, + [{group, G} | Config]. end_per_group(_, _) -> ok. @@ -282,12 +312,33 @@ start_services(_Config) -> | ?SERVICE(?CLIENT)]). add_transports(Config) -> - LRef = ?util:listen(?SERVER, tcp, [{capabilities_cb, fun capx/2}]), - Cs = [?util:connect(?CLIENT, tcp, LRef, [{id, C}, - {capabilities, [osi(C)]}]) - || C <- ?CONNECTIONS], + LRef = ?util:listen(?SERVER, + tcp, + [{capabilities_cb, fun capx/2}, + {applications, apps(rfc3588)}]), + Cs = [?util:connect(?CLIENT, + tcp, + LRef, + [{id, Id}, + {capabilities, [{'Origin-State-Id', origin(Id)}]}, + {applications, apps(D)}]) + || A <- ?ENCODINGS, + C <- ?CONTAINERS, + D <- ?RFCS, + Id <- [{A,C}]], + %% The server uses the client's Origin-State-Id to decide how to + %% answer. ?util:write_priv(Config, "transport", [LRef | Cs]). +apps(D0) -> + D = dict0(D0), + [acct(D), D]. + +%% Ensure there are no outstanding requests in request table. +outstanding(_Config) -> + [] = [T || T <- ets:tab2list(diameter_request), + is_atom(element(1,T))]. + remove_transports(Config) -> [LRef | Cs] = ?util:read_priv(Config, "transport"), [?util:disconnect(?CLIENT, C, ?SERVER, LRef) || C <- Cs]. @@ -296,6 +347,10 @@ stop_services(_Config) -> ok = diameter:stop_service(?CLIENT), ok = diameter:stop_service(?SERVER). +%% Ensure even transports have been removed from request table. +empty(_Config) -> + [] = ets:tab2list(diameter_request). + stop(_Config) -> ok = diameter:stop(). @@ -303,10 +358,6 @@ capx(_, #diameter_caps{origin_host = {OH,DH}}) -> io:format("connection: ~p -> ~p~n", [DH,OH]), ok. -osi(Id) -> - [$c,N] = atom_to_list(Id), - {'Origin-State-Id', N - $0}. - %% =========================================================================== %% Ensure that result codes have the expected values. @@ -329,7 +380,7 @@ send_ok(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 1}], - #diameter_base_accounting_ACA{'Result-Code' = ?SUCCESS} + ['ACA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, Req). %% Send an accounting ACR that the server answers badly to. @@ -337,7 +388,7 @@ send_nok(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 0}], - #'diameter_base_answer-message'{'Result-Code' = ?INVALID_AVP_BITS} + ?answer_message(?INVALID_AVP_BITS) = call(Config, Req). %% Send an ACR and expect success. @@ -345,7 +396,7 @@ send_eval(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 3}], - #diameter_base_accounting_ACA{'Result-Code' = ?SUCCESS} + ['ACA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, Req). %% Send an accounting ACR that the server tries to answer with an @@ -362,46 +413,44 @@ send_protocol_error(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 4}], - #'diameter_base_answer-message'{'Result-Code' = ?TOO_BUSY} + ?answer_message(?TOO_BUSY) = call(Config, Req). %% Send an ASR with an arbitrary AVP and expect success and the same %% AVP in the reply. send_arbitrary(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{name = 'Class', value = "XXX"}]}], - #diameter_base_ASA{'Result-Code' = ?SUCCESS, - 'AVP' = Avps} + ['ASA', _SessionId, {'Result-Code', ?SUCCESS} | Avps] = call(Config, Req), - [#diameter_avp{name = 'Class', - value = "XXX"}] - = Avps. + {'AVP', [#diameter_avp{name = 'Class', + value = "XXX"}]} + = lists:last(Avps). %% Send an unknown AVP (to some client) and check that it comes back. send_unknown(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, is_mandatory = false, data = <<17>>}]}], - #diameter_base_ASA{'Result-Code' = ?SUCCESS, - 'AVP' = Avps} + ['ASA', _SessionId, {'Result-Code', ?SUCCESS} | Avps] = call(Config, Req), - [#diameter_avp{code = 999, - is_mandatory = false, - data = <<17>>}] - = Avps. + {'AVP', [#diameter_avp{code = 999, + is_mandatory = false, + data = <<17>>}]} + = lists:last(Avps). %% Ditto but set the M flag. send_unknown_mandatory(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, is_mandatory = true, data = <<17>>}]}], - #diameter_base_ASA{'Result-Code' = ?AVP_UNSUPPORTED, - 'Failed-AVP' = Failed} + ['ASA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | Avps] = call(Config, Req), - [#'diameter_base_Failed-AVP'{'AVP' = Avps}] = Failed, + [#'diameter_base_Failed-AVP'{'AVP' = As}] + = proplists:get_value('Failed-AVP', Avps), [#diameter_avp{code = 999, is_mandatory = true, data = <<17>>}] - = Avps. + = As. %% Send an STR that the server ignores. send_noreply(Config) -> @@ -411,32 +460,32 @@ send_noreply(Config) -> %% Send an unsupported command and expect 3001. send_unsupported(Config) -> Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}], - #'diameter_base_answer-message'{'Result-Code' = ?COMMAND_UNSUPPORTED} + ?answer_message(?COMMAND_UNSUPPORTED) = call(Config, Req). %% Send an unsupported application and expect 3007. send_unsupported_app(Config) -> Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}], - #'diameter_base_answer-message'{'Result-Code' = ?APPLICATION_UNSUPPORTED} + ?answer_message(?APPLICATION_UNSUPPORTED) = call(Config, Req). %% Send a request with the E bit set and expect 3008. send_error_bit(Config) -> Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}], - #'diameter_base_answer-message'{'Result-Code' = ?INVALID_HDR_BITS} + ?answer_message(?INVALID_HDR_BITS) = call(Config, Req). %% Send a bad version and check that we get 5011. send_unsupported_version(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - #diameter_base_STA{'Result-Code' = ?UNSUPPORTED_VERSION} + ['STA', _SessionId, {'Result-Code', ?UNSUPPORTED_VERSION} | _] = call(Config, Req). %% Send a request containing an incorrect AVP length. send_invalid_avp_bits(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - #'diameter_base_answer-message'{'Result-Code' = ?INVALID_AVP_BITS} + ?answer_message(?INVALID_AVP_BITS) = call(Config, Req). %% Send a request containing an AVP length that doesn't match the @@ -444,7 +493,7 @@ send_invalid_avp_bits(Config) -> send_invalid_avp_length(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - #'diameter_base_STA'{'Result-Code' = ?INVALID_AVP_LENGTH} + ['STA', _SessionId, {'Result-Code', ?INVALID_AVP_LENGTH} | _] = call(Config, Req). %% Send a request containing 5xxx errors that the server rejects with @@ -452,14 +501,14 @@ send_invalid_avp_length(Config) -> send_invalid_reject(Config) -> Req = ['STR', {'Termination-Cause', ?USER_MOVED}], - #'diameter_base_answer-message'{'Result-Code' = ?TOO_BUSY} + ?answer_message(?TOO_BUSY) = call(Config, Req). %% Send something long that will be fragmented by TCP. send_long(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'User-Name', [lists:duplicate(1 bsl 20, $X)]}], - #diameter_base_STA{'Result-Code' = ?SUCCESS} + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, Req). %% Send something for which pick_peer finds no suitable peer. @@ -484,14 +533,14 @@ send_any_1(Config) -> send_any_2(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}], - #'diameter_base_answer-message'{'Result-Code' = ?UNABLE_TO_DELIVER} + ?answer_message(?UNABLE_TO_DELIVER) = call(Config, Req, [{filter, {any, [host, realm]}}]). %% Send with a conjunctive filter. send_all_1(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], Realm = lists:foldr(fun(C,A) -> [C,A] end, [], ?REALM), - #diameter_base_STA{'Result-Code' = ?SUCCESS} + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, Req, [{filter, {all, [{host, any}, {realm, Realm}]}}]). send_all_2(Config) -> @@ -509,8 +558,7 @@ send_timeout(Config) -> %% received the Session-Id. send_error(Config) -> Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_AUTHENTICATE}], - #'diameter_base_answer-message'{'Result-Code' = ?TOO_BUSY, - 'Session-Id' = SId} + ?answer_message(SId, ?TOO_BUSY) = call(Config, Req), undefined /= SId. @@ -520,10 +568,9 @@ send_detach(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], Ref = make_ref(), ok = call(Config, Req, [{extra, [{self(), Ref}]}, detach]), - #diameter_packet{msg = Rec, errors = []} - = receive {Ref, T} -> T after 2000 -> false end, - #diameter_base_STA{'Result-Code' = ?SUCCESS} - = Rec. + Ans = receive {Ref, T} -> T after 2000 -> false end, + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + = Ans. %% Send a request which can't be encoded and expect {error, encode}. send_encode_error(Config) -> @@ -533,11 +580,11 @@ send_encode_error(Config) -> send_destination_1(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'Destination-Host', [?HOST(?SERVER, ?REALM)]}], - #diameter_base_STA{'Result-Code' = ?SUCCESS} + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, Req, [{filter, {all, [host, realm]}}]). send_destination_2(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - #diameter_base_STA{'Result-Code' = ?SUCCESS} + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, Req, [{filter, {all, [host, realm]}}]). %% Send with filtering on and expect failure when specifying an @@ -558,12 +605,12 @@ send_destination_4(Config) -> send_destination_5(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'Destination-Realm', "unknown.org"}], - #'diameter_base_answer-message'{'Result-Code' = ?REALM_NOT_SERVED} + ?answer_message(?REALM_NOT_SERVED) = call(Config, Req). send_destination_6(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}], - #'diameter_base_answer-message'{'Result-Code' = ?UNABLE_TO_DELIVER} + ?answer_message(?UNABLE_TO_DELIVER) = call(Config, Req). %% Specify an invalid option and expect failure. @@ -597,7 +644,7 @@ send_bad_filter(Config, F) -> %% Specify multiple filter options and expect them be conjunctive. send_multiple_filters_1(Config) -> Fun = fun(#diameter_caps{}) -> true end, - #diameter_base_STA{'Result-Code' = ?SUCCESS} + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = send_multiple_filters(Config, [host, {eval, Fun}]). send_multiple_filters_2(Config) -> E = {erlang, is_tuple, []}, @@ -608,7 +655,7 @@ send_multiple_filters_3(Config) -> E2 = {erlang, is_tuple, []}, E3 = {erlang, is_record, [diameter_caps]}, E4 = [{erlang, is_record, []}, diameter_caps], - #diameter_base_STA{'Result-Code' = ?SUCCESS} + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = send_multiple_filters(Config, [{eval, E} || E <- [E1,E2,E3,E4]]). send_multiple_filters(Config, Fs) -> @@ -619,7 +666,7 @@ send_multiple_filters(Config, Fs) -> %% only the return value from the prepare_request callback being %% significant. send_anything(Config) -> - #diameter_base_STA{'Result-Code' = ?SUCCESS} + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, anything). %% =========================================================================== @@ -629,56 +676,69 @@ call(Config, Req) -> call(Config, Req, Opts) -> Name = proplists:get_value(testcase, Config), - [Encoding, C, E] = ?util:name(proplists:get_value(group, Config)), + #group{client_encoding = ReqEncoding, + client_dict0 = Dict0} + = Group + = proplists:get_value(group, Config), diameter:call(?CLIENT, - dict(Req), - msg(Req, Encoding), - [{extra, [Name, client(E,C)]} | Opts]). + dict(Req, Dict0), + msg(Req, ReqEncoding, Dict0), + [{extra, [Name, Group]} | Opts]). -client(E, C) -> - list_to_atom([$c, $0 + 2*codec(E) + container(C)]). +origin({A,C}) -> + 2*codec(A) + container(C); -client(N) -> - {codec(N bsr 1), container(N rem 2)}. +origin(N) -> + {codec(N band 2), container(N rem 2)}. + +%% Map booleans, but the readable atoms are part of (constructed) +%% group names, so it's good that they're readable. codec(record) -> 0; -codec(list) -> 1; +codec(list) -> 1; codec(0) -> record; -codec(1) -> list. - -%% Here we're just mapping booleans but the readable atoms are part of -%% (constructed) group names, so it's good that they're readable. +codec(_) -> list. container(pkt) -> 0; container(msg) -> 1; container(0) -> pkt; -container(1) -> msg. +container(_) -> msg. -msg([H|T], record) +msg([H|_] = Msg, record = E, diameter_gen_base_rfc3588) when H == 'ACR'; H == 'ACA' -> - ?ACCT:'#new-'(?ACCT:msg2rec(H), T); -msg([H|T], record) -> - ?BASE:'#new-'(?BASE:msg2rec(H), T); -msg(T, _) -> - T. - -dict(['ACR' | _]) -> - ?ACCT; -dict(#diameter_base_accounting_ACR{}) -> - ?ACCT; -dict(_) -> - ?BASE. + msg(Msg, E, diameter_gen_base_accounting); +msg([H|_] = Msg, record = E, diameter_gen_base_rfc6733) + when H == 'ACR'; + H == 'ACA' -> + msg(Msg, E, diameter_gen_acct_rfc6733); +msg([H|T], record, Dict) -> + Dict:'#new-'(Dict:msg2rec(H), T); +msg(Msg, _, _) -> + Msg. + +dict0(D) -> + ?A("diameter_gen_base_" ++ ?L(D)). + +dict(Msg, Dict0) + when 'ACR' == hd(Msg); + 'ACA' == hd(Msg); + ?is_record(Msg, diameter_base_accounting_ACR); + ?is_record(Msg, diameter_base_accounting_ACA) -> + acct(Dict0); +dict(_, Dict0) -> + Dict0. + +acct(diameter_gen_base_rfc3588) -> + diameter_gen_base_accounting; +acct(diameter_gen_base_rfc6733) -> + diameter_gen_acct_rfc6733. %% Set only values that aren't already. -set([H|T], Vs) -> +set(_, [H|T], Vs) -> [H | Vs ++ T]; -set(#diameter_base_accounting_ACR{} = Rec, Vs) -> - set(Rec, Vs, ?ACCT); -set(Rec, Vs) -> - set(Rec, Vs, ?BASE). - -set(Rec, Vs, Dict) -> +set(#group{client_dict0 = Dict0} = _Group, Rec, Vs) -> + Dict = dict(Rec, Dict0), lists:foldl(fun({F,_} = FV, A) -> set(Dict, Dict:'#get-'(F, A), FV, A) end, @@ -707,17 +767,18 @@ peer_down(_SvcName, _Peer, State) -> %% pick_peer/6-7 -pick_peer(Peers, _, ?CLIENT, _State, Name, Id) +pick_peer(Peers, _, ?CLIENT, _State, Name, Group) when Name /= send_detach -> - find(Id, Peers). + find(Group, Peers). pick_peer(_Peers, _, ?CLIENT, _State, send_nopeer, _, ?EXTRA) -> false; -pick_peer(Peers, _, ?CLIENT, _State, send_detach, Id, {_,_}) -> - find(Id, Peers). +pick_peer(Peers, _, ?CLIENT, _State, send_detach, Group, {_,_}) -> + find(Group, Peers). -find(Id, Peers) -> +find(#group{server_encoding = A, server_container = C}, Peers) -> + Id = {A,C}, [P] = [P || P <- Peers, id(Id, P)], {ok, P}. @@ -731,39 +792,41 @@ id(Id, {Pid, _Caps}) -> prepare_request(_Pkt, ?CLIENT, {_Ref, _Caps}, send_discard, _) -> {discard, unprepared}; -prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name, _) -> - {send, prepare(Pkt, Caps, Name)}. +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name, Group) -> + {send, prepare(Pkt, Caps, Name, Group)}. -prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, send_detach, _, _) -> - {eval_packet, {send, prepare(Pkt, Caps)}, [fun log/2, detach]}. +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, send_detach, Group, _) -> + {eval_packet, {send, prepare(Pkt, Caps, Group)}, [fun log/2, detach]}. -log(#diameter_packet{} = P, T) -> +log(#diameter_packet{bin = Bin} = P, T) + when is_binary(Bin) -> io:format("~p: ~p~n", [T,P]). -%% prepare/3 +%% prepare/4 -prepare(Pkt, Caps, send_invalid_avp_bits) -> - Req = prepare(Pkt, Caps), +prepare(Pkt, Caps, send_invalid_avp_bits, #group{client_dict0 = Dict0} + = Group) -> + Req = prepare(Pkt, Caps, Group), %% Last AVP in our STR is Termination-Cause of type Unsigned32: %% set its length improperly. #diameter_packet{header = #diameter_header{length = L}, bin = B} = E - = diameter_codec:encode(?BASE, Pkt#diameter_packet{msg = Req}), + = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), Offset = L - 7, %% to AVP Length <<H:Offset/binary, 12:24/integer, T:4/binary>> = B, E#diameter_packet{bin = <<H/binary, 13:24/integer, T/binary>>}; -prepare(Pkt, Caps, N) +prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) when N == send_invalid_avp_length; N == send_invalid_reject -> - Req = prepare(Pkt, Caps), + Req = prepare(Pkt, Caps, Group), %% Second last AVP in our STR is Auth-Application-Id of type %% Unsigned32: Send a value of length 8. #diameter_packet{header = #diameter_header{length = L}, bin = B0} = E - = diameter_codec:encode(?BASE, Pkt#diameter_packet{msg = Req}), + = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), Offset = L - 7 - 12, %% to AVP Length <<H0:Offset/binary, 12:24/integer, T:16/binary>> = B0, <<V, L:24/integer, H/binary>> = H0, %% assert @@ -774,107 +837,111 @@ prepare(Pkt, Caps, N) 0:32/integer, T/binary>>}; -prepare(Pkt, Caps, send_unsupported) -> - Req = prepare(Pkt, Caps), +prepare(Pkt, Caps, send_unsupported, #group{client_dict0 = Dict0} = Group) -> + Req = prepare(Pkt, Caps, Group), #diameter_packet{bin = <<H:5/binary, _CmdCode:3/binary, T/binary>>} = E - = diameter_codec:encode(?BASE, Pkt#diameter_packet{msg = Req}), + = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), E#diameter_packet{bin = <<H/binary, 42:24/integer, T/binary>>}; -prepare(Pkt, Caps, send_unsupported_app) -> - Req = prepare(Pkt, Caps), +prepare(Pkt, Caps, send_unsupported_app, #group{client_dict0 = Dict0} + = Group) -> + Req = prepare(Pkt, Caps, Group), #diameter_packet{bin = <<H:8/binary, _ApplId:4/binary, T/binary>>} = E - = diameter_codec:encode(?BASE, Pkt#diameter_packet{msg = Req}), + = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), E#diameter_packet{bin = <<H/binary, ?BAD_APP:32/integer, T/binary>>}; -prepare(Pkt, Caps, send_error_bit) -> +prepare(Pkt, Caps, send_error_bit, Group) -> #diameter_packet{header = Hdr} = Pkt, Pkt#diameter_packet{header = Hdr#diameter_header{is_error = true}, - msg = prepare(Pkt, Caps)}; + msg = prepare(Pkt, Caps, Group)}; -prepare(Pkt, Caps, send_unsupported_version) -> +prepare(Pkt, Caps, send_unsupported_version, Group) -> #diameter_packet{header = Hdr} = Pkt, Pkt#diameter_packet{header = Hdr#diameter_header{version = 42}, - msg = prepare(Pkt, Caps)}; + msg = prepare(Pkt, Caps, Group)}; -prepare(Pkt, Caps, send_anything) -> +prepare(Pkt, Caps, send_anything, Group) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - prepare(Pkt#diameter_packet{msg = Req}, Caps); + prepare(Pkt#diameter_packet{msg = Req}, Caps, Group); -prepare(Pkt, Caps, _Name) -> - prepare(Pkt, Caps). +prepare(Pkt, Caps, _Name, Group) -> + prepare(Pkt, Caps, Group). -%% prepare/2 +%% prepare/3 -prepare(#diameter_packet{msg = Req}, Caps) - when is_record(Req, diameter_base_accounting_ACR); +prepare(#diameter_packet{msg = Req}, Caps, Group) + when ?is_record(Req, diameter_base_accounting_ACR); 'ACR' == hd(Req) -> #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, DR}} = Caps, - set(Req, [{'Session-Id', diameter:session_id(OH)}, - {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Destination-Realm', DR}]); + set(Group, Req, [{'Session-Id', diameter:session_id(OH)}, + {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Destination-Realm', DR}]); -prepare(#diameter_packet{msg = Req}, Caps) - when is_record(Req, diameter_base_ASR); +prepare(#diameter_packet{msg = Req}, Caps, Group) + when ?is_record(Req, diameter_base_ASR); 'ASR' == hd(Req) -> #diameter_caps{origin_host = {OH, DH}, origin_realm = {OR, DR}} = Caps, - set(Req, [{'Session-Id', diameter:session_id(OH)}, - {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Destination-Host', DH}, - {'Destination-Realm', DR}, - {'Auth-Application-Id', ?APP_ID}]); - -prepare(#diameter_packet{msg = Req}, Caps) - when is_record(Req, diameter_base_STR); + set(Group, Req, [{'Session-Id', diameter:session_id(OH)}, + {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Destination-Host', DH}, + {'Destination-Realm', DR}, + {'Auth-Application-Id', ?APP_ID}]); + +prepare(#diameter_packet{msg = Req}, Caps, Group) + when ?is_record(Req, diameter_base_STR); 'STR' == hd(Req) -> #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, DR}} = Caps, - set(Req, [{'Session-Id', diameter:session_id(OH)}, - {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Destination-Realm', DR}, - {'Auth-Application-Id', ?APP_ID}]); - -prepare(#diameter_packet{msg = Req}, Caps) - when is_record(Req, diameter_base_RAR); + set(Group, Req, [{'Session-Id', diameter:session_id(OH)}, + {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Destination-Realm', DR}, + {'Auth-Application-Id', ?APP_ID}]); + +prepare(#diameter_packet{msg = Req}, Caps, Group) + when ?is_record(Req, diameter_base_RAR); 'RAR' == hd(Req) -> #diameter_caps{origin_host = {OH, DH}, origin_realm = {OR, DR}} = Caps, - set(Req, [{'Session-Id', diameter:session_id(OH)}, - {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Destination-Host', DH}, - {'Destination-Realm', DR}, - {'Auth-Application-Id', ?APP_ID}]). + set(Group, Req, [{'Session-Id', diameter:session_id(OH)}, + {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Destination-Host', DH}, + {'Destination-Realm', DR}, + {'Auth-Application-Id', ?APP_ID}]). %% prepare_retransmit/5 -prepare_retransmit(_Pkt, false, _Peer, _Name, _Id) -> +prepare_retransmit(_Pkt, false, _Peer, _Name, _Group) -> discard. %% handle_answer/6-7 -handle_answer(Pkt, Req, ?CLIENT, Peer, Name, _Id) -> - answer(Pkt, Req, Peer, Name). +handle_answer(Pkt, Req, ?CLIENT, Peer, Name, Group) -> + answer(Pkt, Req, Peer, Name, Group). -handle_answer(Pkt, _Req, ?CLIENT, _Peer, send_detach, _Id, {Pid, Ref}) -> - Pid ! {Ref, Pkt}. +handle_answer(Pkt, Req, ?CLIENT, Peer, send_detach = Name, Group, X) -> + {Pid, Ref} = X, + Pid ! {Ref, answer(Pkt, Req, Peer, Name, Group)}. -answer(Pkt, Req, _Peer, Name) -> - #diameter_packet{header = H, msg = Rec, errors = Es} = Pkt, - ApplId = app(Req, Name), +answer(Pkt, Req, _Peer, Name, #group{client_dict0 = Dict0}) -> + #diameter_packet{header = H, msg = Ans, errors = Es} = Pkt, + ApplId = app(Req, Name, Dict0), #diameter_header{application_id = ApplId} = H, %% assert - answer(Rec, Es, Name). + Dict = dict(Ans, Dict0), + [R | Vs] = Dict:'#get-'(answer(Ans, Es, Name)), + [Dict:rec2msg(R) | Vs]. answer(Rec, [_|_], N) when N == send_invalid_avp_bits; @@ -884,15 +951,15 @@ answer(Rec, [_|_], N) answer(Rec, [], _) -> Rec. -app(_, send_unsupported_app) -> +app(_, send_unsupported_app, _) -> ?BAD_APP; -app(Req, _) -> - Dict = dict(Req), +app(Req, _, Dict0) -> + Dict = dict(Req, Dict0), Dict:id(). %% handle_error/6 -handle_error(Reason, _Req, ?CLIENT, _Peer, _Name, _Id) -> +handle_error(Reason, _Req, ?CLIENT, _Peer, _Name, _Group) -> {error, Reason}. %% handle_request/3 @@ -907,14 +974,15 @@ handle_request(#diameter_packet{header = H, msg = M}, ?SERVER, {_Ref, Caps}) -> {V,B} = ?CLIENT_MASK, V = EI bsr B, %% assert V = HI bsr B, %% - #diameter_caps{origin_state_id = {_,[N]}} = Caps, - answer(client(N), request(M, Caps)). + #diameter_caps{origin_state_id = {_,[Id]}} = Caps, + answer(origin(Id), request(M, Caps)). answer(T, {Tag, Action, Post}) -> {Tag, answer(T, Action), Post}; -answer({E,C}, {reply, Ans}) -> - answer(C, {reply, msg(Ans, E)}); -answer(pkt, {reply, Ans}) -> +answer({A,C}, {reply, Ans}) -> + answer(C, {reply, msg(Ans, A, diameter_gen_base_rfc3588)}); +answer(pkt, {reply, Ans}) + when not is_record(Ans, diameter_packet) -> {reply, #diameter_packet{msg = Ans}}; answer(_, T) -> T. @@ -987,7 +1055,8 @@ request(#diameter_base_ASR{'Session-Id' = SId, {'AVP', Avps}]}; %% send_invalid_reject -request(#diameter_base_STR{'Termination-Cause' = ?USER_MOVED}, _Caps) -> +request(#diameter_base_STR{'Termination-Cause' = ?USER_MOVED}, + _Caps) -> {protocol_error, ?TOO_BUSY}; %% send_noreply @@ -997,13 +1066,13 @@ request(#diameter_base_STR{'Termination-Cause' = T}, discard; %% send_destination_5 -request(#diameter_base_STR{'Destination-Realm'= R}, +request(#diameter_base_STR{'Destination-Realm' = R}, #diameter_caps{origin_realm = {OR, _}}) when R /= undefined, R /= OR -> {protocol_error, ?REALM_NOT_SERVED}; %% send_destination_6 -request(#diameter_base_STR{'Destination-Host'= [H]}, +request(#diameter_base_STR{'Destination-Host' = [H]}, #diameter_caps{origin_host = {OH, _}}) when H /= OH -> {protocol_error, ?UNABLE_TO_DELIVER}; diff --git a/lib/diameter/test/diameter_watchdog_SUITE.erl b/lib/diameter/test/diameter_watchdog_SUITE.erl index 7ce09e93ca..e1e166b834 100644 --- a/lib/diameter/test/diameter_watchdog_SUITE.erl +++ b/lib/diameter/test/diameter_watchdog_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. 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 @@ -127,13 +127,7 @@ end_per_suite(_Config) -> %% =========================================================================== %% Test the watchdog state machine for the required failover, failback -%% and reopen behaviour. Do this by having the testcase replace -%% diameter_service and start watchdogs, and having this module -%% implement a transport process that plays the role of the peer -%% Diameter node. - -%reopen(_) -> -% reopen(connect, ?WD(10000), 1, 'DWR'); +%% and reopen behaviour by examining watchdog events. reopen(_) -> [] = run([[reopen, T, Wd, N, M] @@ -349,7 +343,7 @@ recv_reopen(listen, Ref, _, _) -> reg(Type, Ref, SvcName, T) -> TPid = tpid(Type, Ref, diameter:service_info(SvcName, transport)), true = diameter_reg:add_new({?MODULE, TPid, T}). - + %% tpid/3 tpid(connect, Ref, [[{ref, Ref}, @@ -375,7 +369,7 @@ tpid(listen, Ref, [[{ref, Ref}, {port, [{owner, TPid} | _]} | _]] = lists:filter(fun([{watchdog, {_,_,S}} | _]) -> - S == okay orelse S == reopen + S == okay orelse S == reopen end, As), TPid. @@ -432,7 +426,7 @@ send({SvcName, {_,_,_} = T}, Sock, Bin) -> putr(origin, [OH, OR]), putr(config, T), send(Sock, Bin); - + %% Discard DWA, failback after another timeout in the peer. send({Wd, 0 = No, Msg}, Sock, Bin) -> Origin = getr(origin), diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk index 80b1769d04..c4a713fb10 100644 --- a/lib/diameter/test/modules.mk +++ b/lib/diameter/test/modules.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2012. All Rights Reserved. +# Copyright Ericsson AB 2010-2013. 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 @@ -22,26 +22,28 @@ COVER_SPEC_FILE = diameter.cover MODULES = \ diameter_ct \ - diameter_util \ diameter_enum \ - diameter_compiler_SUITE \ + diameter_util \ + diameter_3xxx_SUITE \ + diameter_app_SUITE \ + diameter_capx_SUITE \ diameter_codec_SUITE \ diameter_codec_test \ - diameter_app_SUITE \ + diameter_compiler_SUITE \ diameter_dict_SUITE \ - diameter_reg_SUITE \ - diameter_sync_SUITE \ - diameter_stats_SUITE \ - diameter_watchdog_SUITE \ + diameter_dpr_SUITE \ + diameter_event_SUITE \ + diameter_failover_SUITE \ diameter_gen_sctp_SUITE \ - diameter_transport_SUITE \ - diameter_capx_SUITE \ - diameter_traffic_SUITE \ + diameter_length_SUITE \ + diameter_reg_SUITE \ diameter_relay_SUITE \ + diameter_stats_SUITE \ + diameter_sync_SUITE \ diameter_tls_SUITE \ - diameter_failover_SUITE \ - diameter_dpr_SUITE \ - diameter_event_SUITE + diameter_traffic_SUITE \ + diameter_transport_SUITE \ + diameter_watchdog_SUITE HRL_FILES = \ diameter_ct.hrl diff --git a/lib/diameter/test/testspec b/lib/diameter/test/testspec new file mode 100644 index 0000000000..2fd8307281 --- /dev/null +++ b/lib/diameter/test/testspec @@ -0,0 +1,3 @@ + +{suites, ".", all}. +{cover, "./coverspec"}. diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index 74f4c57b70..98e719c50a 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -18,5 +18,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.4 +DIAMETER_VSN = 1.4.1 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index 599036f380..a87a8471e3 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -660,7 +660,7 @@ read_source(Name, Opts0) -> check_forms(Forms, Name), Forms; {error, R} -> - edoc_report:error({"error reading file '~s'.", + edoc_report:error({"error reading file '~ts'.", [edoc_lib:filename(Name)]}), exit({error, R}) end. @@ -677,7 +677,84 @@ read_source_2(Name, Opts) -> Includes = proplists:append_values(includes, Opts) ++ [filename:dirname(Name)], Macros = proplists:append_values(macros, Opts), - epp:parse_file(Name, Includes, Macros). + %% epp:parse_file(Name, Includes, Macros). + parse_file(Name, Includes, Macros). + +%% The code below has been copied from epp.erl. +%% +%% Copy the line of the last token to the last token that will be +%% part of the parse tree. +%% +%% The last line is used in edoc_extract:find_type_docs() to determine +%% if a type declaration is followed by a comment. +%% <example> +%% -type t() :: [ +%% {tag, integer()} +%% ]. +%% %% Protocol options. +%% </example> +%% The line of the dot token will be copied to the integer token. + +parse_file(Name, Includes, Macros) -> + case epp:open(Name, Includes, Macros) of + {ok, Epp} -> + try {ok, parse_file(Epp)} + after _ = epp:close(Epp) + end; + Error -> + Error + end. + +parse_file(Epp) -> + case scan_and_parse(Epp) of + {ok, Form} -> + case Form of + {attribute,La,record,{Record, Fields}} -> + case epp:normalize_typed_record_fields(Fields) of + {typed, NewFields} -> + [{attribute, La, record, {Record, NewFields}}, + {attribute, La, type, + {{record, Record}, Fields, []}} + | parse_file(Epp)]; + not_typed -> + [Form | parse_file(Epp)] + end; + _ -> + [Form | parse_file(Epp)] + end; + {error, E} -> + [{error, E} | parse_file(Epp)]; + {eof, Location} -> + [{eof, Location}] + end. + +scan_and_parse(Epp) -> + case epp:scan_erl_form(Epp) of + {ok, Toks0} -> + Toks = fix_last_line(Toks0), + case erl_parse:parse_form(Toks) of + {ok, Form} -> + {ok, Form}; + Else -> + Else + end; + Else -> + Else + end. + +fix_last_line(Toks0) -> + Toks1 = lists:reverse(Toks0), + {line, LastLine} = erl_scan:token_info(hd(Toks1), line), + fll(Toks1, LastLine, []). + +fll([{Category, Attributes0, Symbol} | L], LastLine, Ts) -> + F = fun(_OldLine) -> LastLine end, + Attributes = erl_scan:set_attribute(line, Attributes0, F), + lists:reverse(L, [{Category, Attributes, Symbol} | Ts]); +fll([T | L], LastLine, Ts) -> + fll(L, LastLine, [T | Ts]); +fll(L, _LastLine, Ts) -> + lists:reverse(L, Ts). check_forms(Fs, Name) -> Fun = fun (F) -> diff --git a/lib/edoc/src/edoc_doclet.erl b/lib/edoc/src/edoc_doclet.erl index a0c1ae1c0f..ce1e94a26a 100644 --- a/lib/edoc/src/edoc_doclet.erl +++ b/lib/edoc/src/edoc_doclet.erl @@ -200,7 +200,7 @@ source({M, P, Name, Path}, Dir, Suffix, Env, Set, Private, Hidden, {Set, Error} end; R -> - report("skipping source file '~s': ~W.", [File, R, 15]), + report("skipping source file '~ts': ~W.", [File, R, 15]), {Set, true} end. @@ -216,14 +216,14 @@ check_name(M, M0, P0, File) -> ok; _ -> if N =/= N0 -> - warning("file '~s' actually contains module '~s'.", + warning("file '~ts' actually contains module '~s'.", [File, M]); true -> ok end end, if P =/= P0 -> - warning("file '~s' belongs to package '~s', not '~s'.", + warning("file '~ts' belongs to package '~s', not '~s'.", [File, P, P0]); true -> ok diff --git a/lib/edoc/src/edoc_lib.erl b/lib/edoc/src/edoc_lib.erl index 3d193c4bfa..276f48453e 100644 --- a/lib/edoc/src/edoc_lib.erl +++ b/lib/edoc/src/edoc_lib.erl @@ -466,20 +466,20 @@ uri_get("file://localhost/" ++ Path) -> uri_get_file(Path); uri_get("file://" ++ Path) -> Msg = io_lib:format("cannot handle 'file:' scheme with " - "nonlocal network-path: 'file://~s'.", + "nonlocal network-path: 'file://~ts'.", [Path]), {error, Msg}; uri_get("file:/" ++ Path) -> uri_get_file(Path); uri_get("file:" ++ Path) -> - Msg = io_lib:format("ignoring malformed URI: 'file:~s'.", [Path]), + Msg = io_lib:format("ignoring malformed URI: 'file:~ts'.", [Path]), {error, Msg}; uri_get("http:" ++ Path) -> uri_get_http("http:" ++ Path); uri_get("ftp:" ++ Path) -> uri_get_ftp("ftp:" ++ Path); uri_get("//" ++ Path) -> - Msg = io_lib:format("cannot access network-path: '//~s'.", [Path]), + Msg = io_lib:format("cannot access network-path: '//~ts'.", [Path]), {error, Msg}; uri_get([C, $:, $/ | _]=Path) when C >= $A, C =< $Z; C >= $a, C =< $z -> uri_get_file(Path); % special case for Windows @@ -490,7 +490,7 @@ uri_get(URI) -> true -> uri_get_file(URI); false -> - Msg = io_lib:format("cannot handle URI: '~s'.", [URI]), + Msg = io_lib:format("cannot handle URI: '~ts'.", [URI]), {error, Msg} end. @@ -555,12 +555,12 @@ uri_get_http_1(Result, URI) -> end. http_errmsg(Reason, URI) -> - io_lib:format("http error: ~s: '~s'", [Reason, URI]). + io_lib:format("http error: ~ts: '~ts'", [Reason, URI]). %% TODO: implement ftp access method uri_get_ftp(URI) -> - Msg = io_lib:format("cannot access ftp scheme yet: '~s'.", [URI]), + Msg = io_lib:format("cannot access ftp scheme yet: '~ts'.", [URI]), {error, Msg}. %% @private @@ -615,7 +615,7 @@ copy_file(From, To) -> {ok, _} -> ok; {error, R} -> R1 = file:format_error(R), - report("error copying '~s' to '~s': ~s.", [From, To, R1]), + report("error copying '~ts' to '~ts': ~ts.", [From, To, R1]), exit(error) end. @@ -631,7 +631,7 @@ list_dir(Dir, Error) -> fun (S, As) -> warning(S, As), [] end end, R1 = file:format_error(R), - F("could not read directory '~s': ~s.", [filename(Dir), R1]) + F("could not read directory '~ts': ~ts.", [filename(Dir), R1]) end. %% @private @@ -667,7 +667,7 @@ simplify_path(P) -> %% ok -> ok; %% {error, R} -> %% R1 = file:format_error(R), -%% report("cannot create directory '~s': ~s.", [Dir, R1]), +%% report("cannot create directory '~ts': ~ts.", [Dir, R1]), %% exit(error) %% end. @@ -707,7 +707,7 @@ write_file(Text, Dir, Name, Package, Options) -> ok = file:close(FD); {error, R} -> R1 = file:format_error(R), - report("could not write file '~s': ~s.", [File, R1]), + report("could not write file '~ts': ~ts.", [File, R1]), exit(error) end. @@ -761,7 +761,7 @@ read_info_file(Dir) -> parse_info_file(Text, File); {error, R} -> R1 = file:format_error(R), - warning("could not read '~s': ~s.", [File, R1]), + warning("could not read '~ts': ~ts.", [File, R1]), {?NO_APP, [], []} end; false -> @@ -776,7 +776,7 @@ uri_get_info_file(Base) -> {ok, Text} -> parse_info_file(Text, URI); {error, Msg} -> - warning("could not read '~s': ~s.", [URI, Msg]), + warning("could not read '~ts': ~ts.", [URI, Msg]), {?NO_APP, [], []} end. @@ -785,10 +785,10 @@ parse_info_file(Text, Name) -> {ok, Vs} -> info_file_data(Vs); {error, eof} -> - warning("unexpected end of file in '~s'.", [Name]), + warning("unexpected end of file in '~ts'.", [Name]), {?NO_APP, [], []}; {error, {_Line,Module,R}} -> - warning("~s: ~s.", [Module:format_error(R), Name]), + warning("~ts: ~ts.", [Module:format_error(R), Name]), {?NO_APP, [], []} end. @@ -865,11 +865,14 @@ find_sources_2(Dir, Pkg, Rec, Ext, Skip) -> [] end. -find_sources_3(Es, Dir, '', Rec, Ext, Skip) -> +find_sources_3(Es, Dir, Pkg, Rec, Ext, Skip) -> [find_sources_2(filename:join(Dir, E), - to_atom(E), Rec, Ext, Skip) + to_atom(join(Pkg, E)), Rec, Ext, Skip) || E <- Es, is_package_dir(E, Dir)]. +join('', E) -> E; +join(Pkg, E) -> filename:join(Pkg, E). + is_source_file(Name, Ext) -> (filename:extension(Name) == Ext) andalso is_name(filename:rootname(Name, Ext)). @@ -1030,7 +1033,7 @@ run_plugin(Name, Key, Default, Fun, Opts) when is_atom(Name) -> {ok, Value} -> Value; R -> - report("error in ~s '~w': ~W.", [Name, Module, R, 20]), + report("error in ~ts '~w': ~W.", [Name, Module, R, 20]), exit(error) end. diff --git a/lib/edoc/src/edoc_macros.erl b/lib/edoc/src/edoc_macros.erl index 08686c4fb5..8efbfd00c7 100644 --- a/lib/edoc/src/edoc_macros.erl +++ b/lib/edoc/src/edoc_macros.erl @@ -88,7 +88,7 @@ link_macro(S, Line, Env) -> true -> " target=\"_top\""; % note the initial space false -> "" end, - lists:flatten(io_lib:fwrite("<a href=\"~s\"~s>~ts</a>", + lists:flatten(io_lib:fwrite("<a href=\"~ts\"~ts>~ts</a>", [URI, Target, Txt])). section_macro(S, _Line, _Env) -> @@ -102,7 +102,7 @@ type_macro(S, Line, Env) -> Def = edoc_parser:parse_typedef(S1, Line), {#t_typedef{type = T}, _} = Def, Txt = edoc_layout:type(edoc_data:type(T, Env)), - lists:flatten(io_lib:fwrite("<code>~s</code>", [Txt])). + lists:flatten(io_lib:fwrite("<code>~ts</code>", [Txt])). %% Expand inline macros in tag content. diff --git a/lib/edoc/src/edoc_parser.yrl b/lib/edoc/src/edoc_parser.yrl index cf1a2d6b11..a20f152f34 100644 --- a/lib/edoc/src/edoc_parser.yrl +++ b/lib/edoc/src/edoc_parser.yrl @@ -462,4 +462,4 @@ throw_error({parse_throws, E}, L) -> throw_error(parse_param, L) -> throw({error, L, "missing parameter name"}); throw_error({Where, E}, L) when is_list(Where) -> - throw({error,L,{"unknown error parsing ~s: ~P.",[Where,E,15]}}). + throw({error,L,{"unknown error parsing ~ts: ~P.",[Where,E,15]}}). diff --git a/lib/edoc/src/edoc_report.erl b/lib/edoc/src/edoc_report.erl index 9bec08ab97..dc6320df6d 100644 --- a/lib/edoc/src/edoc_report.erl +++ b/lib/edoc/src/edoc_report.erl @@ -83,13 +83,13 @@ report(L, Where, S, Vs) -> io:nl(). where({File, module}) -> - io_lib:fwrite("~s, in module header: ", [File]); + io_lib:fwrite("~ts, in module header: ", [File]); where({File, footer}) -> - io_lib:fwrite("~s, in module footer: ", [File]); + io_lib:fwrite("~ts, in module footer: ", [File]); where({File, header}) -> - io_lib:fwrite("~s, in header file: ", [File]); + io_lib:fwrite("~ts, in header file: ", [File]); where({File, {F, A}}) -> - io_lib:fwrite("~s, function ~s/~w: ", [File, F, A]); + io_lib:fwrite("~ts, function ~s/~w: ", [File, F, A]); where([]) -> io_lib:fwrite("~s: ", [?APPLICATION]); where(File) when is_list(File) -> diff --git a/lib/edoc/src/edoc_run.erl b/lib/edoc/src/edoc_run.erl index 48b6137ac1..b5a1ef713d 100644 --- a/lib/edoc/src/edoc_run.erl +++ b/lib/edoc/src/edoc_run.erl @@ -162,7 +162,7 @@ file(Args) -> -spec invalid_args(string(), list()) -> no_return(). invalid_args(Where, Args) -> - report("invalid arguments to ~s: ~w.", [Where, Args]), + report("invalid arguments to ~ts: ~w.", [Where, Args]), shutdown_error(). run(F) -> @@ -213,13 +213,13 @@ parse_arg(A) -> {ok, Expr} -> case catch erl_parse:normalise(Expr) of {'EXIT', _} -> - report("bad argument: '~s':", [A]), + report("bad argument: '~ts':", [A]), exit(error); Term -> Term end; {error, _, D} -> - report("error parsing argument '~s'", [A]), + report("error parsing argument '~ts'", [A]), error(D), exit(error) end. diff --git a/lib/edoc/src/edoc_tags.erl b/lib/edoc/src/edoc_tags.erl index 2d986988c2..eb41f1922a 100644 --- a/lib/edoc/src/edoc_tags.erl +++ b/lib/edoc/src/edoc_tags.erl @@ -391,10 +391,10 @@ parse_header(Data, Line, Env, Where) when is_list(Where) -> -spec throw_error(line(), err()) -> no_return(). throw_error(L, {read_file, File, R}) -> - throw_error(L, {"error reading file '~s': ~w", + throw_error(L, {"error reading file '~ts': ~w", [edoc_lib:filename(File), R]}); throw_error(L, {file_not_found, F}) -> - throw_error(L, {"file not found: ~s", [F]}); + throw_error(L, {"file not found: ~ts", [F]}); throw_error(L, file_not_string) -> throw_error(L, "expected file name as a string"); throw_error(L, D) -> diff --git a/lib/edoc/src/edoc_wiki.erl b/lib/edoc/src/edoc_wiki.erl index cc0529d2a9..5d0d78bf3c 100644 --- a/lib/edoc/src/edoc_wiki.erl +++ b/lib/edoc/src/edoc_wiki.erl @@ -295,7 +295,7 @@ expand_uri([], _, L, _Ss, Us, _As) -> expand_uri_error(Us, L) -> {Ps, _} = edoc_lib:split_at(lists:reverse(Us), $:), - throw_error(L, {"reference '[~s:...' ended unexpectedly", [Ps]}). + throw_error(L, {"reference '[~ts:...' ended unexpectedly", [Ps]}). push_uri(Us, Ss, As) -> diff --git a/lib/erl_interface/src/auxdir/config.guess b/lib/erl_interface/src/auxdir/config.guess index 38a833903b..f475ceb413 100755 --- a/lib/erl_interface/src/auxdir/config.guess +++ b/lib/erl_interface/src/auxdir/config.guess @@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-05-17' +timestamp='2013-02-12' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -17,26 +15,22 @@ timestamp='2007-05-17' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <[email protected]>. -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. # -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# Please send patches with a ChangeLog entry to [email protected]. + me=`echo "$0" | sed -e 's,.*/,,'` @@ -56,8 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -144,7 +137,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward @@ -170,7 +163,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -180,7 +173,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -201,6 +194,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} @@ -223,7 +220,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on @@ -269,7 +266,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead @@ -295,12 +295,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo s390-ibm-zvmoe exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 + echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) + arm*:riscos:*:*|arm*:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) @@ -324,14 +324,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; - i86pc:SunOS:5.*:* | ix86xen:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -375,23 +394,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; @@ -461,8 +480,8 @@ EOF echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -475,7 +494,7 @@ EOF else echo i586-dg-dgux${UNAME_RELEASE} fi - exit ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; @@ -532,7 +551,7 @@ EOF echo rs6000-ibm-aix3.2 fi exit ;; - *:AIX:*:[45]) + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -575,52 +594,52 @@ EOF 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -640,7 +659,7 @@ EOF # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -711,22 +730,22 @@ EOF exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; @@ -750,14 +769,14 @@ EOF exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} @@ -769,40 +788,51 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in amd64) echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 + exit ;; *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - *:Interix*:[3456]*) - case ${UNAME_MACHINE} in - x86) + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) echo i586-pc-interix${UNAME_RELEASE} exit ;; - EM64T | authenticamd) + authenticamd | genuineintel | EM64T) echo x86_64-unknown-interix${UNAME_RELEASE} exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we @@ -832,20 +862,68 @@ EOF i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; - arm*:Linux:*:*) + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) - echo cris-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) - echo frv-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -856,74 +934,36 @@ EOF m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + padre:Linux:*:*) + echo sparc-unknown-linux-gnu exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level @@ -933,14 +973,17 @@ EOF *) echo hppa-unknown-linux-gnu ;; esac exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -948,81 +991,18 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - tile:Linux:*:*) - echo tile-unknown-linux-gnu + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - xtensa:Linux:*:*) - echo xtensa-unknown-linux-gnu + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both @@ -1030,11 +1010,11 @@ EOF echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) @@ -1051,7 +1031,7 @@ EOF i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) @@ -1066,7 +1046,7 @@ EOF fi exit ;; i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; @@ -1094,10 +1074,13 @@ EOF exit ;; pc:*:*:*) # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; @@ -1132,8 +1115,18 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; @@ -1146,7 +1139,7 @@ EOF rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) @@ -1166,10 +1159,10 @@ EOF echo ns32k-sni-sysv fi exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <[email protected]> - echo i586-unisys-sysv4 - exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <[email protected]> + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <[email protected]>. # How about differentiating between stratus architectures? -djm @@ -1195,11 +1188,11 @@ EOF exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; @@ -1209,6 +1202,12 @@ EOF BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; @@ -1236,6 +1235,16 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1251,7 +1260,10 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NSE-?:NONSTOP_KERNEL:*:*) + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) @@ -1296,13 +1308,13 @@ EOF echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} + echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` + UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; @@ -1317,11 +1329,14 @@ EOF i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; esac -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ @@ -1339,11 +1354,11 @@ main () #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif @@ -1477,9 +1492,9 @@ This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff --git a/lib/erl_interface/src/auxdir/config.sub b/lib/erl_interface/src/auxdir/config.sub index f43233b104..bb6edbdb47 100755 --- a/lib/erl_interface/src/auxdir/config.sub +++ b/lib/erl_interface/src/auxdir/config.sub @@ -1,44 +1,40 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-04-29' +timestamp='2013-02-12' -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# Please send patches with a ChangeLog entry to [email protected]. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -72,8 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -120,12 +115,18 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ - uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] @@ -148,10 +149,13 @@ case $os in -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray) + -apple | -axis | -knuth | -cray | -microblaze*) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -166,10 +170,10 @@ case $os in os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; @@ -214,6 +218,12 @@ case $os in -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; -lynx*) os=-lynxos ;; @@ -238,24 +248,34 @@ case $basic_machine in # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ + | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | arc \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ + | epiphany \ | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | mcore | mep \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ @@ -266,31 +286,45 @@ case $basic_machine in | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ | mt \ | msp430 \ - | nios | nios2 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | or32 \ + | open8 \ + | or1k | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ + | rl78 | rx \ | score \ - | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu | strongarm \ - | tahoe | thumb | tic4x | tic80 | tron \ - | v850 | v850e \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; @@ -300,6 +334,21 @@ case $basic_machine in basic_machine=mt-unknown ;; + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; + # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. @@ -314,29 +363,37 @@ case $basic_machine in # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ + | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* | avr32-* \ + | be32-* | be64-* \ | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ @@ -347,31 +404,41 @@ case $basic_machine in | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ - | nios-* | nios2-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ - | xstormy16-* | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -389,7 +456,7 @@ case $basic_machine in basic_machine=a29k-amd os=-udi ;; - abacus) + abacus) basic_machine=abacus-unknown ;; adobe68k) @@ -435,6 +502,10 @@ case $basic_machine in basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -443,10 +514,35 @@ case $basic_machine in basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -475,8 +571,8 @@ case $basic_machine in basic_machine=craynv-cray os=-unicosmp ;; - cr16c) - basic_machine=cr16c-unknown + cr16 | cr16-*) + basic_machine=cr16-unknown os=-elf ;; crds | unos) @@ -514,6 +610,10 @@ case $basic_machine in basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp @@ -629,7 +729,6 @@ case $basic_machine in i370-ibm* | ibm*) basic_machine=i370-ibm ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 @@ -668,6 +767,14 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -679,6 +786,13 @@ case $basic_machine in basic_machine=ns32k-utek os=-sysv ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; mingw32) basic_machine=i386-pc os=-mingw32 @@ -715,10 +829,18 @@ case $basic_machine in ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -783,6 +905,12 @@ case $basic_machine in np1) basic_machine=np1-gould ;; + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem + ;; nsr-tandem) basic_machine=nsr-tandem ;; @@ -813,6 +941,14 @@ case $basic_machine in basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -857,9 +993,10 @@ case $basic_machine in ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -884,7 +1021,11 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; - rdos) + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) basic_machine=i386-pc os=-rdos ;; @@ -953,6 +1094,9 @@ case $basic_machine in basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -1009,17 +1153,9 @@ case $basic_machine in basic_machine=t90-cray os=-unicos ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -1027,10 +1163,6 @@ case $basic_machine in tx39el) basic_machine=mipstx39el-unknown ;; - tile*) - basic_machine=tile-tilera - os=-linux-gnu - ;; toad1) basic_machine=pdp10-xkl os=-tops20 @@ -1092,6 +1224,9 @@ case $basic_machine in xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1100,6 +1235,10 @@ case $basic_machine in basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1138,7 +1277,7 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) @@ -1185,9 +1324,12 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1208,21 +1350,23 @@ case $os in # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -openbsd* | -solidbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ @@ -1230,7 +1374,7 @@ case $os in | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1269,7 +1413,7 @@ case $os in -opened*) os=-openedition ;; - -os400*) + -os400*) os=-os400 ;; -wince*) @@ -1318,7 +1462,7 @@ case $os in -sinix*) os=-sysv4 ;; - -tpf*) + -tpf*) os=-tpf ;; -triton*) @@ -1354,12 +1498,14 @@ case $os in -aros*) os=-aros ;; - -kaos*) - os=-kaos - ;; -zvmoe) os=-zvmoe ;; + -dicos*) + os=-dicos + ;; + -nacl*) + ;; -none) ;; *) @@ -1382,10 +1528,10 @@ else # system, and we'll never get to this point. case $basic_machine in - score-*) + score-*) os=-elf ;; - spu-*) + spu-*) os=-elf ;; *-acorn) @@ -1397,8 +1543,20 @@ case $basic_machine in arm*-semi) os=-aout ;; - c4x-* | tic4x-*) - os=-coff + c4x-* | tic4x-*) + os=-coff + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff ;; # This must come before the *-dec entry. pdp10-*) @@ -1418,14 +1576,11 @@ case $basic_machine in ;; m68000-sun) os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 ;; m68*-cisco) os=-aout ;; - mep-*) + mep-*) os=-elf ;; mips*-cisco) @@ -1434,6 +1589,9 @@ case $basic_machine in mips*-*) os=-elf ;; + or1k-*) + os=-elf + ;; or32-*) os=-coff ;; @@ -1452,7 +1610,7 @@ case $basic_machine in *-ibm) os=-aix ;; - *-knuth) + *-knuth) os=-mmixware ;; *-wec) @@ -1557,7 +1715,7 @@ case $basic_machine in -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1628,3 +1786,4 @@ exit # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: + diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 1e298a8d06..0a2c6e822f 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -736,9 +736,6 @@ type(erlang, is_tuple, 1, Xs) -> %% Guard bif, needs to be here. type(erlang, length, 1, Xs) -> strict(arg_types(erlang, length, 1), Xs, fun (_) -> t_non_neg_fixnum() end); -type(erlang, list_to_integer, 2, Xs) -> - strict(arg_types(erlang, list_to_integer, 2), Xs, - fun (_) -> t_integer() end); type(erlang, make_tuple, 2, Xs) -> strict(arg_types(erlang, make_tuple, 2), Xs, fun ([Int, _]) -> @@ -2231,8 +2228,6 @@ arg_types(erlang, is_tuple, 1) -> %% Guard bif, needs to be here. arg_types(erlang, length, 1) -> [t_list()]; -arg_types(erlang, list_to_integer, 2) -> - [t_list(t_byte()), t_from_range(2, 36)]; arg_types(erlang, make_tuple, 2) -> [t_non_neg_fixnum(), t_any()]; % the value 0 is OK as first argument arg_types(erlang, make_tuple, 3) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 532b2e43cd..d1243b2325 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -205,7 +205,7 @@ t_var/1, t_var_name/1, %% t_assign_variables_to_subtype/2, - type_is_defined/3, + type_is_defined/4, record_field_diffs_to_string/2, subst_all_vars_to_any/1, lift_list_to_pos_empty/1, @@ -544,12 +544,12 @@ t_opaque_from_records(RecDict) -> OpaqueRecDict = dict:filter(fun(Key, _Value) -> case Key of - {opaque, _Name} -> true; + {opaque, _Name, _Arity} -> true; _ -> false end end, RecDict), OpaqueTypeDict = - dict:map(fun({opaque, Name}, {Module, Type, ArgNames}) -> + dict:map(fun({opaque, Name, _Arity}, {Module, Type, ArgNames}) -> case ArgNames of [] -> t_opaque(Module, Name, [], t_from_form(Type, RecDict)); @@ -707,8 +707,8 @@ t_solve_remote_type(#remote{mod = RemMod, name = Name, args = Args} = RemType, MFA = {RemMod, Name, ArgsLen}, case sets:is_element(MFA, ET) of true -> - case lookup_type(Name, RemDict) of - {type, {_Mod, Type, ArgNames}} when ArgsLen =:= length(ArgNames) -> + case lookup_type(Name, ArgsLen, RemDict) of + {type, {_Mod, Type, ArgNames}} -> {NewType, NewCycle, NewRR} = case can_unfold_more(RemType, C) of true -> @@ -726,7 +726,7 @@ t_solve_remote_type(#remote{mod = RemMod, name = Name, args = Args} = RemType, false -> RT end, {RT1, RetRR}; - {opaque, {Mod, Type, ArgNames}} when ArgsLen =:= length(ArgNames) -> + {opaque, {Mod, Type, ArgNames}} -> List = lists:zip(ArgNames, Args), TmpVarDict = dict:from_list(List), {Rep, NewCycle, NewRR} = @@ -746,12 +746,6 @@ t_solve_remote_type(#remote{mod = RemMod, name = Name, args = Args} = RemType, {t_from_form({opaque, -1, Name, {Mod, Args, RT1}}, RemDict, TmpVarDict), RetRR}; - {type, _} -> - Msg = io_lib:format("Unknown remote type ~w\n", [Name]), - throw({error, Msg}); - {opaque, _} -> - Msg = io_lib:format("Unknown remote opaque type ~w\n", [Name]), - throw({error, Msg}); error -> Msg = io_lib:format("Unable to find remote type ~w:~w()\n", [RemMod, Name]), @@ -3241,6 +3235,8 @@ t_to_string(?bitstr(0, 0), _RecDict) -> "<<>>"; t_to_string(?bitstr(8, 0), _RecDict) -> "binary()"; +t_to_string(?bitstr(1, 0), _RecDict) -> + "bitstring()"; t_to_string(?bitstr(0, B), _RecDict) -> lists:flatten(io_lib:format("<<_:~w>>", [B])); t_to_string(?bitstr(U, 0), _RecDict) -> @@ -3680,8 +3676,9 @@ t_from_form({type, _L, union, Args}, TypeNames, InOpaque, RecDict, VarDict) -> {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict), {t_sup(L), R}; t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> - case lookup_type(Name, RecDict) of - {type, {_Module, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> + ArgsLen = length(Args), + case lookup_type(Name, ArgsLen, RecDict) of + {type, {_Module, Type, ArgNames}} -> case can_unfold_more({type, Name}, TypeNames) of true -> List = lists:zipwith( @@ -3701,7 +3698,7 @@ t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> end; false -> {t_any(), [{type, Name}]} end; - {opaque, {Module, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> + {opaque, {Module, Type, ArgNames}} -> {Rep, Rret} = case can_unfold_more({opaque, Name}, TypeNames) of true -> @@ -3730,12 +3727,9 @@ t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> RecDict, VarDict) end, {Tret, Rret}; - {type, _} -> - throw({error, io_lib:format("Unknown type ~w\n", [Name])}); - {opaque, _} -> - throw({error, io_lib:format("Unknown opaque type ~w\n", [Name])}); error -> - throw({error, io_lib:format("Unable to find type ~w\n", [Name])}) + Msg = io_lib:format("Unable to find type ~w/~w\n", [Name, ArgsLen]), + throw({error, Msg}) end; t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _InOpaque, _RecDict, _VarDict) -> @@ -3870,12 +3864,14 @@ t_form_to_string({type, _L, binary, [Base, Unit]} = Type) -> case {U, B} of {0, 0} -> "<<>>"; {8, 0} -> "binary()"; + {1, 0} -> "bitstring()"; {0, B} -> lists:flatten(io_lib:format("<<_:~w>>", [B])); {U, 0} -> lists:flatten(io_lib:format("<<_:_*~w>>", [U])); {U, B} -> lists:flatten(io_lib:format("<<_:~w,_:_*~w>>", [B, U])) end; _ -> io_lib:format("Badly formed bitstr type ~w", [Type]) end; +t_form_to_string({type, _L, bitstring, []}) -> "bitstring()"; t_form_to_string({type, _L, 'fun', []}) -> "fun()"; t_form_to_string({type, _L, 'fun', [{type, _, any}, Range]}) -> "fun(...) -> " ++ t_form_to_string(Range); @@ -3986,20 +3982,20 @@ lookup_record(Tag, Arity, RecDict) when is_atom(Tag) -> error -> error end. -lookup_type(Name, RecDict) -> - case dict:find({type, Name}, RecDict) of +lookup_type(Name, Arity, RecDict) -> + case dict:find({type, Name, Arity}, RecDict) of error -> - case dict:find({opaque, Name}, RecDict) of + case dict:find({opaque, Name, Arity}, RecDict) of error -> error; {ok, Found} -> {opaque, Found} end; {ok, Found} -> {type, Found} end. --spec type_is_defined('type' | 'opaque', atom(), dict()) -> boolean(). +-spec type_is_defined('type' | 'opaque', atom(), arity(), dict()) -> boolean(). -type_is_defined(TypeOrOpaque, Name, RecDict) -> - dict:is_key({TypeOrOpaque, Name}, RecDict). +type_is_defined(TypeOrOpaque, Name, Arity, RecDict) -> + dict:is_key({TypeOrOpaque, Name, Arity}, RecDict). can_unfold_more(TypeName, TypeNames) -> Fun = fun(E, Acc) -> case E of TypeName -> Acc + 1; _ -> Acc end end, diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java index cea5080607..968f284bff 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java @@ -118,8 +118,9 @@ public class AbstractNode { localHost = "localhost"; } - final String dotCookieFilename = System.getProperty("user.home") - + File.separator + ".erlang.cookie"; + final String homeDir = getHomeDir(); + final String dotCookieFilename = homeDir + File.separator + + ".erlang.cookie"; BufferedReader br = null; try { @@ -251,4 +252,15 @@ public class AbstractNode { public String toString() { return node(); } + + private static String getHomeDir() { + final String home = System.getProperty("user.home"); + if (System.getProperty("os.name").toLowerCase().contains("windows")) { + final String drive = System.getenv("HOMEDRIVE"); + final String path = System.getenv("HOMEPATH"); + return (drive != null && path != null) ? drive + path : home; + } else { + return home; + } + } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java index 47ec3cc052..78f47aa32f 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java @@ -26,6 +26,7 @@ import java.math.BigDecimal; import java.math.BigInteger; import java.text.DecimalFormat; import java.util.Arrays; +import java.util.zip.Deflater; /** * Provides a stream for encoding Erlang terms to external format, for @@ -48,6 +49,8 @@ public class OtpOutputStream extends ByteArrayOutputStream { private static final BigDecimal ten = new BigDecimal(10.0); private static final BigDecimal one = new BigDecimal(1.0); + private int fixedSize = Integer.MAX_VALUE; + /** * Create a stream with the default initial size (2048 bytes). */ @@ -101,10 +104,16 @@ public class OtpOutputStream extends ByteArrayOutputStream { * the storage of an <tt>OtpOutputStream</tt> instance. */ public void trimToSize() { - if (super.count < super.buf.length) { - final byte[] tmp = new byte[super.count]; - System.arraycopy(super.buf, 0, tmp, 0, super.count); + resize(super.count); + } + + private void resize(int size) { + if (size < super.buf.length) { + final byte[] tmp = new byte[size]; + System.arraycopy(super.buf, 0, tmp, 0, size); super.buf = tmp; + } else if (size > super.buf.length) { + ensureCapacity(size); } } @@ -116,6 +125,9 @@ public class OtpOutputStream extends ByteArrayOutputStream { * @param minCapacity the desired minimum capacity */ public void ensureCapacity(int minCapacity) { + if (minCapacity > fixedSize) { + throw new IllegalArgumentException("Trying to increase fixed-size buffer"); + } int oldCapacity = super.buf.length; if (minCapacity > oldCapacity) { int newCapacity = (oldCapacity * 3)/2 + 1; @@ -123,6 +135,7 @@ public class OtpOutputStream extends ByteArrayOutputStream { newCapacity = oldCapacity + defaultIncrement; if (newCapacity < minCapacity) newCapacity = minCapacity; + newCapacity = Math.min(fixedSize, newCapacity); // minCapacity is usually close to size, so this is a win: final byte[] tmp = new byte[newCapacity]; System.arraycopy(super.buf, 0, tmp, 0, super.count); @@ -142,19 +155,37 @@ public class OtpOutputStream extends ByteArrayOutputStream { super.buf[super.count++] = b; } - /** - * Write an array of bytes to the stream. - * - * @param buf - * the array of bytes to write. - * + /* (non-Javadoc) + * @see java.io.ByteArrayOutputStream#write(byte[]) */ - @Override public void write(final byte[] buf) { - ensureCapacity(super.count + buf.length); - System.arraycopy(buf, 0, super.buf, super.count, buf.length); - super.count += buf.length; + // don't assume that super.write(byte[]) calls write(buf, 0, buf.length) + write(buf, 0, buf.length); + } + + /* (non-Javadoc) + * @see java.io.ByteArrayOutputStream#write(int) + */ + @Override + public synchronized void write(int b) { + ensureCapacity(super.count + 1); + super.buf[super.count] = (byte) b; + count += 1; + } + + /* (non-Javadoc) + * @see java.io.ByteArrayOutputStream#write(byte[], int, int) + */ + @Override + public synchronized void write(byte[] b, int off, int len) { + if ((off < 0) || (off > b.length) || (len < 0) + || ((off + len) - b.length > 0)) { + throw new IndexOutOfBoundsException(); + } + ensureCapacity(super.count + len); + System.arraycopy(b, off, super.buf, super.count, len); + super.count += len; } /** @@ -819,24 +850,77 @@ public class OtpOutputStream extends ByteArrayOutputStream { /** * Write an arbitrary Erlang term to the stream in compressed format. - * + * * @param o - * the Erlang tem to write. + * the Erlang term to write. */ public void write_compressed(final OtpErlangObject o) { + write_compressed(o, Deflater.DEFAULT_COMPRESSION); + } + + /** + * Write an arbitrary Erlang term to the stream in compressed format. + * + * @param o + * the Erlang term to write. + * @param level + * the compression level (<tt>0..9</tt>) + */ + public void write_compressed(final OtpErlangObject o, int level) { final OtpOutputStream oos = new OtpOutputStream(o); - write1(OtpExternal.compressedTag); - write4BE(oos.size()); - final java.io.FilterOutputStream fos = new java.io.FilterOutputStream( - this); - final java.util.zip.DeflaterOutputStream dos = new java.util.zip.DeflaterOutputStream( - fos); - try { - oos.writeTo(dos); - dos.close(); - } catch (final IOException e) { - throw new java.lang.IllegalArgumentException( - "Intremediate stream failed for Erlang object " + o); + /* + * similar to erts_term_to_binary() in external.c: + * We don't want to compress if compression actually increases the size. + * Since compression uses 5 extra bytes (COMPRESSED tag + size), don't + * compress if the original term is smaller. + */ + if (oos.size() < 5) { + // fast path for small terms + try { + oos.writeTo(this); + // if the term is written as a compressed term, the output + // stream is closed, so we do this here, too + this.close(); + } catch (IOException e) { + throw new java.lang.IllegalArgumentException( + "Intermediate stream failed for Erlang object " + o); + } + } else { + int startCount = super.count; + // we need destCount bytes for an uncompressed term + // -> if compression uses more, use the uncompressed term! + int destCount = startCount + oos.size(); + this.fixedSize = destCount; + Deflater def = new Deflater(level); + final java.util.zip.DeflaterOutputStream dos = new java.util.zip.DeflaterOutputStream( + this, def); + try { + write1(OtpExternal.compressedTag); + write4BE(oos.size()); + oos.writeTo(dos); + dos.close(); // note: closes this, too! + } catch (final IllegalArgumentException e) { + // discard further un-compressed data + // -> if not called, there may be memory leaks! + def.end(); + // could not make the value smaller than originally + // -> reset to starting count, write uncompressed + super.count = startCount; + try { + oos.writeTo(this); + // if the term is written as a compressed term, the output + // stream is closed, so we do this here, too + this.close(); + } catch (IOException e2) { + throw new java.lang.IllegalArgumentException( + "Intermediate stream failed for Erlang object " + o); + } + } catch (final IOException e) { + throw new java.lang.IllegalArgumentException( + "Intermediate stream failed for Erlang object " + o); + } finally { + this.fixedSize = Integer.MAX_VALUE; + } } } diff --git a/lib/jinterface/test/nc_SUITE.erl b/lib/jinterface/test/nc_SUITE.erl index 1f66366731..63c78ebdaa 100644 --- a/lib/jinterface/test/nc_SUITE.erl +++ b/lib/jinterface/test/nc_SUITE.erl @@ -208,7 +208,10 @@ decompress_roundtrip(Config) when is_list(Config) -> <<RandomBin1M:1048576/binary,_/binary>> = RandomBin, <<RandomBin10M:10485760/binary,_/binary>> = RandomBin, Terms = - [0.0, + [{}, + {a,b,c}, + [], + 0.0, math:sqrt(2), <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,31:5>>, RandomBin1k, @@ -234,7 +237,10 @@ compress_roundtrip(Config) when is_list(Config) -> <<RandomBin1M:1048576/binary,_/binary>> = RandomBin, <<RandomBin10M:10485760/binary,_/binary>> = RandomBin, Terms = - [0.0, + [{}, + {a,b,c}, + [], + 0.0, math:sqrt(2), <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,31:5>>, RandomBin1k, diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index a96da0fb4e..069b13eacf 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -110,6 +110,9 @@ <name name="filename"/> </datatype> <datatype> + <name name="filename_all"/> + </datatype> + <datatype> <name name="io_device"/> <desc> <p>As returned by diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index 1602745669..9ed2c7a7d9 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -495,6 +495,8 @@ init(Init, Kernel) -> {'EXIT', LoadError} -> Reason = {'load error', LoadError}, Init ! {ack, self(), {error, to_string(Reason)}}; + {error, Error} -> + Init ! {ack, self(), {error, to_string(Error)}}; {ok, NewS} -> Init ! {ack, self(), ok}, gen_server:enter_loop(?MODULE, [], NewS, diff --git a/lib/kernel/src/auth.erl b/lib/kernel/src/auth.erl index 1e12a647d7..7d463103e3 100644 --- a/lib/kernel/src/auth.erl +++ b/lib/kernel/src/auth.erl @@ -391,7 +391,7 @@ create_cookie(Name) -> {error,Reason} -> {error, lists:flatten( - io_lib:format("Failed to create cookie file '~s': ~p", [Name, Reason]))} + io_lib:format("Failed to create cookie file '~ts': ~p", [Name, Reason]))} end. random_cookie(0, _, Result) -> diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index e7a0451011..5f52f94270 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -27,12 +27,12 @@ -export([format_error/1]). %% File system and metadata. -export([get_cwd/0, get_cwd/1, set_cwd/1, delete/1, rename/2, - make_dir/1, del_dir/1, list_dir/1, + make_dir/1, del_dir/1, list_dir/1, list_dir_all/1, read_file_info/1, read_file_info/2, write_file_info/2, write_file_info/3, altname/1, read_link_info/1, read_link_info/2, - read_link/1, + read_link/1, read_link_all/1, make_link/2, make_symlink/2, read_file/1, write_file/2, write_file/3]). %% Specialized @@ -67,8 +67,8 @@ -export([ipread_s32bu_p32bu_int/3]). %% Types that can be used from other modules -- alphabetically ordered. --export_type([date_time/0, fd/0, file_info/0, filename/0, io_device/0, - name/0, posix/0]). +-export_type([date_time/0, fd/0, file_info/0, filename/0, filename_all/0, + io_device/0, name/0, posix/0]). %%% Includes and defines -include("file.hrl"). @@ -80,7 +80,8 @@ -define(RAM_FILE, ram_file). % Module %% data types --type filename() :: string() | binary(). +-type filename() :: string(). +-type filename_all() :: string() | binary(). -type file_info() :: #file_info{}. -type fd() :: #file_descriptor{}. -type io_device() :: pid() | fd(). @@ -278,6 +279,14 @@ read_link_info(Name, Opts) when is_list(Opts) -> read_link(Name) -> check_and_call(read_link, [file_name(Name)]). +-spec read_link_all(Name) -> {ok, Filename} | {error, Reason} when + Name :: name(), + Filename :: filename_all(), + Reason :: posix() | badarg. + +read_link_all(Name) -> + check_and_call(read_link_all, [file_name(Name)]). + -spec write_file_info(Filename, FileInfo) -> ok | {error, Reason} when Filename :: name(), FileInfo :: file_info(), @@ -303,6 +312,14 @@ write_file_info(Name, Info = #file_info{}, Opts) when is_list(Opts) -> list_dir(Name) -> check_and_call(list_dir, [file_name(Name)]). +-spec list_dir_all(Dir) -> {ok, Filenames} | {error, Reason} when + Dir :: name(), + Filenames :: [filename_all()], + Reason :: posix() | badarg. + +list_dir_all(Name) -> + check_and_call(list_dir_all, [file_name(Name)]). + -spec read_file(Filename) -> {ok, Binary} | {error, Reason} when Filename :: name(), Binary :: binary(), diff --git a/lib/kernel/src/file_server.erl b/lib/kernel/src/file_server.erl index fc6cd823c9..6b413ff630 100644 --- a/lib/kernel/src/file_server.erl +++ b/lib/kernel/src/file_server.erl @@ -136,6 +136,8 @@ handle_call({del_dir, Name}, _From, Handle) -> handle_call({list_dir, Name}, _From, Handle) -> {reply, ?PRIM_FILE:list_dir(Handle, Name), Handle}; +handle_call({list_dir_all, Name}, _From, Handle) -> + {reply, ?PRIM_FILE:list_dir_all(Handle, Name), Handle}; handle_call(get_cwd, _From, Handle) -> {reply, ?PRIM_FILE:get_cwd(Handle), Handle}; @@ -167,6 +169,8 @@ handle_call({read_link_info, Name, Opts}, _From, Handle) -> handle_call({read_link, Name}, _From, Handle) -> {reply, ?PRIM_FILE:read_link(Handle, Name), Handle}; +handle_call({read_link_all, Name}, _From, Handle) -> + {reply, ?PRIM_FILE:read_link_all(Handle, Name), Handle}; handle_call({make_link, Old, New}, _From, Handle) -> {reply, ?PRIM_FILE:make_link(Handle, Old, New), Handle}; diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl index ec13ab6d2e..23867300a5 100644 --- a/lib/kernel/src/gen_tcp.erl +++ b/lib/kernel/src/gen_tcp.erl @@ -256,7 +256,7 @@ close(S) -> -spec send(Socket, Packet) -> ok | {error, Reason} when Socket :: socket(), Packet :: iodata(), - Reason :: inet:posix(). + Reason :: closed | inet:posix(). send(S, Packet) when is_port(S) -> case inet_db:lookup_socket(S) of diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index d8dac7d3a6..79d11c155c 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -716,7 +716,7 @@ analyse([], [This={M,F,A}|Path], Visited, ErrCnt0) -> %% These modules should be loaded by code.erl before %% the code_server is started. OK = [erlang, os, prim_file, erl_prim_loader, init, ets, - code_server, lists, lists_sort, unicode, binary, filename, packages, + code_server, lists, lists_sort, unicode, binary, filename, gb_sets, gb_trees, hipe_unified_loader, hipe_bifs, prim_zip, zlib], ErrCnt1 = @@ -1594,7 +1594,7 @@ native_early_modules_1(Architecture) -> ?line true = lists:all(fun code:is_module_native/1, [ets,file,filename,gb_sets,gb_trees, %%hipe_unified_loader, no_native as workaround - lists,os,packages]), + lists,os]), ok end. diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index ac991b1111..eda901f3d6 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -45,6 +45,7 @@ init_per_testcase/2, end_per_testcase/2, read_write_file/1, names/1]). -export([cur_dir_0/1, cur_dir_1/1, make_del_dir/1, + list_dir/1,list_dir_error/1, untranslatable_names/1, pos1/1, pos2/1]). -export([close/1, consult1/1, path_consult/1, delete/1]). -export([ eval1/1, path_eval/1, script1/1, path_script/1, @@ -115,7 +116,8 @@ all() -> read_line_4, standard_io]. groups() -> - [{dirs, [], [make_del_dir, cur_dir_0, cur_dir_1]}, + [{dirs, [], [make_del_dir, cur_dir_0, cur_dir_1, + list_dir, list_dir_error, untranslatable_names]}, {files, [], [{group, open}, {group, pos}, {group, file_info}, {group, consult}, {group, eval}, {group, script}, @@ -519,6 +521,114 @@ win_cur_dir_1(_Config) -> ok. + +%%% +%%% Test list_dir() on a non-existing pathname. +%%% + +list_dir_error(Config) -> + Priv = ?config(priv_dir, Config), + NonExisting = filename:join(Priv, "non-existing-dir"), + {error,enoent} = ?FILE_MODULE:list_dir(NonExisting), + ok. + +%%% +%%% Test list_dir() and list_dir_all(). +%%% + +list_dir(Config) -> + RootDir = ?config(priv_dir, Config), + TestDir = filename:join(RootDir, ?MODULE_STRING++"_list_dir"), + ?FILE_MODULE:make_dir(TestDir), + list_dir_1(TestDir, 42, []). + +list_dir_1(TestDir, 0, Sorted) -> + [ok = ?FILE_MODULE:delete(filename:join(TestDir, F)) || + F <- Sorted], + ok = ?FILE_MODULE:del_dir(TestDir); +list_dir_1(TestDir, Cnt, Sorted0) -> + Base = "file" ++ integer_to_list(Cnt), + Name = filename:join(TestDir, Base), + ok = ?FILE_MODULE:write_file(Name, Base), + Sorted = lists:merge([Base], Sorted0), + {ok,DirList0} = ?FILE_MODULE:list_dir(TestDir), + {ok,DirList1} = ?FILE_MODULE:list_dir_all(TestDir), + Sorted = lists:sort(DirList0), + Sorted = lists:sort(DirList1), + list_dir_1(TestDir, Cnt-1, Sorted). + +untranslatable_names(Config) -> + case no_untranslatable_names() of + true -> + {skip,"Not a problem on this OS"}; + false -> + untranslatable_names_1(Config) + end. + +untranslatable_names_1(Config) -> + {ok,OldCwd} = file:get_cwd(), + PrivDir = ?config(priv_dir, Config), + Dir = filename:join(PrivDir, "untranslatable_names"), + ok = file:make_dir(Dir), + Node = start_node(untranslatable_names, "+fnu"), + try + ok = file:set_cwd(Dir), + [ok = file:write_file(F, F) || {_,F} <- untranslatable_names()], + + ExpectedListDir0 = [unicode:characters_to_list(N, utf8) || + {utf8,N} <- untranslatable_names()], + ExpectedListDir = lists:sort(ExpectedListDir0), + io:format("ExpectedListDir: ~p\n", [ExpectedListDir]), + ExpectedListDir = call_and_sort(Node, file, list_dir, [Dir]), + + ExpectedListDirAll0 = [case Enc of + utf8 -> + unicode:characters_to_list(N, utf8); + latin1 -> + N + end || {Enc,N} <- untranslatable_names()], + ExpectedListDirAll = lists:sort(ExpectedListDirAll0), + io:format("ExpectedListDirAll: ~p\n", [ExpectedListDirAll]), + ExpectedListDirAll = call_and_sort(Node, file, list_dir_all, [Dir]) + after + catch test_server:stop_node(Node), + file:set_cwd(OldCwd), + [file:delete(F) || {_,F} <- untranslatable_names()], + file:del_dir(Dir) + end, + ok. + +untranslatable_names() -> + [{utf8,<<"abc">>}, + {utf8,<<"def">>}, + {utf8,<<"Lagerl",195,182,"f">>}, + {utf8,<<195,150,"stra Emterwik">>}, + {latin1,<<"M",229,"rbacka">>}, + {latin1,<<"V",228,"rmland">>}]. + +call_and_sort(Node, M, F, A) -> + {ok,Res} = rpc:call(Node, M, F, A), + lists:sort(Res). + +no_untranslatable_names() -> + case os:type() of + {unix,darwin} -> true; + {win32,_} -> true; + _ -> false + end. + +start_node(Name, Args) -> + [_,Host] = string:tokens(atom_to_list(node()), "@"), + ct:log("Trying to start ~w@~s~n", [Name,Host]), + case test_server:start_node(Name, peer, [{args,Args}]) of + {error,Reason} -> + test_server:fail(Reason); + {ok,Node} -> + ct:log("Node ~p started~n", [Node]), + Node + end. + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2453,6 +2563,7 @@ symlinks(suite) -> []; symlinks(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(10)), ?line {error, _} = ?FILE_MODULE:read_link(lists:duplicate(10000,$a)), + {error, _} = ?FILE_MODULE:read_link_all(lists:duplicate(10000,$a)), ?line RootDir = ?config(priv_dir, Config), ?line NewDir = filename:join(RootDir, atom_to_list(?MODULE) @@ -2476,6 +2587,7 @@ symlinks(Config) when is_list(Config) -> ?line {ok, Info2} = ?FILE_MODULE:read_link_info(Alias), ?line #file_info{links=1, type=symlink} = Info2, ?line {ok, Name} = ?FILE_MODULE:read_link(Alias), + {ok, Name} = ?FILE_MODULE:read_link_all(Alias), ok end, diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl index 40bde8a736..808a10ee27 100644 --- a/lib/kernel/test/file_name_SUITE.erl +++ b/lib/kernel/test/file_name_SUITE.erl @@ -340,9 +340,9 @@ check_icky(Mod) -> ?line true=(length("åäö") =:= 3), ?line UniMode = file:native_name_encoding() =/= latin1, ?line make_icky_dir(Mod), - ?line {ok, L0} = Mod:list_dir("."), + {ok, L0} = Mod:list_dir_all("."), ?line L1 = lists:sort(L0), - io:format("~p ~p~n",[L1,list(icky_dir())]), + io:format("~p~n~p~n~n",[L1,lists:sort(list(icky_dir()))]), ?line L1 = lists:sort(convlist(list(icky_dir()))), ?line {ok,D2} = Mod:get_cwd(), ?line true = is_list(D2), @@ -357,7 +357,8 @@ check_icky(Mod) -> ?line Syms = [ {S,conv(Targ),list_to_binary(get_data(Targ,icky_dir()))} || {T,S,Targ} <- icky_dir(), T =:= symlink ], ?line [ {ok, Cont} = Mod:read_file(SymL) || {SymL,_,Cont} <- Syms ], - ?line [ {ok, Targ} = fixlink(Mod:read_link(SymL)) || {SymL,Targ,_} <- Syms ], + [ {ok, Targ} = fixlink(Mod:read_link_all(SymL)) || + {SymL,Targ,_} <- Syms ], ?line chk_cre_dir(Mod,[{directory,"åäö_dir",icky_dir()}]), ?line {ok,BeginAt} = Mod:get_cwd(), ?line true = is_list(BeginAt), @@ -369,7 +370,7 @@ check_icky(Mod) -> ?line ok = Mod:set_cwd(".."), ?line {ok,BeginAt} = Mod:get_cwd(), ?line rm_r2(Mod,"åäö_dir"), - {OS,TYPE} = os:type(), + {OS,_} = os:type(), % Check that treat_icky really converts to the same as the OS case UniMode of true -> @@ -377,7 +378,7 @@ check_icky(Mod) -> ?line ok = Mod:set_cwd("åäö_dir"), ?line ok = Mod:write_file(<<"ååå">>,<<"hello">>), ?line Treated = treat_icky(<<"ååå">>), - ?line {ok,[Treated]} = Mod:list_dir("."), + {ok,[Treated]} = Mod:list_dir_all("."), ?line ok = Mod:delete(<<"ååå">>), ?line {ok,[]} = Mod:list_dir("."), ?line ok = Mod:set_cwd(".."), @@ -393,15 +394,7 @@ check_icky(Mod) -> true -> ok end, - ?line ok = Mod:set_cwd(treat_icky(<<"åäö_dir">>)), - ?line {ok, NowAt2} = Mod:get_cwd(), - io:format("~p~n",[NowAt2]), - % Cannot create raw unicode-breaking filenames on windows or macos - ?line true = ((((not UniMode) or (OS =:= win32) or (TYPE=:=darwin)) and is_list(NowAt2)) orelse ((UniMode) and is_binary(NowAt2))), - ?line true = BeginAt =/= NowAt2, - ?line ok = Mod:set_cwd(".."), ?line {ok,BeginAt} = Mod:get_cwd(), - ?line rm_r2(Mod,conv(treat_icky(<<"åäö_dir">>))), case has_links() of true -> ?line ok = Mod:make_link("fil1","nisseö"), @@ -485,7 +478,7 @@ check_very_icky(Mod) -> ok end, ?line make_very_icky_dir(Mod), - ?line {ok, L0} = Mod:list_dir("."), + {ok, L0} = Mod:list_dir_all("."), ?line L1 = lists:sort(L0), ?line L1 = lists:sort(convlist(list(very_icky_dir()))), ?line {ok,D2} = Mod:get_cwd(), @@ -494,7 +487,8 @@ check_very_icky(Mod) -> ?line Syms = [ {S,conv(Targ),list_to_binary(get_data(Targ,very_icky_dir()))} || {T,S,Targ} <- very_icky_dir(), T =:= symlink ], ?line [ {ok, Cont} = Mod:read_file(SymL) || {SymL,_,Cont} <- Syms ], - ?line [ {ok, Targ} = fixlink(Mod:read_link(SymL)) || {SymL,Targ,_} <- Syms ], + ?line [ {ok, Targ} = fixlink(Mod:read_link_all(SymL)) || + {SymL,Targ,_} <- Syms ], ?line chk_cre_dir(Mod,[{directory,[1088,1079,1091]++"_dir",very_icky_dir()}]), ?line {ok,BeginAt} = Mod:get_cwd(), ?line true = is_list(BeginAt), @@ -559,33 +553,6 @@ check_very_icky(Mod) -> FI#file_info{mode = NewMode2}), ?line {ok,#file_info{mode = NewMode2}} = Mod:read_file_info([956,965,963,954,959,49]), - ?line NumOK0 = case has_links() of - true -> 5; - false -> 3 - end, - ?line NumNOK0 = case has_links() of - true -> 4; - false -> 3 - end, - ?line {NumOK,NumNOK} = case is_binary(treat_icky(<<"foo">>)) of - false -> - {NumOK0+NumNOK0,0}; - true -> - {NumOK0,NumNOK0} - end, - ?line {NumOK,NumNOK} = filelib:fold_files(".",".*",true,fun(_F,{N,M}) when is_list(_F) -> io:format("~ts~n",[_F]),{N+1,M}; (_F,{N,M}) -> io:format("~p~n",[_F]),{N,M+1} end,{0,0}), - ?line ok = filelib:fold_files(".",[1076,1089,1072,124,46,42],true,fun(_F,_) -> ok end,false), - ?line SF3 = unicode:characters_to_binary("åäösubfil3", - file:native_name_encoding()), - ?line SF2 = case treat_icky(<<"åäösubfil2">>) of - LF2 when is_list(LF2) -> - unicode:characters_to_binary(LF2, - file:native_name_encoding()); - BF2 -> - BF2 - end, - ?line Sorted = lists:sort([SF3,SF2]), - ?line Sorted = lists:sort(filelib:wildcard("*",<<"åäösubdir2">>)), ok catch throw:need_unicode_mode -> @@ -604,7 +571,7 @@ check_very_icky(Mod) -> rm_rf(Mod,Dir) -> case Mod:read_link_info(Dir) of {ok, #file_info{type = directory}} -> - {ok, Content} = Mod:list_dir(Dir), + {ok, Content} = Mod:list_dir_all(Dir), [ rm_rf(Mod,filename:join(Dir,C)) || C <- Content ], Mod:del_dir(Dir), ok; @@ -619,7 +586,7 @@ rm_r(Mod,Dir) -> case Mod:read_link_info(Dir) of {ok, #file_info{type = directory}} -> {ok,#file_info{type = directory}} = Mod:read_file_info(Dir), - {ok, Content} = Mod:list_dir(Dir), + {ok, Content} = Mod:list_dir_all(Dir), [ true = is_list(Part) || Part <- Content ], [ true = is_list(filename:join(Dir,Part)) || Part <- Content ], [ rm_r(Mod,filename:join(Dir,C)) || C <- Content ], @@ -637,7 +604,7 @@ rm_r2(Mod,Dir) -> case Mod:read_link_info(Dir) of {ok, #file_info{type = directory}} -> {ok,#file_info{type = directory}} = Mod:read_file_info(Dir), - {ok, Content} = Mod:list_dir(Dir), + {ok, Content} = Mod:list_dir_all(Dir), UniMode = file:native_name_encoding() =/= latin1, [ true = (is_list(Part) orelse UniMode) || Part <- Content ], [ true = (is_list(filename:join(Dir,Part)) orelse UniMode) || Part <- Content ], diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 4e93a593b3..4550cb1770 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -49,7 +49,9 @@ make_link_a/1, make_link_b/1, read_link_info_for_non_link/1, symlinks_a/1, symlinks_b/1, - list_dir_limit/1]). + list_dir_limit/1, + list_dir_error/1, + list_dir/1]). -export([advise/1]). -export([large_write/1]). @@ -81,7 +83,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [read_write_file, {group, dirs}, {group, files}, delete_a, delete_b, rename_a, rename_b, {group, errors}, - {group, compression}, {group, links}, list_dir_limit]. + {group, compression}, {group, links}, list_dir_limit, list_dir]. groups() -> [{dirs, [], @@ -110,7 +112,7 @@ groups() -> write_compressed, compress_errors]}, {links, [], [make_link_a, make_link_b, read_link_info_for_non_link, - symlinks_a, symlinks_b]}]. + symlinks_a, symlinks_b, list_dir_error]}]. init_per_group(_GroupName, Config) -> Config. @@ -2035,6 +2037,8 @@ symlinks(Config, Handle, Suffix) -> ?line #file_info{links=1, type=symlink} = Info2, ?line {ok, Name} = ?PRIM_FILE_call(read_link, Handle, [Alias]), + {ok, Name} = + ?PRIM_FILE_call(read_link_all, Handle, [Alias]), ok end, @@ -2140,6 +2144,41 @@ list_dir_limit_cleanup(Dir, Handle, N, Cnt) -> list_dir_limit_cleanup(Dir, Handle, N, Cnt+1). %%% +%%% Test list_dir() on a non-existing pathname. +%%% + +list_dir_error(Config) -> + Priv = ?config(priv_dir, Config), + NonExisting = filename:join(Priv, "non-existing-dir"), + {error,enoent} = prim_file:list_dir(NonExisting), + ok. + +%%% +%%% Test list_dir() and list_dir_all(). +%%% + +list_dir(Config) -> + RootDir = ?config(priv_dir, Config), + TestDir = filename:join(RootDir, ?MODULE_STRING++"_list_dir"), + ?PRIM_FILE:make_dir(TestDir), + list_dir_1(TestDir, 42, []). + +list_dir_1(TestDir, 0, Sorted) -> + [ok = ?PRIM_FILE:delete(filename:join(TestDir, F)) || + F <- Sorted], + ok = ?PRIM_FILE:del_dir(TestDir); +list_dir_1(TestDir, Cnt, Sorted0) -> + Base = "file" ++ integer_to_list(Cnt), + Name = filename:join(TestDir, Base), + ok = ?PRIM_FILE:write_file(Name, Base), + Sorted = lists:merge([Base], Sorted0), + {ok,DirList0} = ?PRIM_FILE:list_dir(TestDir), + {ok,DirList1} = ?PRIM_FILE:list_dir_all(TestDir), + Sorted = lists:sort(DirList0), + Sorted = lists:sort(DirList1), + list_dir_1(TestDir, Cnt-1, Sorted). + +%%% %%% Support for testing large files. %%% diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl index b06384fc94..74ae2c96e6 100644 --- a/lib/odbc/test/odbc_connect_SUITE.erl +++ b/lib/odbc/test/odbc_connect_SUITE.erl @@ -277,13 +277,19 @@ port_dies(_Config) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), {status, _} = process_info(Ref, status), process_flag(trap_exit, true), - Port = lists:last(erlang:ports()), - exit(Port, kill), - %% Wait for exit_status from port 5000 ms (will not get a exit - %% status in this case), then wait a little longer to make sure - %% the port and the controlprocess has had time to terminate. - test_server:sleep(10000), - undefined = process_info(Ref, status). + NamedPorts = [{P, erlang:port_info(P, name)} || P <- erlang:ports()], + case [P || {P, {name, Name}} <- NamedPorts, is_odbcserver(Name)] of + [Port] -> + exit(Port, kill), + %% Wait for exit_status from port 5000 ms (will not get a exit + %% status in this case), then wait a little longer to make sure + %% the port and the controlprocess has had time to terminate. + test_server:sleep(10000), + undefined = process_info(Ref, status); + [] -> + ct:fail([erlang:port_info(P, name) || P <- erlang:ports()]) + end. + %%------------------------------------------------------------------------- control_process_dies(doc) -> @@ -292,13 +298,17 @@ control_process_dies(suite) -> []; control_process_dies(_Config) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), process_flag(trap_exit, true), - Port = lists:last(erlang:ports()), - {connected, Ref} = erlang:port_info(Port, connected), - exit(Ref, kill), - test_server:sleep(500), - undefined = erlang:port_info(Port, connected). - %% Check for c-program still running, how? - + NamedPorts = [{P, erlang:port_info(P, name)} || P <- erlang:ports()], + case [P || {P, {name, Name}} <- NamedPorts, is_odbcserver(Name)] of + [Port] -> + {connected, Ref} = erlang:port_info(Port, connected), + exit(Ref, kill), + test_server:sleep(500), + undefined = erlang:port_info(Port, connected); + %% Check for c-program still running, how? + [] -> + ct:fail([erlang:port_info(P, name) || P <- erlang:ports()]) + end. %%------------------------------------------------------------------------- client_dies_normal(doc) -> @@ -868,3 +878,13 @@ extended_errors(Config) when is_list(Config)-> ok = odbc:disconnect(Ref), ok = odbc:disconnect(RefExtended). + + +is_odbcserver(Name) -> + case re:run(Name, "odbcserver") of + {match, _} -> + true; + _ -> + false + end. + diff --git a/lib/parsetools/src/leex.erl b/lib/parsetools/src/leex.erl index 22b496258f..e531b78a5b 100644 --- a/lib/parsetools/src/leex.erl +++ b/lib/parsetools/src/leex.erl @@ -127,7 +127,7 @@ file(File, Opts0) -> leex_ret(St). format_error({file_error, Reason}) -> - io_lib:fwrite("~s",[file:format_error(Reason)]); + io_lib:fwrite("~ts",[file:format_error(Reason)]); format_error(missing_defs) -> "missing Definitions"; format_error(missing_rules) -> "missing Rules"; format_error(missing_code) -> "missing Erlang code"; @@ -301,10 +301,10 @@ pack_warnings([]) -> report_errors(St) -> when_opt(fun () -> foreach(fun({File,{none,Mod,E}}) -> - io:fwrite("~s: ~ts\n", + io:fwrite("~ts: ~ts\n", [File,Mod:format_error(E)]); ({File,{Line,Mod,E}}) -> - io:fwrite("~s:~w: ~ts\n", + io:fwrite("~ts:~w: ~ts\n", [File,Line,Mod:format_error(E)]) end, sort(St#leex.errors)) end, report_errors, St#leex.opts). @@ -319,11 +319,11 @@ report_warnings(St) -> ShouldReport = member(report_warnings, St#leex.opts) orelse ReportWerror, when_bool(fun () -> foreach(fun({File,{none,Mod,W}}) -> - io:fwrite("~s: ~s~ts\n", + io:fwrite("~ts: ~s~ts\n", [File,Prefix, Mod:format_error(W)]); ({File,{Line,Mod,W}}) -> - io:fwrite("~s:~w: ~s~ts\n", + io:fwrite("~ts:~w: ~s~ts\n", [File,Line,Prefix, Mod:format_error(W)]) end, sort(St#leex.warnings)) @@ -401,7 +401,7 @@ parse_file(St0) -> {ok,Xfile} -> St1 = St0#leex{encoding = epp:set_encoding(Xfile)}, try - verbose_print(St1, "Parsing file ~s, ", [St1#leex.xfile]), + verbose_print(St1, "Parsing file ~ts, ", [St1#leex.xfile]), %% We KNOW that errors throw so we can ignore them here. {ok,Line1,St2} = parse_head(Xfile, St1), {ok,Line2,Macs,St3} = parse_defs(Xfile, Line1, St2), @@ -1292,7 +1292,7 @@ pack_dfa([], _, Rs, PDFA) -> {PDFA,Rs}. %% the code for the actions. out_file(St0, DFA, DF, Actions, Code) -> - verbose_print(St0, "Writing file ~s, ", [St0#leex.efile]), + verbose_print(St0, "Writing file ~ts, ", [St0#leex.efile]), case open_inc_file(St0) of {ok,Ifile} -> try @@ -1582,7 +1582,7 @@ pp_sep(_, _, _, _) -> " ". %% with Graphviz. out_dfa_graph(St, DFA, DF) -> - verbose_print(St, "Writing DFA to file ~s, ", [St#leex.gfile]), + verbose_print(St, "Writing DFA to file ~ts, ", [St#leex.gfile]), case file:open(St#leex.gfile, [write]) of {ok,Gfile} -> try @@ -1644,7 +1644,7 @@ output_encoding_comment(File, #leex{encoding = Encoding}) -> io:fwrite(File, <<"%% ~s\n">>, [epp:encoding_to_string(Encoding)]). output_file_directive(File, Filename, Line) -> - io:fwrite(File, <<"-file(~s, ~w).\n">>, + io:fwrite(File, <<"-file(~ts, ~w).\n">>, [format_filename(Filename), Line]). format_filename(Filename) -> diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl index 30e0db421e..53292b037a 100644 --- a/lib/parsetools/src/yecc.erl +++ b/lib/parsetools/src/yecc.erl @@ -185,7 +185,7 @@ format_error({endsymbol_is_terminal, Symbol}) -> format_error({error, Module, Error}) -> Module:format_error(Error); format_error({file_error, Reason}) -> - io_lib:fwrite("~s",[file:format_error(Reason)]); + io_lib:fwrite("~ts",[file:format_error(Reason)]); format_error(illegal_empty) -> io_lib:fwrite("illegal use of empty symbol", []); format_error({internal_error, Error}) -> @@ -481,7 +481,7 @@ generate(St0) -> ?PASS(action_conflicts), ?PASS(write_file)], F = case member(time, St1#yecc.options) of true -> - io:fwrite(<<"Generating parser from grammar in ~s\n">>, + io:fwrite(<<"Generating parser from grammar in ~ts\n">>, [format_filename(St1#yecc.infile)]), fun timeit/3; false -> @@ -858,10 +858,10 @@ report_errors(St) -> case member(report_errors, St#yecc.options) of true -> foreach(fun({File,{none,Mod,E}}) -> - io:fwrite(<<"~s: ~ts\n">>, + io:fwrite(<<"~ts: ~ts\n">>, [File,Mod:format_error(E)]); ({File,{Line,Mod,E}}) -> - io:fwrite(<<"~s:~w: ~ts\n">>, + io:fwrite(<<"~ts:~w: ~ts\n">>, [File,Line,Mod:format_error(E)]) end, sort(St#yecc.errors)); false -> @@ -878,11 +878,11 @@ report_warnings(St) -> case member(report_warnings, St#yecc.options) orelse ReportWerror of true -> foreach(fun({File,{none,Mod,W}}) -> - io:fwrite(<<"~s: ~s~ts\n">>, + io:fwrite(<<"~ts: ~s~ts\n">>, [File,Prefix, Mod:format_error(W)]); ({File,{Line,Mod,W}}) -> - io:fwrite(<<"~s:~w: ~s~ts\n">>, + io:fwrite(<<"~ts:~w: ~s~ts\n">>, [File,Line,Prefix, Mod:format_error(W)]) end, sort(St#yecc.warnings)); @@ -2518,7 +2518,7 @@ output_encoding_comment(#yecc{encoding = Encoding}=St) -> fwrite(St, <<"%% ~s\n">>, [epp:encoding_to_string(Encoding)]). output_file_directive(St, Filename, Line) when St#yecc.file_attrs -> - fwrite(St, <<"-file(~s, ~w).\n">>, + fwrite(St, <<"-file(~ts, ~w).\n">>, [format_filename(Filename), Line]); output_file_directive(St, _Filename, _Line) -> St. diff --git a/lib/pman/src/pman_win.erl b/lib/pman/src/pman_win.erl index 350bc2dd7f..a6ef6fd13e 100644 --- a/lib/pman/src/pman_win.erl +++ b/lib/pman/src/pman_win.erl @@ -546,7 +546,7 @@ name(Pid) -> %% module_data(ModuleName) -> - vformat("", catch apply({ModuleName, module_info},[])). + vformat("", catch apply(ModuleName, module_info, [])). diff --git a/lib/sasl/src/si_sasl_supp.erl b/lib/sasl/src/si_sasl_supp.erl index 9c96d11c28..97f906a5f8 100644 --- a/lib/sasl/src/si_sasl_supp.erl +++ b/lib/sasl/src/si_sasl_supp.erl @@ -360,7 +360,7 @@ ppi_impl(XPid) -> print_info(Device, Pid, {Module, Func}, Opt, Data) -> case erlang:function_exported(Module, Func, 2) of true -> - case catch apply({Module, Func}, [Opt, Data]) of + case catch apply(Module, Func, [Opt, Data]) of Format when is_list(Format) -> format_lib_supp:print_info(Device, 79, add_pid_to_format(Pid, Format)), diff --git a/lib/ssh/doc/html/SSH_protocols.png b/lib/ssh/doc/html/SSH_protocols.png Binary files differdeleted file mode 100644 index 145c96c4cd..0000000000 --- a/lib/ssh/doc/html/SSH_protocols.png +++ /dev/null diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index f57ee13460..bd0d3d49dd 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -91,7 +91,8 @@ </type> <desc> <p>Connects to an SSH server. No channel is started. This is done - by calling ssh_connect:session_channel/2.</p> + by calling + <seealso marker="ssh_connection#session_channel/2">ssh_connection:session_channel/[2, 4]</seealso>.</p> <p>Options are:</p> <taglist> <tag><c><![CDATA[{user_dir, string()}]]></c></tag> diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index 5ba3742de7..c4b5aa256b 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -19,6 +19,7 @@ {"%VSN%", [ + {<<"2.1.3">>, [{restart_application, ssh}]}, {<<"2.1.2">>, [{restart_application, ssh}]}, {<<"2.1.1">>, [{restart_application, ssh}]}, {<<"2.1">>, [{restart_application, ssh}]}, @@ -26,6 +27,7 @@ {<<"1\\.*">>, [{restart_application, ssh}]} ], [ + {<<"2.1.3">>, [{restart_application, ssh}]}, {<<"2.1.2">>, [{restart_application, ssh}]}, {<<"2.1.1">>, [{restart_application, ssh}]}, {<<"2.1">>,[{restart_application, ssh}]}, diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 787d82c4db..74a6ac7d19 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -223,11 +223,13 @@ key_exchange(#ssh_msg_kexdh_reply{} = Msg, catch #ssh_msg_disconnect{} = DisconnectMsg -> handle_disconnect(DisconnectMsg, State); + {ErrorToDisplay, #ssh_msg_disconnect{} = DisconnectMsg} -> + handle_disconnect(DisconnectMsg, State, ErrorToDisplay); _:Error -> Desc = log_error(Error), handle_disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = Desc, - language = "en"}, State) + description = Desc, + language = "en"}, State) end; key_exchange(#ssh_msg_kex_dh_gex_group{} = Msg, @@ -673,6 +675,11 @@ terminate({shutdown, #ssh_msg_disconnect{} = Msg}, StateName, #state{ssh_params send_msg(SshPacket, State), ssh_connection_manager:event(Pid, Msg), terminate(normal, StateName, State#state{ssh_params = Ssh}); +terminate({shutdown, {#ssh_msg_disconnect{} = Msg, ErrorMsg}}, StateName, #state{ssh_params = Ssh0, manager = Pid} = State) -> + {SshPacket, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), + send_msg(SshPacket, State), + ssh_connection_manager:event(Pid, Msg, ErrorMsg), + terminate(normal, StateName, State#state{ssh_params = Ssh}); terminate(Reason, StateName, #state{ssh_params = Ssh0, manager = Pid} = State) -> log_error(Reason), DisconnectMsg = @@ -950,6 +957,8 @@ handle_ssh_packet(Length, StateName, #state{decoded_data_buffer = DecData0, handle_disconnect(#ssh_msg_disconnect{} = Msg, State) -> {stop, {shutdown, Msg}, State}. +handle_disconnect(#ssh_msg_disconnect{} = Msg, State, ErrorMsg) -> + {stop, {shutdown, {Msg, ErrorMsg}}, State}. counterpart_versions(NumVsn, StrVsn, #ssh{role = server} = Ssh) -> Ssh#ssh{c_vsn = NumVsn , c_version = StrVsn}; diff --git a/lib/ssh/src/ssh_connection_manager.erl b/lib/ssh/src/ssh_connection_manager.erl index 94a9ed505f..9536eb9dec 100644 --- a/lib/ssh/src/ssh_connection_manager.erl +++ b/lib/ssh/src/ssh_connection_manager.erl @@ -40,8 +40,7 @@ close/2, stop/1, send/5, send_eof/2]). --export([open_channel/6, reply_request/3, request/6, request/7, global_request/4, event/2, - cast/2]). +-export([open_channel/6, reply_request/3, request/6, request/7, global_request/4, event/2, event/3, cast/2]). %% Internal application API and spawn -export([send_msg/1, ssh_channel_info_handler/3]). @@ -110,10 +109,11 @@ global_request(ConnectionManager, Type, true = Reply, Data) -> global_request(ConnectionManager, Type, false = Reply, Data) -> cast(ConnectionManager, {global_request, self(), Type, Reply, Data}). - + +event(ConnectionManager, BinMsg, ErrorMsg) -> + call(ConnectionManager, {ssh_msg, self(), BinMsg, ErrorMsg}). event(ConnectionManager, BinMsg) -> call(ConnectionManager, {ssh_msg, self(), BinMsg}). - info(ConnectionManager) -> info(ConnectionManager, {info, all}). @@ -262,8 +262,7 @@ handle_call({ssh_msg, Pid, Msg}, From, %% To avoid that not all data sent by the other side is processes before %% possible crash in ssh_connection_handler takes down the connection. - gen_server:reply(From, ok), - + gen_server:reply(From, ok), ConnectionMsg = decode_ssh_msg(Msg), try ssh_connection:handle_msg(ConnectionMsg, Connection0, Pid, Role) of {{replies, Replies}, Connection} -> @@ -294,7 +293,45 @@ handle_call({ssh_msg, Pid, Msg}, From, disconnect_fun(Reason, SSHOpts), {stop, {shutdown, Error}, State#state{connection_state = Connection}} end; +handle_call({ssh_msg, Pid, Msg, ErrorMsg}, From, + #state{connection_state = Connection0, + role = Role, opts = Opts, connected = IsConnected, + client = ClientPid} + = State) -> + %% To avoid that not all data sent by the other side is processes before + %% possible crash in ssh_connection_handler takes down the connection. + gen_server:reply(From, ok), + ConnectionMsg = decode_ssh_msg(Msg), + try ssh_connection:handle_msg(ConnectionMsg, Connection0, Pid, Role) of + {{replies, Replies}, Connection} -> + lists:foreach(fun send_msg/1, Replies), + {noreply, State#state{connection_state = Connection}}; + {noreply, Connection} -> + {noreply, State#state{connection_state = Connection}}; + {disconnect, {_, Reason}, {{replies, Replies}, Connection}} + when Role == client andalso (not IsConnected) -> + lists:foreach(fun send_msg/1, Replies), + ClientPid ! {self(), not_connected, {Reason, ErrorMsg}}, + {stop, {shutdown, normal}, State#state{connection = Connection}}; + {disconnect, Reason, {{replies, Replies}, Connection}} -> + lists:foreach(fun send_msg/1, Replies), + SSHOpts = proplists:get_value(ssh_opts, Opts), + disconnect_fun(Reason, SSHOpts), + {stop, {shutdown, normal}, State#state{connection_state = Connection}} + catch + _:Error -> + {disconnect, Reason, {{replies, Replies}, Connection}} = + ssh_connection:handle_msg( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Internal error", + language = "en"}, Connection0, undefined, + Role), + lists:foreach(fun send_msg/1, Replies), + SSHOpts = proplists:get_value(ssh_opts, Opts), + disconnect_fun(Reason, SSHOpts), + {stop, {shutdown, Error}, State#state{connection_state = Connection}} + end; handle_call({global_request, Pid, _, _, _} = Request, From, #state{connection_state = #connection{channel_cache = Cache}} = State0) -> diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 1abb69921d..a47a55b707 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -356,12 +356,12 @@ handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = HostKey, f = F, {ok, SshPacket, Ssh#ssh{shared_secret = K, exchanged_hash = H, session_id = sid(Ssh, H)}}; - _Error -> + Error -> Disconnect = #ssh_msg_disconnect{ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, description = "Key exchange failed", language = "en"}, - throw(Disconnect) + throw({Error, Disconnect}) end. handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = _Min, diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 71666a3179..9fc4b0522e 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 2.1.3 +SSH_VSN = 2.1.4 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index e45a4c774f..ab468c8d6b 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2012</year> + <year>1999</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -84,10 +84,13 @@ {client_preferred_next_protocols, binary(), client | server, list(binary())} </c></p> - <p><c>transportoption() = {CallbackModule, DataTag, ClosedTag} - - defaults to {gen_tcp, tcp, tcp_closed}. Ssl may be - run over any reliable transport protocol that has - an equivalent API to gen_tcp's.</c></p> + <p><c>transportoption() = {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom(), ErrTag:atom()}} + - defaults to {gen_tcp, tcp, tcp_closed, tcp_error}. Can be used to customize + the transport layer. The callback module must implement a reliable transport + protocol and behave as gen_tcp and in addition have functions corresponding to + inet:setopts/2, inet:getopts/2, inet:peername/1, inet:sockname/1 and inet:port/1. + The callback gen_tcp is treated specially and will call inet directly. + </c></p> <p><c> CallbackModule = atom()</c> diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 043645be41..e61f415c84 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2012. All Rights Reserved. +# Copyright Ericsson AB 1999-2013. 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 @@ -52,11 +52,11 @@ MODULES= \ ssl_cipher \ ssl_connection \ ssl_connection_sup \ - ssl_debug \ ssl_handshake \ ssl_manager \ ssl_session \ ssl_session_cache \ + ssl_socket \ ssl_record \ ssl_ssl2 \ ssl_ssl3 \ @@ -64,7 +64,6 @@ MODULES= \ ssl_tls_dist_proxy INTERNAL_HRL_FILES = \ - ssl_debug.hrl \ ssl_alert.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_internal.hrl \ ssl_record.hrl diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 13d5eaf4d7..897a097f73 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -13,10 +13,10 @@ ssl_session, ssl_session_cache_api, ssl_session_cache, + ssl_socket, ssl_record, ssl_manager, ssl_handshake, - ssl_debug, ssl_connection_sup, ssl_connection, ssl_cipher, diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 76e14860ec..a8a494b2fc 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,12 +1,14 @@ %% -*- erlang -*- {"%VSN%", [ + {<<"5.2">>, [{restart_application, ssl}]}, {<<"5.1\\*">>, [{restart_application, ssl}]}, {<<"5.0\\*">>, [{restart_application, ssl}]}, {<<"4\\.*">>, [{restart_application, ssl}]}, {<<"3\\.*">>, [{restart_application, ssl}]} ], [ + {<<"5.2">>, [{restart_application, ssl}]}, {<<"5.1\\*">>, [{restart_application, ssl}]}, {<<"5.0\\*">>, [{restart_application, ssl}]}, {<<"4\\.*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 09f2819ca8..0ba59cede2 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2013. 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 @@ -76,7 +76,8 @@ string(). % (according to old API) -type ssl_imp() :: new | old. --type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom()}}. +-type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), + ClosedTag::atom(), ErrTag::atom()}}. -type prf_random() :: client_random | server_random. %%-------------------------------------------------------------------- @@ -108,7 +109,8 @@ stop() -> %%-------------------------------------------------------------------- -spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} | {error, reason()}. --spec connect(host() | port(), [connect_option()] | inet:port_number(), timeout() | list()) -> +-spec connect(host() | port(), [connect_option()] | inet:port_number(), + timeout() | list()) -> {ok, #sslsocket{}} | {error, reason()}. -spec connect(host() | port(), inet:port_number(), list(), timeout()) -> {ok, #sslsocket{}} | {error, reason()}. @@ -120,12 +122,15 @@ connect(Socket, SslOptions) when is_port(Socket) -> connect(Socket, SslOptions, infinity). connect(Socket, SslOptions0, Timeout) when is_port(Socket) -> + {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0, + {gen_tcp, tcp, tcp_closed, tcp_error}), EmulatedOptions = emulated_options(), - {ok, InetValues} = inet:getopts(Socket, EmulatedOptions), - ok = inet:setopts(Socket, internal_inet_values()), - try handle_options(SslOptions0 ++ InetValues, client) of - {ok, #config{cb=CbInfo, ssl=SslOptions, emulated=EmOpts}} -> - case inet:peername(Socket) of + {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), + try handle_options(SslOptions0 ++ SocketValues, client) of + {ok, #config{cb = CbInfo, ssl = SslOptions, emulated = EmOpts}} -> + + ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()), + case ssl_socket:peername(Transport, Socket) of {ok, {Address, Port}} -> ssl_connection:connect(Address, Port, Socket, {SslOptions, EmOpts}, @@ -157,12 +162,12 @@ connect(Host, Port, Options, Timeout) -> %% Description: Creates an ssl listen socket. %%-------------------------------------------------------------------- listen(_Port, []) -> - {error, enooptions}; + {error, nooptions}; listen(Port, Options0) -> try {ok, Config} = handle_options(Options0, server), - #config{cb={CbModule, _, _, _},inet_user=Options} = Config, - case CbModule:listen(Port, Options) of + #config{cb = {Transport, _, _, _}, inet_user = Options} = Config, + case Transport:listen(Port, Options) of {ok, ListenSocket} -> {ok, #sslsocket{pid = {ListenSocket, Config}}}; Err = {error, _} -> @@ -183,23 +188,23 @@ listen(Port, Options0) -> transport_accept(ListenSocket) -> transport_accept(ListenSocket, infinity). -transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts}}}, Timeout) -> +transport_accept(#sslsocket{pid = {ListenSocket, #config{cb = CbInfo, ssl = SslOpts}}}, Timeout) -> %% The setopt could have been invoked on the listen socket %% and options should be inherited. EmOptions = emulated_options(), - {ok, InetValues} = inet:getopts(ListenSocket, EmOptions), - ok = inet:setopts(ListenSocket, internal_inet_values()), - {CbModule,_,_, _} = CbInfo, - case CbModule:accept(ListenSocket, Timeout) of + {Transport,_,_, _} = CbInfo, + {ok, SocketValues} = ssl_socket:getopts(Transport, ListenSocket, EmOptions), + ok = ssl_socket:setopts(Transport, ListenSocket, internal_inet_values()), + case Transport:accept(ListenSocket, Timeout) of {ok, Socket} -> - ok = inet:setopts(ListenSocket, InetValues), - {ok, Port} = inet:port(Socket), + ok = ssl_socket:setopts(Transport, ListenSocket, SocketValues), + {ok, Port} = ssl_socket:port(Transport, Socket), ConnArgs = [server, "localhost", Port, Socket, - {SslOpts, socket_options(InetValues)}, self(), CbInfo], + {SslOpts, socket_options(SocketValues)}, self(), CbInfo], case ssl_connection_sup:start_child(ConnArgs) of {ok, Pid} -> - ssl_connection:socket_control(Socket, Pid, CbModule); + ssl_connection:socket_control(Socket, Pid, Transport); {error, Reason} -> {error, Reason} end; @@ -209,9 +214,11 @@ transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts} %%-------------------------------------------------------------------- -spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}. --spec ssl_accept(#sslsocket{} | port(), timeout()| [ssl_option() | transport_option()]) -> +-spec ssl_accept(#sslsocket{} | port(), timeout()| [ssl_option() + | transport_option()]) -> ok | {ok, #sslsocket{}} | {error, reason()}. --spec ssl_accept(port(), [ssl_option()| transport_option()], timeout()) -> {ok, #sslsocket{}} | {error, reason()}. +-spec ssl_accept(port(), [ssl_option()| transport_option()], timeout()) -> + {ok, #sslsocket{}} | {error, reason()}. %% %% Description: Performs accept on an ssl listen socket. e.i. performs %% ssl handshake. @@ -226,12 +233,14 @@ ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> ssl_accept(ListenSocket, SslOptions, infinity). ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> + {Transport,_,_,_} = + proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}), EmulatedOptions = emulated_options(), - {ok, InetValues} = inet:getopts(Socket, EmulatedOptions), - ok = inet:setopts(Socket, internal_inet_values()), - try handle_options(SslOptions ++ InetValues, server) of - {ok, #config{cb=CbInfo,ssl=SslOpts, emulated=EmOpts}} -> - {ok, Port} = inet:port(Socket), + {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), + try handle_options(SslOptions ++ SocketValues, server) of + {ok, #config{cb = CbInfo, ssl = SslOpts, emulated = EmOpts}} -> + ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()), + {ok, Port} = ssl_socket:port(Transport, Socket), ssl_connection:ssl_accept(Port, Socket, {SslOpts, EmOpts}, self(), CbInfo, Timeout) @@ -246,8 +255,8 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> %%-------------------------------------------------------------------- close(#sslsocket{pid = Pid}) when is_pid(Pid) -> ssl_connection:close(Pid); -close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}) -> - CbMod:close(ListenSocket). +close(#sslsocket{pid = {ListenSocket, #config{cb={Transport,_, _, _}}}}) -> + Transport:close(ListenSocket). %%-------------------------------------------------------------------- -spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}. @@ -256,8 +265,8 @@ close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}) -> %%-------------------------------------------------------------------- send(#sslsocket{pid = Pid}, Data) when is_pid(Pid) -> ssl_connection:send(Pid, Data); -send(#sslsocket{pid = {ListenSocket, #config{cb={CbModule, _, _, _}}}}, Data) -> - CbModule:send(ListenSocket, Data). %% {error,enotconn} +send(#sslsocket{pid = {ListenSocket, #config{cb={Transport, _, _, _}}}}, Data) -> + Transport:send(ListenSocket, Data). %% {error,enotconn} %%-------------------------------------------------------------------- -spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}. @@ -269,8 +278,9 @@ recv(Socket, Length) -> recv(Socket, Length, infinity). recv(#sslsocket{pid = Pid}, Length, Timeout) when is_pid(Pid) -> ssl_connection:recv(Pid, Length, Timeout); -recv(#sslsocket{pid = {Listen, #config{cb={CbModule, _, _, _}}}}, _,_) when is_port(Listen)-> - CbModule:recv(Listen, 0). %% {error,enotconn} +recv(#sslsocket{pid = {Listen, + #config{cb={Transport, _, _, _}}}}, _,_) when is_port(Listen)-> + Transport:recv(Listen, 0). %% {error,enotconn} %%-------------------------------------------------------------------- -spec controlling_process(#sslsocket{}, pid()) -> ok | {error, reason()}. @@ -281,9 +291,10 @@ recv(#sslsocket{pid = {Listen, #config{cb={CbModule, _, _, _}}}}, _,_) when is_p controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid), is_pid(NewOwner) -> ssl_connection:new_user(Pid, NewOwner); controlling_process(#sslsocket{pid = {Listen, - #config{cb={CbModule, _, _, _}}}}, NewOwner) when is_port(Listen), - is_pid(NewOwner) -> - CbModule:controlling_process(Listen, NewOwner). + #config{cb={Transport, _, _, _}}}}, + NewOwner) when is_port(Listen), + is_pid(NewOwner) -> + Transport:controlling_process(Listen, NewOwner). %%-------------------------------------------------------------------- -spec connection_info(#sslsocket{}) -> {ok, {tls_atom_version(), erl_cipher_suite()}} | @@ -301,10 +312,10 @@ connection_info(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> %% %% Description: same as inet:peername/1. %%-------------------------------------------------------------------- -peername(#sslsocket{pid = Pid, fd = Socket}) when is_pid(Pid)-> - inet:peername(Socket); -peername(#sslsocket{pid = {ListenSocket, _}}) -> - inet:peername(ListenSocket). %% Will return {error, enotconn} +peername(#sslsocket{pid = Pid, fd = {Transport, Socket}}) when is_pid(Pid)-> + ssl_socket:peername(Transport, Socket); +peername(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}) -> + ssl_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn} %%-------------------------------------------------------------------- -spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}. @@ -363,18 +374,19 @@ cipher_suites(openssl) -> %%-------------------------------------------------------------------- getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> ssl_connection:get_opts(Pid, OptionTags); -getopts(#sslsocket{pid = {ListenSocket, _}}, OptionTags) when is_list(OptionTags) -> - try inet:getopts(ListenSocket, OptionTags) of +getopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}, + OptionTags) when is_list(OptionTags) -> + try ssl_socket:getopts(Transport, ListenSocket, OptionTags) of {ok, _} = Result -> Result; {error, InetError} -> - {error, {eoptions, {inet_options, OptionTags, InetError}}} + {error, {options, {socket_options, OptionTags, InetError}}} catch _:_ -> - {error, {eoptions, {inet_options, OptionTags}}} + {error, {options, {socket_options, OptionTags}}} end; getopts(#sslsocket{}, OptionTags) -> - {error, {eoptions, {inet_options, OptionTags}}}. + {error, {options, {socket_options, OptionTags}}}. %%-------------------------------------------------------------------- -spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}. @@ -388,30 +400,30 @@ setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> ssl_connection:set_opts(Pid, Options) catch _:_ -> - {error, {eoptions, {not_a_proplist, Options0}}} + {error, {options, {not_a_proplist, Options0}}} end; -setopts(#sslsocket{pid = {ListenSocket, _}}, Options) when is_list(Options) -> - try inet:setopts(ListenSocket, Options) of +setopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}, Options) when is_list(Options) -> + try ssl_socket:setopts(Transport, ListenSocket, Options) of ok -> ok; {error, InetError} -> - {error, {eoptions, {inet_options, Options, InetError}}} + {error, {options, {socket_options, Options, InetError}}} catch _:Error -> - {error, {eoptions, {inet_options, Options, Error}}} + {error, {options, {socket_options, Options, Error}}} end; setopts(#sslsocket{}, Options) -> - {error, {eoptions,{not_a_proplist, Options}}}. + {error, {options,{not_a_proplist, Options}}}. %%--------------------------------------------------------------- -spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}. %% %% Description: Same as gen_tcp:shutdown/2 %%-------------------------------------------------------------------- -shutdown(#sslsocket{pid = {Listen, #config{cb={CbMod,_, _, _}}}}, +shutdown(#sslsocket{pid = {Listen, #config{cb={Transport,_, _, _}}}}, How) when is_port(Listen) -> - CbMod:shutdown(Listen, How); + Transport:shutdown(Listen, How); shutdown(#sslsocket{pid = Pid}, How) -> ssl_connection:shutdown(Pid, How). @@ -420,11 +432,11 @@ shutdown(#sslsocket{pid = Pid}, How) -> %% %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- -sockname(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> - inet:sockname(Listen); +sockname(#sslsocket{pid = {Listen, #config{cb={Transport,_, _, _}}}}) when is_port(Listen) -> + ssl_socket:sockname(Transport, Listen); -sockname(#sslsocket{pid = Pid, fd = Socket}) when is_pid(Pid) -> - inet:sockname(Socket). +sockname(#sslsocket{pid = Pid, fd = {Transport, Socket}}) when is_pid(Pid) -> + ssl_socket:sockname(Transport, Socket). %%--------------------------------------------------------------- -spec session_info(#sslsocket{}) -> {ok, list()} | {error, reason()}. @@ -491,26 +503,26 @@ format_error({error, Reason}) -> format_error(Reason) when is_list(Reason) -> Reason; format_error(closed) -> - "The connection is closed"; -format_error(ecacertfile) -> - "Own CA certificate file is invalid."; -format_error(ecertfile) -> - "Own certificate file is invalid."; -format_error(ekeyfile) -> - "Own private key file is invalid."; -format_error(esslaccept) -> - "Server SSL handshake procedure between client and server failed."; -format_error(esslconnect) -> - "Client SSL handshake procedure between client and server failed."; -format_error({eoptions, Options}) -> - lists:flatten(io_lib:format("Error in options list: ~p~n", [Options])); + "TLS connection is closed"; +format_error({tls_alert, Description}) -> + "TLS Alert: " ++ Description; +format_error({options,{FileType, File, Reason}}) when FileType == cacertfile; + FileType == certfile; + FileType == keyfile; + FileType == dhfile -> + Error = file_error_format(Reason), + file_desc(FileType) ++ File ++ ": " ++ Error; +format_error({options, {socket_options, Option, Error}}) -> + lists:flatten(io_lib:format("Invalid transport socket option ~p: ~s", [Option, format_error(Error)])); +format_error({options, {socket_options, Option}}) -> + lists:flatten(io_lib:format("Invalid socket option: ~p", [Option])); +format_error({options, Options}) -> + lists:flatten(io_lib:format("Invalid TLS option: ~p", [Options])); format_error(Error) -> - case (catch inet:format_error(Error)) of - "unkknown POSIX" ++ _ -> - no_format(Error); - {'EXIT', _} -> - no_format(Error); + case inet:format_error(Error) of + "unknown POSIX" ++ _ -> + unexpected_format(Error); Other -> Other end. @@ -531,7 +543,6 @@ random_bytes(N) -> crypto:rand_bytes(N) end. - %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- @@ -539,8 +550,8 @@ do_connect(Address, Port, #config{cb=CbInfo, inet_user=UserOpts, ssl=SslOpts, emulated=EmOpts,inet_ssl=SocketOpts}, Timeout) -> - {CbModule, _, _, _} = CbInfo, - try CbModule:connect(Address, Port, SocketOpts, Timeout) of + {Transport, _, _, _} = CbInfo, + try Transport:connect(Address, Port, SocketOpts, Timeout) of {ok, Socket} -> ssl_connection:connect(Address, Port, Socket, {SslOpts,EmOpts}, self(), CbInfo, Timeout); @@ -548,11 +559,11 @@ do_connect(Address, Port, {error, Reason} catch exit:{function_clause, _} -> - {error, {eoptions, {cb_info, CbInfo}}}; + {error, {options, {cb_info, CbInfo}}}; exit:badarg -> - {error, {eoptions, {inet_options, UserOpts}}}; + {error, {options, {socket_options, UserOpts}}}; exit:{badarg, _} -> - {error, {eoptions, {inet_options, UserOpts}}} + {error, {options, {socket_options, UserOpts}}} end. handle_options(Opts0, _Role) -> @@ -596,7 +607,7 @@ handle_options(Opts0, _Role) -> {verify_peer, UserFailIfNoPeerCert, ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; Value -> - throw({error, {eoptions, {verify, Value}}}) + throw({error, {options, {verify, Value}}}) end, CertFile = handle_option(certfile, Opts, <<>>), @@ -623,11 +634,13 @@ handle_options(Opts0, _Role) -> reuse_sessions = handle_option(reuse_sessions, Opts, true), secure_renegotiate = handle_option(secure_renegotiate, Opts, false), renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), - debug = handle_option(debug, Opts, []), hibernate_after = handle_option(hibernate_after, Opts, undefined), erl_dist = handle_option(erl_dist, Opts, false), - next_protocols_advertised = handle_option(next_protocols_advertised, Opts, undefined), - next_protocol_selector = make_next_protocol_selector(handle_option(client_preferred_next_protocols, Opts, undefined)) + next_protocols_advertised = + handle_option(next_protocols_advertised, Opts, undefined), + next_protocol_selector = + make_next_protocol_selector( + handle_option(client_preferred_next_protocols, Opts, undefined)) }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), @@ -635,8 +648,9 @@ handle_options(Opts0, _Role) -> fail_if_no_peer_cert, verify_client_once, depth, cert, certfile, key, keyfile, password, cacerts, cacertfile, dh, dhfile, ciphers, - debug, reuse_session, reuse_sessions, ssl_imp, - cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist, next_protocols_advertised, + reuse_session, reuse_sessions, ssl_imp, + cb_info, renegotiate_at, secure_renegotiate, hibernate_after, + erl_dist, next_protocols_advertised, client_preferred_next_protocols], SockOpts = lists:foldl(fun(Key, PropList) -> @@ -740,9 +754,9 @@ validate_option(ciphers, Value) when is_list(Value) -> try cipher_suites(Version, Value) catch exit:_ -> - throw({error, {eoptions, {ciphers, Value}}}); + throw({error, {options, {ciphers, Value}}}); error:_-> - throw({error, {eoptions, {ciphers, Value}}}) + throw({error, {options, {ciphers, Value}}}) end; validate_option(reuse_session, Value) when is_function(Value) -> Value; @@ -756,8 +770,6 @@ validate_option(secure_renegotiate, Value) when Value == true; validate_option(renegotiate_at, Value) when is_integer(Value) -> erlang:min(Value, ?DEFAULT_RENEGOTIATE_AT); -validate_option(debug, Value) when is_list(Value); Value == true -> - Value; validate_option(hibernate_after, undefined) -> undefined; validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 -> @@ -769,7 +781,7 @@ validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredPro when is_list(PreferredProtocols) -> case ssl_record:highest_protocol_version([]) of {3,0} -> - throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}}); + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); _ -> validate_binary_list(client_preferred_next_protocols, PreferredProtocols), validate_npn_ordering(Precedence), @@ -780,7 +792,7 @@ validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredPro byte_size(Default) > 0, byte_size(Default) < 256 -> case ssl_record:highest_protocol_version([]) of {3,0} -> - throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}}); + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); _ -> validate_binary_list(client_preferred_next_protocols, PreferredProtocols), validate_npn_ordering(Precedence), @@ -792,7 +804,7 @@ validate_option(client_preferred_next_protocols, undefined) -> validate_option(next_protocols_advertised = Opt, Value) when is_list(Value) -> case ssl_record:highest_protocol_version([]) of {3,0} -> - throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}}); + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); _ -> validate_binary_list(next_protocols_advertised, Value), Value @@ -801,14 +813,14 @@ validate_option(next_protocols_advertised = Opt, Value) when is_list(Value) -> validate_option(next_protocols_advertised, undefined) -> undefined; validate_option(Opt, Value) -> - throw({error, {eoptions, {Opt, Value}}}). + throw({error, {options, {Opt, Value}}}). validate_npn_ordering(client) -> ok; validate_npn_ordering(server) -> ok; validate_npn_ordering(Value) -> - throw({error, {eoptions, {client_preferred_next_protocols, {invalid_precedence, Value}}}}). + throw({error, {options, {client_preferred_next_protocols, {invalid_precedence, Value}}}}). validate_binary_list(Opt, List) -> lists:foreach( @@ -817,7 +829,7 @@ validate_binary_list(Opt, List) -> byte_size(Bin) < 256 -> ok; (Bin) -> - throw({error, {eoptions, {Opt, {invalid_protocol, Bin}}}}) + throw({error, {options, {Opt, {invalid_protocol, Bin}}}}) end, List). validate_versions([], Versions) -> @@ -828,23 +840,23 @@ validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2'; Version == sslv3 -> validate_versions(Rest, Versions); validate_versions([Ver| _], Versions) -> - throw({error, {eoptions, {Ver, {versions, Versions}}}}). + throw({error, {options, {Ver, {versions, Versions}}}}). validate_inet_option(mode, Value) when Value =/= list, Value =/= binary -> - throw({error, {eoptions, {mode,Value}}}); + throw({error, {options, {mode,Value}}}); validate_inet_option(packet, Value) when not (is_atom(Value) orelse is_integer(Value)) -> - throw({error, {eoptions, {packet,Value}}}); + throw({error, {options, {packet,Value}}}); validate_inet_option(packet_size, Value) when not is_integer(Value) -> - throw({error, {eoptions, {packet_size,Value}}}); + throw({error, {options, {packet_size,Value}}}); validate_inet_option(header, Value) when not is_integer(Value) -> - throw({error, {eoptions, {header,Value}}}); + throw({error, {options, {header,Value}}}); validate_inet_option(active, Value) when Value =/= true, Value =/= false, Value =/= once -> - throw({error, {eoptions, {active,Value}}}); + throw({error, {options, {active,Value}}}); validate_inet_option(_, _) -> ok. @@ -923,8 +935,27 @@ cipher_suites(Version, Ciphers0) -> Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")], cipher_suites(Version, Ciphers). -no_format(Error) -> - lists:flatten(io_lib:format("No format string for error: \"~p\" available.", [Error])). +unexpected_format(Error) -> + lists:flatten(io_lib:format("Unexpected error: ~p", [Error])). + +file_error_format({error, Error})-> + case file:format_error(Error) of + "unknown POSIX error" -> + "decoding error"; + Str -> + Str + end; +file_error_format(_) -> + "decoding error". + +file_desc(cacertfile) -> + "Invalid CA certificate file "; +file_desc(certfile) -> + "Invalid certificate file "; +file_desc(keyfile) -> + "Invalid key file "; +file_desc(dhfile) -> + "Invalid DH params file ". detect(_Pred, []) -> undefined; @@ -940,16 +971,25 @@ make_next_protocol_selector(undefined) -> undefined; make_next_protocol_selector({client, AllProtocols, DefaultProtocol}) -> fun(AdvertisedProtocols) -> - case detect(fun(PreferredProtocol) -> lists:member(PreferredProtocol, AdvertisedProtocols) end, AllProtocols) of - undefined -> DefaultProtocol; - PreferredProtocol -> PreferredProtocol + case detect(fun(PreferredProtocol) -> + lists:member(PreferredProtocol, AdvertisedProtocols) + end, AllProtocols) of + undefined -> + DefaultProtocol; + PreferredProtocol -> + PreferredProtocol end end; make_next_protocol_selector({server, AllProtocols, DefaultProtocol}) -> fun(AdvertisedProtocols) -> - case detect(fun(PreferredProtocol) -> lists:member(PreferredProtocol, AllProtocols) end, AdvertisedProtocols) of - undefined -> DefaultProtocol; - PreferredProtocol -> PreferredProtocol - end + case detect(fun(PreferredProtocol) -> + lists:member(PreferredProtocol, AllProtocols) + end, + AdvertisedProtocols) of + undefined -> + DefaultProtocol; + PreferredProtocol -> + PreferredProtocol + end end. diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index f94a1136a0..94e95d3cd3 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -45,7 +45,7 @@ reason_code(#alert{description = ?CLOSE_NOTIFY}, _) -> closed; reason_code(#alert{description = Description}, _) -> - {essl, description_txt(Description)}. + {tls_alert, description_txt(Description)}. %%-------------------------------------------------------------------- -spec alert_txt(#alert{}) -> string(). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index e5a6181a88..52b765f191 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -178,10 +178,10 @@ handshake(#sslsocket{pid = Pid}, Timeout) -> %% %% Description: Set the ssl process to own the accept socket %%-------------------------------------------------------------------- -socket_control(Socket, Pid, CbModule) -> - case CbModule:controlling_process(Socket, Pid) of +socket_control(Socket, Pid, Transport) -> + case Transport:controlling_process(Socket, Pid) of ok -> - {ok, sslsocket(Pid, Socket)}; + {ok, ssl_socket:socket(Pid, Transport, Socket)}; {error, Reason} -> {error, Reason} end. @@ -848,8 +848,9 @@ handle_sync_event({new_user, User}, _From, StateName, handle_sync_event({get_opts, OptTags}, _From, StateName, #state{socket = Socket, + transport_cb = Transport, socket_options = SockOpts} = State) -> - OptsReply = get_socket_opts(Socket, OptTags, SockOpts, []), + OptsReply = get_socket_opts(Transport, Socket, OptTags, SockOpts, []), {reply, OptsReply, StateName, State, get_timeout(State)}; handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = undefined} = State) -> @@ -860,8 +861,9 @@ handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protoc handle_sync_event({set_opts, Opts0}, _From, StateName, #state{socket_options = Opts1, socket = Socket, + transport_cb = Transport, user_data_buffer = Buffer} = State0) -> - {Reply, Opts} = set_socket_opts(Socket, Opts0, Opts1, []), + {Reply, Opts} = set_socket_opts(Transport, Socket, Opts0, Opts1, []), State1 = State0#state{socket_options = Opts}, if Opts#socket_options.active =:= false -> @@ -982,9 +984,10 @@ handle_info({CloseTag, Socket}, StateName, {stop, {shutdown, transport_closed}, State}; handle_info({ErrorTag, Socket, econnaborted}, StateName, - #state{socket = Socket, start_or_recv_from = StartFrom, role = Role, + #state{socket = Socket, transport_cb = Transport, + start_or_recv_from = StartFrom, role = Role, error_tag = ErrorTag} = State) when StateName =/= connection -> - alert_user(Socket, StartFrom, ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Role), + alert_user(Transport, Socket, StartFrom, ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Role), {stop, normal, State}; handle_info({ErrorTag, Socket, Reason}, StateName, #state{socket = Socket, @@ -1133,9 +1136,8 @@ init_certificates(#ssl_options{cacerts = CaCerts, end, {ok, _, _, _, _, _} = ssl_manager:connection_init(Certs, Role) catch - Error:Reason -> - handle_file_error(?LINE, Error, Reason, CACertFile, {ecacertfile, Reason}, - erlang:get_stacktrace()) + _:Reason -> + file_error(CACertFile, {cacertfile, Reason}) end, init_certificates(Cert, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CertFile, Role). @@ -1155,9 +1157,8 @@ init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHan [OwnCert] = ssl_certificate:file_to_certificats(CertFile, PemCacheHandle), {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, OwnCert} catch - Error:Reason -> - handle_file_error(?LINE, Error, Reason, CertFile, {ecertfile, Reason}, - erlang:get_stacktrace()) + _:Reason -> + file_error(CertFile, {certfile, Reason}) end; init_certificates(Cert, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, _, _) -> {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, Cert}. @@ -1174,9 +1175,8 @@ init_private_key(DbHandle, undefined, KeyFile, Password, _) -> ], private_key(public_key:pem_entry_decode(PemEntry, Password)) catch - Error:Reason -> - handle_file_error(?LINE, Error, Reason, KeyFile, {ekeyfile, Reason}, - erlang:get_stacktrace()) + _:Reason -> + file_error(KeyFile, {keyfile, Reason}) end; %% First two clauses are for backwards compatibility @@ -1202,18 +1202,14 @@ private_key(#'PrivateKeyInfo'{privateKeyAlgorithm = private_key(Key) -> Key. --spec(handle_file_error(_,_,_,_,_,_) -> no_return()). -handle_file_error(Line, Error, {badmatch, Reason}, File, Throw, Stack) -> - file_error(Line, Error, Reason, File, Throw, Stack); -handle_file_error(Line, Error, Reason, File, Throw, Stack) -> - file_error(Line, Error, Reason, File, Throw, Stack). - --spec(file_error(_,_,_,_,_,_) -> no_return()). -file_error(Line, Error, Reason, File, Throw, Stack) -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [Line, Error, Reason, File, Stack]), - error_logger:error_report(Report), - throw(Throw). +-spec(file_error(_,_) -> no_return()). +file_error(File, Throw) -> + case Throw of + {Opt,{badmatch, {error, {badmatch, Error}}}} -> + throw({options, {Opt, binary_to_list(File), Error}}); + _ -> + throw(Throw) + end. init_diffie_hellman(_,Params, _,_) when is_binary(Params)-> public_key:der_decode('DHParameter', Params); @@ -1231,9 +1227,8 @@ init_diffie_hellman(DbHandle,_, DHParamFile, server) -> ?DEFAULT_DIFFIE_HELLMAN_PARAMS end catch - Error:Reason -> - handle_file_error(?LINE, Error, Reason, - DHParamFile, {edhfile, Reason}, erlang:get_stacktrace()) + _:Reason -> + file_error(DHParamFile, {dhfile, Reason}) end. sync_send_all_state_event(FsmPid, Event) -> @@ -1762,6 +1757,7 @@ passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) -> read_application_data(Data, #state{user_application = {_Mon, Pid}, socket = Socket, + transport_cb = Transport, socket_options = SOpts, bytes_to_read = BytesToRead, start_or_recv_from = RecvFrom, @@ -1774,7 +1770,7 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, end, case get_data(SOpts, BytesToRead, Buffer1) of {ok, ClientData, Buffer} -> % Send data - SocketOpt = deliver_app_data(Socket, SOpts, ClientData, Pid, RecvFrom), + SocketOpt = deliver_app_data(Transport, Socket, SOpts, ClientData, Pid, RecvFrom), cancel_timer(Timer), State = State0#state{user_data_buffer = Buffer, start_or_recv_from = undefined, @@ -1795,7 +1791,7 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, {passive, Buffer} -> next_record_if_active(State0#state{user_data_buffer = Buffer}); {error,_Reason} -> %% Invalid packet in packet mode - deliver_packet_error(Socket, SOpts, Buffer1, Pid, RecvFrom), + deliver_packet_error(Transport, Socket, SOpts, Buffer1, Pid, RecvFrom), {stop, normal, State0} end. @@ -1877,9 +1873,9 @@ decode_packet(Type, Buffer, PacketOpts) -> %% Note that if the user has explicitly configured the socket to expect %% HTTP headers using the {packet, httph} option, we don't do any automatic %% switching of states. -deliver_app_data(Socket, SOpts = #socket_options{active=Active, packet=Type}, +deliver_app_data(Transport, Socket, SOpts = #socket_options{active=Active, packet=Type}, Data, Pid, From) -> - send_or_reply(Active, Pid, From, format_reply(Socket, SOpts, Data)), + send_or_reply(Active, Pid, From, format_reply(Transport, Socket, SOpts, Data)), SO = case Data of {P, _, _, _} when ((P =:= http_request) or (P =:= http_response)), ((Type =:= http) or (Type =:= http_bin)) -> @@ -1898,20 +1894,20 @@ deliver_app_data(Socket, SOpts = #socket_options{active=Active, packet=Type}, SO end. -format_reply(_,#socket_options{active = false, mode = Mode, packet = Packet, +format_reply(_, _,#socket_options{active = false, mode = Mode, packet = Packet, header = Header}, Data) -> {ok, do_format_reply(Mode, Packet, Header, Data)}; -format_reply(Socket, #socket_options{active = _, mode = Mode, packet = Packet, - header = Header}, Data) -> - {ssl, sslsocket(self(), Socket), do_format_reply(Mode, Packet, Header, Data)}. +format_reply(Transport, Socket, #socket_options{active = _, mode = Mode, packet = Packet, + header = Header}, Data) -> + {ssl, ssl_socket:socket(self(), Transport, Socket), do_format_reply(Mode, Packet, Header, Data)}. -deliver_packet_error(Socket, SO= #socket_options{active = Active}, Data, Pid, From) -> - send_or_reply(Active, Pid, From, format_packet_error(Socket, SO, Data)). +deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Data, Pid, From) -> + send_or_reply(Active, Pid, From, format_packet_error(Transport, Socket, SO, Data)). -format_packet_error(_,#socket_options{active = false, mode = Mode}, Data) -> +format_packet_error(_, _,#socket_options{active = false, mode = Mode}, Data) -> {error, {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}; -format_packet_error(Socket, #socket_options{active = _, mode = Mode}, Data) -> - {ssl_error, sslsocket(self(), Socket), {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}. +format_packet_error(Transport, Socket, #socket_options{active = _, mode = Mode}, Data) -> + {ssl_error, ssl_socket:socket(self(), Transport, Socket), {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}. do_format_reply(binary, _, N, Data) when N > 0 -> % Header mode header(N, Data); @@ -2037,8 +2033,9 @@ next_tls_record(Data, #state{tls_record_buffer = Buf0, Alert end. -next_record(#state{tls_packets = [], tls_cipher_texts = [], socket = Socket} = State) -> - inet:setopts(Socket, [{active,once}]), +next_record(#state{tls_packets = [], tls_cipher_texts = [], socket = Socket, + transport_cb = Transport} = State) -> + ssl_socket:setopts(Transport, Socket, [{active,once}]), {no_record, State}; next_record(#state{tls_packets = [], tls_cipher_texts = [CT | Rest], connection_states = ConnStates0} = State) -> @@ -2151,61 +2148,58 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, send_queue = queue:new() }. -sslsocket(Pid, Socket) -> - #sslsocket{pid = Pid, fd = Socket}. - -get_socket_opts(_,[], _, Acc) -> +get_socket_opts(_,_,[], _, Acc) -> {ok, Acc}; -get_socket_opts(Socket, [mode | Tags], SockOpts, Acc) -> - get_socket_opts(Socket, Tags, SockOpts, +get_socket_opts(Transport, Socket, [mode | Tags], SockOpts, Acc) -> + get_socket_opts(Transport, Socket, Tags, SockOpts, [{mode, SockOpts#socket_options.mode} | Acc]); -get_socket_opts(Socket, [packet | Tags], SockOpts, Acc) -> +get_socket_opts(Transport, Socket, [packet | Tags], SockOpts, Acc) -> case SockOpts#socket_options.packet of {Type, headers} -> - get_socket_opts(Socket, Tags, SockOpts, [{packet, Type} | Acc]); + get_socket_opts(Transport, Socket, Tags, SockOpts, [{packet, Type} | Acc]); Type -> - get_socket_opts(Socket, Tags, SockOpts, [{packet, Type} | Acc]) + get_socket_opts(Transport, Socket, Tags, SockOpts, [{packet, Type} | Acc]) end; -get_socket_opts(Socket, [header | Tags], SockOpts, Acc) -> - get_socket_opts(Socket, Tags, SockOpts, +get_socket_opts(Transport, Socket, [header | Tags], SockOpts, Acc) -> + get_socket_opts(Transport, Socket, Tags, SockOpts, [{header, SockOpts#socket_options.header} | Acc]); -get_socket_opts(Socket, [active | Tags], SockOpts, Acc) -> - get_socket_opts(Socket, Tags, SockOpts, +get_socket_opts(Transport, Socket, [active | Tags], SockOpts, Acc) -> + get_socket_opts(Transport, Socket, Tags, SockOpts, [{active, SockOpts#socket_options.active} | Acc]); -get_socket_opts(Socket, [Tag | Tags], SockOpts, Acc) -> - try inet:getopts(Socket, [Tag]) of +get_socket_opts(Transport, Socket, [Tag | Tags], SockOpts, Acc) -> + try ssl_socket:getopts(Transport, Socket, [Tag]) of {ok, [Opt]} -> - get_socket_opts(Socket, Tags, SockOpts, [Opt | Acc]); + get_socket_opts(Transport, Socket, Tags, SockOpts, [Opt | Acc]); {error, Error} -> - {error, {eoptions, {inet_option, Tag, Error}}} + {error, {options, {socket_options, Tag, Error}}} catch %% So that inet behavior does not crash our process - _:Error -> {error, {eoptions, {inet_option, Tag, Error}}} + _:Error -> {error, {options, {socket_options, Tag, Error}}} end; -get_socket_opts(_,Opts, _,_) -> - {error, {eoptions, {inet_option, Opts, function_clause}}}. +get_socket_opts(_, _,Opts, _,_) -> + {error, {options, {socket_options, Opts, function_clause}}}. -set_socket_opts(_, [], SockOpts, []) -> +set_socket_opts(_,_, [], SockOpts, []) -> {ok, SockOpts}; -set_socket_opts(Socket, [], SockOpts, Other) -> +set_socket_opts(Transport, Socket, [], SockOpts, Other) -> %% Set non emulated options - try inet:setopts(Socket, Other) of + try ssl_socket:setopts(Transport, Socket, Other) of ok -> {ok, SockOpts}; {error, InetError} -> - {{error, {eoptions, {inet_options, Other, InetError}}}, SockOpts} + {{error, {options, {socket_options, Other, InetError}}}, SockOpts} catch _:Error -> %% So that inet behavior does not crash our process - {{error, {eoptions, {inet_options, Other, Error}}}, SockOpts} + {{error, {options, {socket_options, Other, Error}}}, SockOpts} end; -set_socket_opts(Socket, [{mode, Mode}| Opts], SockOpts, Other) when Mode == list; Mode == binary -> - set_socket_opts(Socket, Opts, +set_socket_opts(Transport,Socket, [{mode, Mode}| Opts], SockOpts, Other) when Mode == list; Mode == binary -> + set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{mode = Mode}, Other); -set_socket_opts(_, [{mode, _} = Opt| _], SockOpts, _) -> - {{error, {eoptions, {inet_opt, Opt}}}, SockOpts}; -set_socket_opts(Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet == raw; +set_socket_opts(_, _, [{mode, _} = Opt| _], SockOpts, _) -> + {{error, {options, {socket_options, Opt}}}, SockOpts}; +set_socket_opts(Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet == raw; Packet == 0; Packet == 1; Packet == 2; @@ -2220,24 +2214,24 @@ set_socket_opts(Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet = Packet == httph; Packet == http_bin; Packet == httph_bin -> - set_socket_opts(Socket, Opts, + set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{packet = Packet}, Other); -set_socket_opts(_, [{packet, _} = Opt| _], SockOpts, _) -> - {{error, {eoptions, {inet_opt, Opt}}}, SockOpts}; -set_socket_opts(Socket, [{header, Header}| Opts], SockOpts, Other) when is_integer(Header) -> - set_socket_opts(Socket, Opts, +set_socket_opts(_, _, [{packet, _} = Opt| _], SockOpts, _) -> + {{error, {options, {socket_options, Opt}}}, SockOpts}; +set_socket_opts(Transport, Socket, [{header, Header}| Opts], SockOpts, Other) when is_integer(Header) -> + set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{header = Header}, Other); -set_socket_opts(_, [{header, _} = Opt| _], SockOpts, _) -> - {{error,{eoptions, {inet_opt, Opt}}}, SockOpts}; -set_socket_opts(Socket, [{active, Active}| Opts], SockOpts, Other) when Active == once; - Active == true; - Active == false -> - set_socket_opts(Socket, Opts, +set_socket_opts(_, _, [{header, _} = Opt| _], SockOpts, _) -> + {{error,{options, {socket_options, Opt}}}, SockOpts}; +set_socket_opts(Transport, Socket, [{active, Active}| Opts], SockOpts, Other) when Active == once; + Active == true; + Active == false -> + set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{active = Active}, Other); -set_socket_opts(_, [{active, _} = Opt| _], SockOpts, _) -> - {{error, {eoptions, {inet_opt, Opt}} }, SockOpts}; -set_socket_opts(Socket, [Opt | Opts], SockOpts, Other) -> - set_socket_opts(Socket, Opts, SockOpts, [Opt | Other]). +set_socket_opts(_, _, [{active, _} = Opt| _], SockOpts, _) -> + {{error, {options, {socket_options, Opt}} }, SockOpts}; +set_socket_opts(Transport, Socket, [Opt | Opts], SockOpts, Other) -> + set_socket_opts(Transport, Socket, Opts, SockOpts, [Opt | Other]). handle_alerts([], Result) -> Result; @@ -2248,12 +2242,13 @@ handle_alerts([Alert | Alerts], {next_state, StateName, State, _Timeout}) -> handle_alerts(Alerts, handle_alert(Alert, StateName, State)). handle_alert(#alert{level = ?FATAL} = Alert, StateName, - #state{socket = Socket, start_or_recv_from = From, host = Host, + #state{socket = Socket, transport_cb = Transport, + start_or_recv_from = From, host = Host, port = Port, session = Session, user_application = {_Mon, Pid}, log_alert = Log, role = Role, socket_options = Opts} = State) -> invalidate_session(Role, Host, Port, Session), log_alert(Log, StateName, Alert), - alert_user(Socket, StateName, Opts, Pid, From, Alert, Role), + alert_user(Transport, Socket, StateName, Opts, Pid, From, Alert, Role), {stop, normal, State}; handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, @@ -2280,28 +2275,28 @@ handle_alert(#alert{level = ?WARNING, description = ?USER_CANCELED} = Alert, Sta {Record, State} = next_record(State0), next_state(StateName, StateName, Record, State). -alert_user(Socket, connection, Opts, Pid, From, Alert, Role) -> - alert_user(Socket, Opts#socket_options.active, Pid, From, Alert, Role); -alert_user(Socket,_, _, _, From, Alert, Role) -> - alert_user(Socket, From, Alert, Role). +alert_user(Transport, Socket, connection, Opts, Pid, From, Alert, Role) -> + alert_user(Transport,Socket, Opts#socket_options.active, Pid, From, Alert, Role); +alert_user(Transport, Socket,_, _, _, From, Alert, Role) -> + alert_user(Transport, Socket, From, Alert, Role). -alert_user(Socket, From, Alert, Role) -> - alert_user(Socket, false, no_pid, From, Alert, Role). +alert_user(Transport, Socket, From, Alert, Role) -> + alert_user(Transport, Socket, false, no_pid, From, Alert, Role). -alert_user(_Socket, false = Active, Pid, From, Alert, Role) -> +alert_user(_,_, false = Active, Pid, From, Alert, Role) -> %% If there is an outstanding ssl_accept | recv %% From will be defined and send_or_reply will %% send the appropriate error message. ReasonCode = ssl_alert:reason_code(Alert, Role), send_or_reply(Active, Pid, From, {error, ReasonCode}); -alert_user(Socket, Active, Pid, From, Alert, Role) -> +alert_user(Transport, Socket, Active, Pid, From, Alert, Role) -> case ssl_alert:reason_code(Alert, Role) of closed -> send_or_reply(Active, Pid, From, - {ssl_closed, sslsocket(self(), Socket)}); + {ssl_closed, ssl_socket:socket(self(), Transport, Socket)}); ReasonCode -> send_or_reply(Active, Pid, From, - {ssl_error, sslsocket(self(), Socket), ReasonCode}) + {ssl_error, ssl_socket:socket(self(), Transport, Socket), ReasonCode}) end. log_alert(true, Info, Alert) -> @@ -2332,15 +2327,17 @@ handle_own_alert(Alert, Version, StateName, {stop, {shutdown, own_alert}, State}. handle_normal_shutdown(Alert, _, #state{socket = Socket, + transport_cb = Transport, start_or_recv_from = StartFrom, role = Role, renegotiation = {false, first}}) -> - alert_user(Socket, StartFrom, Alert, Role); + alert_user(Transport, Socket, StartFrom, Alert, Role); handle_normal_shutdown(Alert, StateName, #state{socket = Socket, socket_options = Opts, + transport_cb = Transport, user_application = {_Mon, Pid}, start_or_recv_from = RecvFrom, role = Role}) -> - alert_user(Socket, StateName, Opts, Pid, RecvFrom, Alert, Role). + alert_user(Transport, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role). handle_unexpected_message(Msg, Info, #state{negotiated_version = Version} = State) -> Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), @@ -2424,7 +2421,7 @@ workaround_transport_delivery_problems(Socket, gen_tcp = Transport) -> %% data sent to the tcp port is really delivered to the %% peer application before tcp port is closed so that the peer will %% get the correct TLS alert message and not only a transport close. - inet:setopts(Socket, [{active, false}]), + ssl_socket:setopts(Transport, Socket, [{active, false}]), Transport:shutdown(Socket, write), %% Will return when other side has closed or after 30 s %% e.g. we do not want to hang if something goes wrong @@ -2518,7 +2515,7 @@ cancel_timer(Timer) -> ok. handle_unrecv_data(StateName, #state{socket = Socket, transport_cb = Transport} = State) -> - inet:setopts(Socket, [{active, false}]), + ssl_socket:setopts(Transport, Socket, [{active, false}]), case Transport:recv(Socket, 0, 0) of {error, closed} -> ok; diff --git a/lib/ssl/src/ssl_debug.erl b/lib/ssl/src/ssl_debug.erl deleted file mode 100644 index 625889c43b..0000000000 --- a/lib/ssl/src/ssl_debug.erl +++ /dev/null @@ -1,99 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-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% -%% - -%% - -%%% Purpose : some debug utilities - --module(ssl_debug). - --export([unhex/1, hexd/1, hex_data/2, term_data/2, hex_data/4, term_data/4, make_binary/1]). - -%% external - -hex_data(Name, Data) -> - io:format("~s\n~s", [Name, hex(Data)]). - -term_data(Name, Term) -> - io:format("~s\n~p\n", [Name, Term]). - -hex_data(Name, Data, Mod, Line) -> - io:format("~w:~p ~s\n~s", [Mod, Line, Name, hex(Data)]). - -term_data(Name, Term, Mod, Line) -> - io:format("~w:~p ~s\n~p\n", [Mod, Line, Name, Term]). - -unhex(S) -> - Lines = string:tokens(S, "\n"), - H = [unhex(L, []) || L <- Lines], - list_to_binary(H). - -make_binary(Size) -> - crypto:rand_bytes(Size). - -%% internal - -is_hex_digit(C) when C >= $0, C =< $9 -> true; -is_hex_digit(C) when C >= $A, C =< $F -> true; -is_hex_digit(C) when C >= $a, C =< $f -> true; -is_hex_digit(_) -> false. - -unhex([], Acc) -> - list_to_binary(lists:reverse(Acc)); -unhex([_], Acc) -> - unhex([], Acc); -unhex([$ | Tl], Acc) -> - unhex(Tl, Acc); -unhex([D1, D2 | Tl], Acc) -> - case {is_hex_digit(D1), is_hex_digit(D2)} of - {true, true} -> - unhex(Tl, [erlang:list_to_integer([D1, D2], 16) | Acc]); - _ -> - unhex([], Acc) - end. - -hexd(B) -> - io:format("~s\n", [hex(B)]). - -hex(B) -> hex(erlang:iolist_to_binary(B), []). - -hex_asc(B) -> - L = binary_to_list(B), - {hexify(L), asciify(L)}. - -hex(<<B:16/binary, Rest/binary>>, Acc) -> - {HS, AS} = hex_asc(B), - hex(Rest, ["\n", AS, " ", HS | Acc]); -hex(<<>>, Acc) -> - lists:reverse(Acc); -hex(B, Acc) -> - {HS, AS} = hex_asc(B), - L = erlang:iolist_size(HS), - lists:flatten(lists:reverse(Acc, [HS, lists:duplicate(3*16 - L, $ ), " ", AS, "\n"])). - -hexify(L) -> [[hex_byte(B), " "] || B <- L]. - -hex_byte(B) when B < 16#10 -> ["0", erlang:integer_to_list(B, 16)]; -hex_byte(B) -> erlang:integer_to_list(B, 16). - -asciify(L) -> [ascii_byte(C) || C <- L]. - -ascii_byte($") -> $.; -ascii_byte(C) when C < 32; C >= 127 -> $.; -ascii_byte(C) -> C. diff --git a/lib/ssl/src/ssl_socket.erl b/lib/ssl/src/ssl_socket.erl new file mode 100644 index 0000000000..4778db2333 --- /dev/null +++ b/lib/ssl/src/ssl_socket.erl @@ -0,0 +1,35 @@ +-module(ssl_socket). + +-include("ssl_internal.hrl"). + +-export([socket/3, setopts/3, getopts/3, peername/2, sockname/2, port/2]). + +socket(Pid, Transport, Socket) -> + #sslsocket{pid = Pid, + %% "The name "fd" is keept for backwards compatibility + fd = {Transport, Socket}}. + +setopts(gen_tcp, Socket, Options) -> + inet:setopts(Socket, Options); +setopts(Transport, Socket, Options) -> + Transport:setopts(Socket, Options). + +getopts(gen_tcp, Socket, Options) -> + inet:getopts(Socket, Options); +getopts(Transport, Socket, Options) -> + Transport:getopts(Socket, Options). + +peername(gen_tcp, Socket) -> + inet:peername(Socket); +peername(Transport, Socket) -> + Transport:peername(Socket). + +sockname(gen_tcp, Socket) -> + inet:sockname(Socket); +sockname(Transport, Socket) -> + Transport:sockname(Socket). + +port(gen_tcp, Socket) -> + inet:port(Socket); +port(Transport, Socket) -> + Transport:port(Socket). diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 7067cd861d..b5c6a1da49 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -99,10 +99,10 @@ options_tests() -> invalid_inet_set_option_not_list, invalid_inet_set_option_improper_list, dh_params, - ecertfile, - ecacertfile, - ekeyfile, - eoptions, + invalid_certfile, + invalid_cacertfile, + invalid_keyfile, + invalid_options, protocol_versions, empty_protocol_versions, ipv6, @@ -822,7 +822,7 @@ invalid_inet_get_option_not_list(Config) when is_list(Config) -> get_invalid_inet_option_not_list(Socket) -> - {error, {eoptions, {inet_options, some_invalid_atom_here}}} + {error, {options, {socket_options, some_invalid_atom_here}}} = ssl:getopts(Socket, some_invalid_atom_here), ok. @@ -854,7 +854,7 @@ invalid_inet_get_option_improper_list(Config) when is_list(Config) -> get_invalid_inet_option_improper_list(Socket) -> - {error, {eoptions, {inet_option, foo,_}}} = ssl:getopts(Socket, [packet | foo]), + {error, {options, {socket_options, foo,_}}} = ssl:getopts(Socket, [packet | foo]), ok. %%-------------------------------------------------------------------- @@ -884,10 +884,10 @@ invalid_inet_set_option(Config) when is_list(Config) -> ssl_test_lib:close(Client). set_invalid_inet_option(Socket) -> - {error, {eoptions, {inet_opt, {packet, foo}}}} = ssl:setopts(Socket, [{packet, foo}]), - {error, {eoptions, {inet_opt, {header, foo}}}} = ssl:setopts(Socket, [{header, foo}]), - {error, {eoptions, {inet_opt, {active, foo}}}} = ssl:setopts(Socket, [{active, foo}]), - {error, {eoptions, {inet_opt, {mode, foo}}}} = ssl:setopts(Socket, [{mode, foo}]), + {error, {options, {socket_options, {packet, foo}}}} = ssl:setopts(Socket, [{packet, foo}]), + {error, {options, {socket_options, {header, foo}}}} = ssl:setopts(Socket, [{header, foo}]), + {error, {options, {socket_options, {active, foo}}}} = ssl:setopts(Socket, [{active, foo}]), + {error, {options, {socket_options, {mode, foo}}}} = ssl:setopts(Socket, [{mode, foo}]), ok. %%-------------------------------------------------------------------- invalid_inet_set_option_not_list() -> @@ -917,7 +917,7 @@ invalid_inet_set_option_not_list(Config) when is_list(Config) -> set_invalid_inet_option_not_list(Socket) -> - {error, {eoptions, {not_a_proplist, some_invalid_atom_here}}} + {error, {options, {not_a_proplist, some_invalid_atom_here}}} = ssl:setopts(Socket, some_invalid_atom_here), ok. @@ -948,7 +948,7 @@ invalid_inet_set_option_improper_list(Config) when is_list(Config) -> ssl_test_lib:close(Client). set_invalid_inet_option_improper_list(Socket) -> - {error, {eoptions, {not_a_proplist, [{packet, 0} | {foo, 2}]}}} = + {error, {options, {not_a_proplist, [{packet, 0} | {foo, 2}]}}} = ssl:setopts(Socket, [{packet, 0} | {foo, 2}]), ok. @@ -966,7 +966,6 @@ misc_ssl_options(Config) when is_list(Config) -> {key, undefined}, {password, []}, {reuse_session, fun(_,_,_,_) -> true end}, - {debug, []}, {cb_info, {gen_tcp, tcp, tcp_closed, tcp_error}}], Server = @@ -1287,9 +1286,9 @@ ipv6(Config) when is_list(Config) -> %%-------------------------------------------------------------------- -ekeyfile() -> +invalid_keyfile() -> [{doc,"Test what happens with an invalid key file"}]. -ekeyfile(Config) when is_list(Config) -> +invalid_keyfile(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), BadOpts = ?config(server_bad_key, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1305,16 +1304,17 @@ ekeyfile(Config) when is_list(Config) -> ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, {options, ClientOpts}]), - - ssl_test_lib:check_result(Server, {error, ekeyfile}, Client, - {error, closed}). + + File = proplists:get_value(keyfile,BadOpts), + ssl_test_lib:check_result(Server, {error,{options, {keyfile, File, {error,enoent}}}}, Client, + {error, closed}). %%-------------------------------------------------------------------- -ecertfile() -> +invalid_certfile() -> [{doc,"Test what happens with an invalid cert file"}]. -ecertfile(Config) when is_list(Config) -> +invalid_certfile(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), ServerBadOpts = ?config(server_bad_cert, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1331,16 +1331,16 @@ ecertfile(Config) when is_list(Config) -> {port, Port}, {host, Hostname}, {from, self()}, {options, ClientOpts}]), - - ssl_test_lib:check_result(Server, {error, ecertfile}, Client, - {error, closed}). + File = proplists:get_value(certfile, ServerBadOpts), + ssl_test_lib:check_result(Server, {error,{options, {certfile, File, {error,enoent}}}}, + Client, {error, closed}). %%-------------------------------------------------------------------- -ecacertfile() -> +invalid_cacertfile() -> [{doc,"Test what happens with an invalid cacert file"}]. -ecacertfile(Config) when is_list(Config) -> +invalid_cacertfile(Config) when is_list(Config) -> ClientOpts = [{reuseaddr, true}|?config(client_opts, Config)], ServerBadOpts = [{reuseaddr, true}|?config(server_bad_ca, Config)], {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1358,11 +1358,12 @@ ecacertfile(Config) when is_list(Config) -> {port, Port0}, {host, Hostname}, {from, self()}, {options, ClientOpts}]), + + File0 = proplists:get_value(cacertfile, ServerBadOpts), - ssl_test_lib:check_result(Server0, {error, ecacertfile}, + ssl_test_lib:check_result(Server0, {error, {options, {cacertfile, File0,{error,enoent}}}}, Client0, {error, closed}), - File0 = proplists:get_value(cacertfile, ServerBadOpts), File = File0 ++ "do_not_exit.pem", ServerBadOpts1 = [{cacertfile, File}|proplists:delete(cacertfile, ServerBadOpts)], @@ -1379,31 +1380,32 @@ ecacertfile(Config) when is_list(Config) -> {from, self()}, {options, ClientOpts}]), - ssl_test_lib:check_result(Server1, {error, ecacertfile}, + + ssl_test_lib:check_result(Server1, {error, {options, {cacertfile, File,{error,enoent}}}}, Client1, {error, closed}), ok. %%-------------------------------------------------------------------- -eoptions() -> +invalid_options() -> [{doc,"Test what happens when we give invalid options"}]. -eoptions(Config) when is_list(Config) -> +invalid_options(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), ServerOpts = ?config(server_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Check = fun(Client, Server, {versions, [sslv2, sslv3]} = Option) -> ssl_test_lib:check_result(Server, - {error, {eoptions, {sslv2, Option}}}, + {error, {options, {sslv2, Option}}}, Client, - {error, {eoptions, {sslv2, Option}}}); + {error, {options, {sslv2, Option}}}); (Client, Server, Option) -> ssl_test_lib:check_result(Server, - {error, {eoptions, Option}}, + {error, {options, Option}}, Client, - {error, {eoptions, Option}}) + {error, {options, Option}}) end, TestOpts = [{versions, [sslv2, sslv3]}, @@ -1421,7 +1423,6 @@ eoptions(Config) when is_list(Config) -> {reuse_session, foo}, {reuse_sessions, 0}, {renegotiate_at, "10"}, - {debug, 1}, {mode, depech}, {packet, 8.0}, {packet_size, "2"}, @@ -1595,8 +1596,8 @@ default_reject_anonymous(Config) when is_list(Config) -> [{ciphers,[Cipher]} | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {essl, "insufficient security"}}, - Client, {error, {essl, "insufficient security"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "insufficient security"}}, + Client, {error, {tls_alert, "insufficient security"}}). %%-------------------------------------------------------------------- reuse_session() -> @@ -3149,7 +3150,7 @@ treashold(N, _) -> N + 1. get_invalid_inet_option(Socket) -> - {error, {eoptions, {inet_option, foo, _}}} = ssl:getopts(Socket, [foo]), + {error, {options, {socket_options, foo, _}}} = ssl:getopts(Socket, [foo]), ok. shutdown_result(Socket, server) -> diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 86e1d47be7..26938bda50 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -252,8 +252,8 @@ server_require_peer_cert_fail(Config) when is_list(Config) -> {from, self()}, {options, [{active, false} | BadClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {essl, "handshake failure"}}, - Client, {error, {essl, "handshake failure"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "handshake failure"}}, + Client, {error, {tls_alert, "handshake failure"}}). %%-------------------------------------------------------------------- @@ -293,14 +293,14 @@ verify_fun_always_run_client(Config) when is_list(Config) -> [{verify, verify_peer}, {verify_fun, FunAndState} | ClientOpts]}]), - %% Server error may be {essl,"handshake failure"} or closed depending on timing + %% Server error may be {tls_alert,"handshake failure"} or closed depending on timing %% this is not a bug it is a circumstance of how tcp works! receive {Server, ServerError} -> ct:print("Server Error ~p~n", [ServerError]) end, - ssl_test_lib:check_result(Client, {error, {essl, "handshake failure"}}). + ssl_test_lib:check_result(Client, {error, {tls_alert, "handshake failure"}}). %%-------------------------------------------------------------------- verify_fun_always_run_server() -> @@ -342,14 +342,14 @@ verify_fun_always_run_server(Config) when is_list(Config) -> [{verify, verify_peer} | ClientOpts]}]), - %% Client error may be {essl, "handshake failure" } or closed depending on timing + %% Client error may be {tls_alert, "handshake failure" } or closed depending on timing %% this is not a bug it is a circumstance of how tcp works! receive {Client, ClientError} -> ct:print("Client Error ~p~n", [ClientError]) end, - ssl_test_lib:check_result(Server, {error, {essl, "handshake failure"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "handshake failure"}}). %%-------------------------------------------------------------------- @@ -432,8 +432,8 @@ cert_expired(Config) when is_list(Config) -> {from, self()}, {options, [{verify, verify_peer} | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {essl, "certificate expired"}}, - Client, {error, {essl, "certificate expired"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "certificate expired"}}, + Client, {error, {tls_alert, "certificate expired"}}). two_digits_str(N) when N < 10 -> lists:flatten(io_lib:format("0~p", [N])); @@ -710,8 +710,8 @@ invalid_signature_server(Config) when is_list(Config) -> {from, self()}, {options, [{verify, verify_peer} | ClientOpts]}]), - tcp_delivery_workaround(Server, {error, {essl, "bad certificate"}}, - Client, {error, {essl, "bad certificate"}}). + tcp_delivery_workaround(Server, {error, {tls_alert, "bad certificate"}}, + Client, {error, {tls_alert, "bad certificate"}}). %%-------------------------------------------------------------------- @@ -747,8 +747,8 @@ invalid_signature_client(Config) when is_list(Config) -> {from, self()}, {options, NewClientOpts}]), - tcp_delivery_workaround(Server, {error, {essl, "bad certificate"}}, - Client, {error, {essl, "bad certificate"}}). + tcp_delivery_workaround(Server, {error, {tls_alert, "bad certificate"}}, + Client, {error, {tls_alert, "bad certificate"}}). %%-------------------------------------------------------------------- @@ -792,7 +792,7 @@ server_verify_no_cacerts(Config) when is_list(Config) -> {options, [{verify, verify_peer} | ServerOpts]}]), - ssl_test_lib:check_result(Server, {error, {eoptions, {cacertfile, ""}}}). + ssl_test_lib:check_result(Server, {error, {options, {cacertfile, ""}}}). %%-------------------------------------------------------------------- @@ -829,8 +829,8 @@ unknown_server_ca_fail(Config) when is_list(Config) -> {verify_fun, FunAndState} | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {essl, "unknown ca"}}, - Client, {error, {essl, "unknown ca"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "unknown ca"}}, + Client, {error, {tls_alert, "unknown ca"}}). %%-------------------------------------------------------------------- unknown_server_ca_accept_verify_none() -> diff --git a/lib/ssl/test/ssl_npn_handshake_SUITE.erl b/lib/ssl/test/ssl_npn_handshake_SUITE.erl index 4e848095a5..862690cd7b 100644 --- a/lib/ssl/test/ssl_npn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_npn_handshake_SUITE.erl @@ -106,15 +106,15 @@ end_per_group(_GroupName, Config) -> %%-------------------------------------------------------------------- validate_empty_protocols_are_not_allowed(Config) when is_list(Config) -> - {error, {eoptions, {next_protocols_advertised, {invalid_protocol, <<>>}}}} + {error, {options, {next_protocols_advertised, {invalid_protocol, <<>>}}}} = (catch ssl:listen(9443, [{next_protocols_advertised, [<<"foo/1">>, <<"">>]}])), - {error, {eoptions, {client_preferred_next_protocols, {invalid_protocol, <<>>}}}} + {error, {options, {client_preferred_next_protocols, {invalid_protocol, <<>>}}}} = (catch ssl:connect({127,0,0,1}, 9443, [{client_preferred_next_protocols, {client, [<<"foo/1">>, <<"">>], <<"foox/1">>}}], infinity)), Option = {client_preferred_next_protocols, {invalid_protocol, <<"">>}}, - {error, {eoptions, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option], infinity)). + {error, {options, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option], infinity)). %-------------------------------------------------------------------------------- @@ -126,12 +126,12 @@ validate_empty_advertisement_list_is_allowed(Config) when is_list(Config) -> validate_advertisement_must_be_a_binary_list(Config) when is_list(Config) -> Option = {next_protocols_advertised, blah}, - {error, {eoptions, Option}} = (catch ssl:listen(9443, [Option])). + {error, {options, Option}} = (catch ssl:listen(9443, [Option])). %-------------------------------------------------------------------------------- validate_client_protocols_must_be_a_tuple(Config) when is_list(Config) -> Option = {client_preferred_next_protocols, [<<"foo/1">>]}, - {error, {eoptions, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option])). + {error, {options, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option])). %-------------------------------------------------------------------------------- @@ -220,7 +220,7 @@ npn_not_supported_client(Config) when is_list(Config) -> {from, self()}, {options, ClientOpts}]), ssl_test_lib:check_result(Client, {error, - {eoptions, + {options, {not_supported_in_sslv3, PrefProtocols}}}). %-------------------------------------------------------------------------------- @@ -229,7 +229,7 @@ npn_not_supported_server(Config) when is_list(Config)-> AdvProtocols = {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, ServerOpts = [AdvProtocols] ++ ServerOpts0, - {error, {eoptions, {not_supported_in_sslv3, AdvProtocols}}} = ssl:listen(0, ServerOpts). + {error, {options, {not_supported_in_sslv3, AdvProtocols}}} = ssl:listen(0, ServerOpts). %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 8d96a70a6e..d58541df52 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -206,7 +206,7 @@ close(Pid) -> check_result(Server, {error, SReason} = ServerMsg, Client, {error, closed} = ClientMsg) -> receive - {Server, {error, {SReason, _}}} -> + {Server, {error, SReason}} -> receive {Client, ClientMsg} -> ok; diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 7c0c00bf36..4f53132d5d 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -902,7 +902,7 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> ok end, - ssl_test_lib:check_result(Server, {error, {essl, "protocol version"}}), + ssl_test_lib:check_result(Server, {error, {tls_alert, "protocol version"}}), process_flag(trap_exit, false). %%-------------------------------------------------------------------- diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index cb73e86ede..1f3bef83c8 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 5.2 +SSL_VSN = 5.2.1 diff --git a/lib/stdlib/doc/src/io.xml b/lib/stdlib/doc/src/io.xml index fa475804eb..63f814ad2e 100644 --- a/lib/stdlib/doc/src/io.xml +++ b/lib/stdlib/doc/src/io.xml @@ -390,10 +390,11 @@ ok</pre> applicable, it is used for both the field width and precision. The default padding character is <c>' '</c> (space).</p> <p><c>Mod</c> is the control sequence modifier. It is either a - single character (currently only <c>t</c>, for Unicode translation, - is supported) that changes the interpretation of Data.</p> - - <p>The following control sequences are available:</p> + single character (currently only <c>t</c>, for Unicode + translation, and <c>l</c>, for stopping <c>p</c> and + <c>P</c> from detecting printable characters, are supported) + that changes the interpretation of Data.</p> + <p>The following control sequences are available:</p> <taglist> <tag><c>~</c></tag> <item> @@ -407,7 +408,7 @@ ok</pre> which in turn defaults to 1. The following example illustrates:</p> <pre> -2> <input>io:fwrite("|~10.5c|~-10.5c|~5c|~n", [$a, $b, $c]).</input> +1> <input>io:fwrite("|~10.5c|~-10.5c|~5c|~n", [$a, $b, $c]).</input> | aaaaa|bbbbb |ccccc| ok</pre> <p>If the Unicode translation modifier (<c>t</c>) is in effect, @@ -415,10 +416,10 @@ ok</pre> valid Unicode codepoint, otherwise it should be an integer less than or equal to 255, otherwise it is masked with 16#FF:</p> <pre> -1> <input>io:fwrite("~tc~n",[1024]).</input> +2> <input>io:fwrite("~tc~n",[1024]).</input> \x{400} ok -2> <input>io:fwrite("~c~n",[1024]).</input> +3> <input>io:fwrite("~c~n",[1024]).</input> ^@ ok</pre> @@ -462,20 +463,20 @@ ok</pre> <p>This format can be used for printing any object and truncating the output so it fits a specified field:</p> <pre> -3> <input>io:fwrite("|~10w|~n", [{hey, hey, hey}]).</input> +1> <input>io:fwrite("|~10w|~n", [{hey, hey, hey}]).</input> |**********| ok -4> <input>io:fwrite("|~10s|~n", [io_lib:write({hey, hey, hey})]).</input> +2> <input>io:fwrite("|~10s|~n", [io_lib:write({hey, hey, hey})]).</input> |{hey,hey,h| -5> <input>io:fwrite("|~-10.8s|~n", [io_lib:write({hey, hey, hey})]).</input> +3> <input>io:fwrite("|~-10.8s|~n", [io_lib:write({hey, hey, hey})]).</input> |{hey,hey | ok</pre> <p>A list with integers larger than 255 is considered an error if the Unicode translation modifier is not given:</p> <pre> -1> <input>io:fwrite("~ts~n",[[1024]]).</input> +4> <input>io:fwrite("~ts~n",[[1024]]).</input> \x{400} ok -2> io:fwrite("~s~n",[[1024]]). +5> <input>io:fwrite("~s~n",[[1024]]).</input> ** exception exit: {badarg,[{io,format,[<0.26.0>,"~s~n",[[1024]]]}, ...</pre> </item> @@ -493,20 +494,21 @@ ok <c>~w</c>, but breaks terms whose printed representation is longer than one line into many lines and indents each line sensibly. It also tries to detect lists of - printable characters and to output these as strings. - For example:</p> + printable characters and to output these as strings. The + Unicode translation modifier is used for determining + what characters are printable. For example:</p> <pre> -5> <input>T = [{attributes,[[{id,age,1.50000},{mode,explicit},</input> +1> <input>T = [{attributes,[[{id,age,1.50000},{mode,explicit},</input> <input>{typename,"INTEGER"}], [{id,cho},{mode,explicit},{typename,'Cho'}]]},</input> <input>{typename,'Person'},{tag,{'PRIVATE',3}},{mode,implicit}].</input> ... -6> <input>io:fwrite("~w~n", [T]).</input> +2> <input>io:fwrite("~w~n", [T]).</input> [{attributes,[[{id,age,1.5},{mode,explicit},{typename, [73,78,84,69,71,69,82]}],[{id,cho},{mode,explicit},{typena me,'Cho'}]]},{typename,'Person'},{tag,{'PRIVATE',3}},{mode ,implicit}] ok -7> <input>io:fwrite("~62p~n", [T]).</input> +3> <input>io:fwrite("~62p~n", [T]).</input> [{attributes,[[{id,age,1.5}, {mode,explicit}, {typename,"INTEGER"}], @@ -522,7 +524,7 @@ ok</pre> <c>io:fwrite</c> or <c>io:format</c>. For example, using <c>T</c> above:</p> <pre> -8> <input>io:fwrite("Here T = ~62p~n", [T]).</input> +4> <input>io:fwrite("Here T = ~62p~n", [T]).</input> Here T = [{attributes,[[{id,age,1.5}, {mode,explicit}, {typename,"INTEGER"}], @@ -533,6 +535,31 @@ Here T = [{attributes,[[{id,age,1.5}, {tag,{'PRIVATE',3}}, {mode,implicit}] ok</pre> + <p>When the modifier <c>l</c> is given no detection of + printable character lists will take place. For example:</p> + <pre> +5> <input>S = [{a,"a"}, {b, "b"}].</input> +6> <input>io:fwrite("~15p~n", [S]).</input> +[{a,"a"}, + {b,"b"}] +ok +7> <input>io:fwrite("~15lp~n", [S]).</input> +[{a,[97]}, + {b,[98]}] +ok</pre> + <p>Binaries that look like UTF-8 encoded strings will be + output with the string syntax if the Unicode translation + modifier is given:</p> + <pre> +9> <input>io:fwrite("~p~n",[[1024]]).</input> +[1024] +10> <input>io:fwrite("~tp~n",[[1024]]).</input> +"\x{400}" +11> <input>io:fwrite("~tp~n", [<<128,128>>]).</input> +<<128,128>> +12> <input>io:fwrite("~tp~n", [<<208,128>>]).</input> +<<"\x{400}"/utf8>> +ok</pre> </item> <tag><c>W</c></tag> <item> @@ -541,7 +568,7 @@ ok</pre> are printed. Anything below this depth is replaced with <c>...</c>. For example, using <c>T</c> above:</p> <pre> -9> <input>io:fwrite("~W~n", [T,9]).</input> +8> <input>io:fwrite("~W~n", [T,9]).</input> [{attributes,[[{id,age,1.5},{mode,explicit},{typename,...}], [{id,cho},{mode,...},{...}]]},{typename,'Person'}, {tag,{'PRIVATE',3}},{mode,implicit}] @@ -558,7 +585,7 @@ ok</pre> are printed. Anything below this depth is replaced with <c>...</c>. For example:</p> <pre> -10> <input>io:fwrite("~62P~n", [T,9]).</input> +9> <input>io:fwrite("~62P~n", [T,9]).</input> [{attributes,[[{id,age,1.5},{mode,explicit},{typename,...}], [{id,cho},{mode,...},{...}]]}, {typename,'Person'}, @@ -572,13 +599,13 @@ ok</pre> 10. A leading dash is printed for negative integers.</p> <p>The precision field selects base. For example:</p> <pre> -11> <input>io:fwrite("~.16B~n", [31]).</input> +1> <input>io:fwrite("~.16B~n", [31]).</input> 1F ok -12> <input>io:fwrite("~.2B~n", [-19]).</input> +2> <input>io:fwrite("~.2B~n", [-19]).</input> -10011 ok -13> <input>io:fwrite("~.36B~n", [5*36+35]).</input> +3> <input>io:fwrite("~.36B~n", [5*36+35]).</input> 5Z ok</pre> </item> @@ -590,10 +617,10 @@ ok</pre> <p>The prefix can be a possibly deep list of characters or an atom.</p> <pre> -14> <input>io:fwrite("~X~n", [31,"10#"]).</input> +1> <input>io:fwrite("~X~n", [31,"10#"]).</input> 10#31 ok -15> <input>io:fwrite("~.16X~n", [-31,"0x"]).</input> +2> <input>io:fwrite("~.16X~n", [-31,"0x"]).</input> -0x1F ok</pre> </item> @@ -602,10 +629,10 @@ ok</pre> <p>Like <c>B</c>, but prints the number with an Erlang style <c>#</c>-separated base prefix.</p> <pre> -16> <input>io:fwrite("~.10#~n", [31]).</input> +1> <input>io:fwrite("~.10#~n", [31]).</input> 10#31 ok -17> <input>io:fwrite("~.16#~n", [-31]).</input> +2> <input>io:fwrite("~.16#~n", [-31]).</input> -16#1F ok</pre> </item> @@ -639,10 +666,10 @@ ok</pre> </taglist> <p>If an error occurs, there is no output. For example:</p> <pre> -18> <input>io:fwrite("~s ~w ~i ~w ~c ~n",['abc def', 'abc def', {foo, 1},{foo, 1}, 65]).</input> +1> <input>io:fwrite("~s ~w ~i ~w ~c ~n",['abc def', 'abc def', {foo, 1},{foo, 1}, 65]).</input> abc def 'abc def' {foo,1} A ok -19> <input>io:fwrite("~s", [65]).</input> +2> <input>io:fwrite("~s", [65]).</input> ** exception exit: {badarg,[{io,format,[<0.22.0>,"~s","A"]}, {erl_eval,do_apply,5}, {shell,exprs,6}, diff --git a/lib/stdlib/doc/src/shell.xml b/lib/stdlib/doc/src/shell.xml index bc2120c37d..7f251c863e 100644 --- a/lib/stdlib/doc/src/shell.xml +++ b/lib/stdlib/doc/src/shell.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2011</year> + <year>1996</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -781,7 +781,7 @@ loop(N) -> </desc> </func> <func> - <name>catch_exception(Bool) -> Bool</name> + <name>catch_exception(Bool) -> boolean()</name> <fsummary>Sets the exception handling of the shell</fsummary> <type> <v>Bool = boolean()</v> @@ -801,8 +801,8 @@ loop(N) -> <name name="prompt_func" arity="1"/> <fsummary>Sets the shell prompt</fsummary> <desc> - <p>Sets the shell prompt function to <c>PromptFunc</c>. The - previous prompt function is returned.</p> + <p>Sets the shell prompt function to <c><anno>PromptFunc</anno></c>. + The previous prompt function is returned.</p> </desc> </func> <func> @@ -827,6 +827,20 @@ loop(N) -> is meant to be called from the shell.</p> </desc> </func> + <func> + <name name="strings" arity="1"/> + <fsummary>Sets the shell's string recognition flag.</fsummary> + <desc> + <p>Sets pretty printing of lists to <c><anno>Strings</anno></c>. + The previous value of the flag is returned.</p> + <p>The flag can also be set by the STDLIB application variable + <c>shell_strings</c>. The default is + <c>true</c> which means that lists of integers will be + printed using the string syntax, when possible. The value + <c>false</c> means that no lists will be printed using the + string syntax.</p> + </desc> + </func> </funcs> </erlref> diff --git a/lib/stdlib/doc/src/stdlib_app.xml b/lib/stdlib/doc/src/stdlib_app.xml index a615c1bf88..2391bb6f03 100644 --- a/lib/stdlib/doc/src/stdlib_app.xml +++ b/lib/stdlib/doc/src/stdlib_app.xml @@ -4,7 +4,7 @@ <appref> <header> <copyright> - <year>2005</year><year>2010</year> + <year>2005</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -51,7 +51,7 @@ <p>This parameter can be used to run the Erlang shell in restricted mode.</p> </item> - <tag><c>shell_catch_exception = bool()</c></tag> + <tag><c>shell_catch_exception = boolean()</c></tag> <item> <p>This parameter can be used to set the exception handling of the Erlang shell's evaluator process.</p> @@ -76,6 +76,11 @@ <p>This parameter can be used to determine how many results are saved by the Erlang shell.</p> </item> + <tag><c>shell_strings = boolean()</c></tag> + <item> + <p>This parameter can be used to determine how the Erlang + shell outputs lists of integers.</p> + </item> </taglist> </section> diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl index 41b6ab1d5f..de18b6cd54 100644 --- a/lib/stdlib/src/binary.erl +++ b/lib/stdlib/src/binary.erl @@ -186,7 +186,7 @@ part(_, _) -> -spec part(Subject, Pos, Len) -> binary() when Subject :: binary(), Pos :: non_neg_integer(), - Len :: non_neg_integer(). + Len :: integer(). part(_, _, _) -> erlang:nif_error(undef). diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index 535f2d5174..91d317489c 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -512,7 +512,7 @@ m(M) -> print_object_file(Mod) -> case code:is_loaded(Mod) of {file,File} -> - format("Object file: ~s\n", [File]); + format("Object file: ~ts\n", [File]); _ -> ignore end. @@ -685,7 +685,7 @@ portformat(Name, Id, Cmd) -> pwd() -> case file:get_cwd() of {ok, Str} -> - ok = io:format("~ts\n", [fixup_one_bin(Str)]); + ok = io:format("~ts\n", [Str]); {error, _} -> ok = io:format("Cannot determine current directory\n") end. @@ -712,27 +712,11 @@ ls() -> ls(Dir) -> case file:list_dir(Dir) of {ok, Entries} -> - ls_print(sort(fixup_bin(Entries))); + ls_print(sort(Entries)); {error,_E} -> format("Invalid directory\n") end. -fixup_one_bin(X) when is_binary(X) -> - L = binary_to_list(X), - [ if - El > 127 -> - $?; - true -> - El - end || El <- L]; -fixup_one_bin(X) -> - X. -fixup_bin([H|T]) -> - [fixup_one_bin(H) | fixup_bin(T)]; -fixup_bin([]) -> - []. - - ls_print([]) -> ok; ls_print(L) -> Width = min([max(lengths(L, [])), 40]) + 5, diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 1bb3b95ae2..0a1caa7178 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -614,7 +614,7 @@ enter_file_reply(From, Name, Location, AtLocation) -> %% Flatten filename to a string. Must be a valid filename. -file_name([C | T]) when is_integer(C), C > 0, C =< 255 -> +file_name([C | T]) when is_integer(C), C > 0 -> [C | file_name(T)]; file_name([H|T]) -> file_name(H) ++ file_name(T); diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 254384e877..378e629ac9 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -254,6 +254,9 @@ bif(binary_part, 2) -> true; bif(binary_part, 3) -> true; bif(binary_to_atom, 2) -> true; bif(binary_to_existing_atom, 2) -> true; +bif(binary_to_integer, 1) -> true; +bif(binary_to_integer, 2) -> true; +bif(binary_to_float, 1) -> true; bif(binary_to_list, 1) -> true; bif(binary_to_list, 3) -> true; bif(binary_to_term, 1) -> true; @@ -279,6 +282,8 @@ bif(exit, 2) -> true; bif(float, 1) -> true; bif(float_to_list, 1) -> true; bif(float_to_list, 2) -> true; +bif(float_to_binary, 1) -> true; +bif(float_to_binary, 2) -> true; bif(garbage_collect, 0) -> true; bif(garbage_collect, 1) -> true; bif(get, 0) -> true; @@ -290,6 +295,8 @@ bif(halt, 0) -> true; bif(halt, 1) -> true; bif(halt, 2) -> true; bif(hd, 1) -> true; +bif(integer_to_binary, 1) -> true; +bif(integer_to_binary, 2) -> true; bif(integer_to_list, 1) -> true; bif(integer_to_list, 2) -> true; bif(iolist_size, 1) -> true; diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 12505b33d1..68a8534f15 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -3483,6 +3483,12 @@ extract_sequence(4, [$t, $P | Fmt], Need) -> extract_sequence(5, [$P|Fmt], Need); extract_sequence(4, [$t, C | _Fmt], _Need) -> {error,"invalid control ~t" ++ [C]}; +extract_sequence(4, [$l, $p | Fmt], Need) -> + extract_sequence(5, [$p|Fmt], Need); +extract_sequence(4, [$l, $P | Fmt], Need) -> + extract_sequence(5, [$P|Fmt], Need); +extract_sequence(4, [$l, C | _Fmt], _Need) -> + {error,"invalid control ~l" ++ [C]}; extract_sequence(4, Fmt, Need) -> extract_sequence(5, Fmt, Need); extract_sequence(5, [C|Fmt], Need0) -> diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index a868867a81..06dae51cc9 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -42,7 +42,7 @@ | {encoding, latin1 | unicode | utf8}). -type(options() :: hook_function() | [option()]). --record(pp, {string_fun, char_fun}). +-record(pp, {string_fun, char_fun, term_fun}). -record(options, {hook, encoding, opts}). @@ -61,7 +61,8 @@ form(Thing) -> Options :: options()). form(Thing, Options) -> - frmt(lform(Thing, options(Options)), state(Options)). + State = state(Options), + frmt(lform(Thing, options(Options), State), State). -spec(attribute(Attribute) -> io_lib:chars() when Attribute :: erl_parse:abstract_form()). @@ -74,7 +75,8 @@ attribute(Thing) -> Options :: options()). attribute(Thing, Options) -> - frmt(lattribute(Thing, options(Options)), state(Options)). + State = state(Options), + frmt(lattribute(Thing, options(Options), State), State). -spec(function(Function) -> io_lib:chars() when Function :: erl_parse:abstract_form()). @@ -180,11 +182,13 @@ state(_Hook) -> state() -> #pp{string_fun = fun io_lib:write_string_as_latin1/1, - char_fun = fun io_lib:write_char_as_latin1/1}. + char_fun = fun io_lib:write_char_as_latin1/1, + term_fun = fun(T) -> io_lib:format("~p", [T]) end}. unicode_state() -> #pp{string_fun = fun io_lib:write_string/1, - char_fun = fun io_lib:write_char/1}. + char_fun = fun io_lib:write_char/1, + term_fun = fun(T) -> io_lib:format("~tp", [T]) end}. encoding(Options) -> case proplists:get_value(encoding, Options, epp:default_encoding()) of @@ -193,47 +197,47 @@ encoding(Options) -> unicode -> unicode end. -lform({attribute,Line,Name,Arg}, Opts) -> - lattribute({attribute,Line,Name,Arg}, Opts); -lform({function,Line,Name,Arity,Clauses}, Opts) -> +lform({attribute,Line,Name,Arg}, Opts, State) -> + lattribute({attribute,Line,Name,Arg}, Opts, State); +lform({function,Line,Name,Arity,Clauses}, Opts, _State) -> lfunction({function,Line,Name,Arity,Clauses}, Opts); -lform({rule,Line,Name,Arity,Clauses}, Opts) -> +lform({rule,Line,Name,Arity,Clauses}, Opts, _State) -> lrule({rule,Line,Name,Arity,Clauses}, Opts); %% These are specials to make it easier for the compiler. -lform({error,E}, _Opts) -> - leaf(format("~p\n", [{error,E}])); -lform({warning,W}, _Opts) -> - leaf(format("~p\n", [{warning,W}])); -lform({eof,_Line}, _Opts) -> +lform({error,E}, _Opts, State) -> + leaf((State#pp.term_fun)({error,E})++"\n"); +lform({warning,W}, _Opts, State) -> + leaf((State#pp.term_fun)({warning,W})++"\n"); +lform({eof,_Line}, _Opts, _State) -> $\n. -lattribute({attribute,_Line,type,Type}, Opts) -> +lattribute({attribute,_Line,type,Type}, Opts, _State) -> [typeattr(type, Type, Opts),leaf(".\n")]; -lattribute({attribute,_Line,opaque,Type}, Opts) -> +lattribute({attribute,_Line,opaque,Type}, Opts, _State) -> [typeattr(opaque, Type, Opts),leaf(".\n")]; -lattribute({attribute,_Line,spec,Arg}, _Opts) -> +lattribute({attribute,_Line,spec,Arg}, _Opts, _State) -> [specattr(Arg),leaf(".\n")]; -lattribute({attribute,_Line,Name,Arg}, Opts) -> - [lattribute(Name, Arg, Opts),leaf(".\n")]. +lattribute({attribute,_Line,Name,Arg}, Opts, State) -> + [lattribute(Name, Arg, Opts, State),leaf(".\n")]. -lattribute(module, {M,Vs}, _Opts) -> +lattribute(module, {M,Vs}, _Opts, _State) -> attr("module",[{var,0,pname(M)}, foldr(fun(V, C) -> {cons,0,{var,0,V},C} end, {nil,0}, Vs)]); -lattribute(module, M, _Opts) -> +lattribute(module, M, _Opts, _State) -> attr("module", [{var,0,pname(M)}]); -lattribute(export, Falist, _Opts) -> +lattribute(export, Falist, _Opts, _State) -> call({var,0,"-export"}, [falist(Falist)], 0, none); -lattribute(import, Name, _Opts) when is_list(Name) -> +lattribute(import, Name, _Opts, _State) when is_list(Name) -> attr("import", [{var,0,pname(Name)}]); -lattribute(import, {From,Falist}, _Opts) -> +lattribute(import, {From,Falist}, _Opts, _State) -> attr("import",[{var,0,pname(From)},falist(Falist)]); -lattribute(file, {Name,Line}, _Opts) -> - attr("file", [{var,0,format("~p", [Name])},{integer,0,Line}]); -lattribute(record, {Name,Is}, Opts) -> +lattribute(file, {Name,Line}, _Opts, State) -> + attr("file", [{var,0,(State#pp.term_fun)(Name)},{integer,0,Line}]); +lattribute(record, {Name,Is}, Opts, _State) -> Nl = leaf(format("-record(~w,", [Name])), [{first,Nl,record_fields(Is, Opts)},$)]; -lattribute(Name, Arg, #options{encoding = Encoding}) -> +lattribute(Name, Arg, #options{encoding = Encoding}, _State) -> attr(write(Name), [erl_parse:abstract(Arg, [{encoding,Encoding}])]). typeattr(Tag, {TypeName,Type,Args}, _Opts) -> @@ -423,7 +427,7 @@ lexpr(E, Opts) -> lexpr({var,_,V}, _, _) when is_integer(V) -> %Special hack for Robert leaf(format("_~w", [V])); -lexpr({var,_,V}, _, _) -> leaf(format("~s", [V])); +lexpr({var,_,V}, _, _) -> leaf(format("~ts", [V])); lexpr({char,_,C}, _, _) -> {char,C}; lexpr({integer,_,N}, _, _) -> leaf(write(N)); lexpr({float,_,F}, _, _) -> leaf(write(F)); @@ -799,7 +803,7 @@ maybe_paren(_P, _Prec, Expr) -> Expr. leaf(S) -> - {leaf,iolist_size(S),S}. + {leaf,chars_size(S),S}. %%% Do the formatting. Currently nothing fancy. Could probably have %%% done it in one single pass. @@ -1009,7 +1013,7 @@ incr(I, Incr) -> I+Incr. indentation(E, I) when I < 0 -> - iolist_size(E); + chars_size(E); indentation(E, I0) -> I = io_lib_format:indentation(E, I0), case has_nl(E) of @@ -1064,6 +1068,15 @@ write_char(C, PP) -> %% Utilities %% +chars_size([C | Es]) when is_integer(C) -> + 1 + chars_size(Es); +chars_size([E | Es]) -> + chars_size(E) + chars_size(Es); +chars_size([]) -> + 0; +chars_size(B) when is_binary(B) -> + byte_size(B). + -define(N_SPACES, 30). spacetab() -> diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index 318f3b87b8..7df72a93e5 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -19,16 +19,14 @@ -module(filelib). %% File utilities. - -%% Avoid warning for local function error/1 clashing with autoimported BIF. --compile({no_auto_import,[error/1]}). --export([wildcard/1, wildcard/2, is_dir/1, is_file/1, is_regular/1, - compile_wildcard/1]). +-export([wildcard/1, wildcard/2, is_dir/1, is_file/1, is_regular/1]). -export([fold_files/5, last_modified/1, file_size/1, ensure_dir/1]). - -export([wildcard/3, is_dir/2, is_file/2, is_regular/2]). -export([fold_files/6, last_modified/2, file_size/2]). +%% For debugging/testing. +-export([compile_wildcard/1]). + -include_lib("kernel/include/file.hrl"). -define(HANDLE_ERROR(Expr), @@ -37,7 +35,7 @@ catch error:{badpattern,_}=UnUsUalVaRiAbLeNaMe -> %% Get the stack backtrace correct. - erlang:error(UnUsUalVaRiAbLeNaMe) + error(UnUsUalVaRiAbLeNaMe) end). -type filename() :: file:name(). @@ -48,19 +46,19 @@ -spec wildcard(Wildcard) -> [file:filename()] when Wildcard :: filename() | dirname(). wildcard(Pattern) when is_list(Pattern) -> - ?HANDLE_ERROR(do_wildcard(Pattern, file)). + ?HANDLE_ERROR(do_wildcard(Pattern, ".", file)). -spec wildcard(Wildcard, Cwd) -> [file:filename()] when Wildcard :: filename() | dirname(), Cwd :: dirname(). -wildcard(Pattern, Cwd) when is_list(Pattern), (is_list(Cwd) or is_binary(Cwd)) -> +wildcard(Pattern, Cwd) when is_list(Pattern), is_list(Cwd) -> ?HANDLE_ERROR(do_wildcard(Pattern, Cwd, file)); wildcard(Pattern, Mod) when is_list(Pattern), is_atom(Mod) -> - ?HANDLE_ERROR(do_wildcard(Pattern, Mod)). + ?HANDLE_ERROR(do_wildcard(Pattern, ".", Mod)). -spec wildcard(file:name(), file:name(), atom()) -> [file:filename()]. wildcard(Pattern, Cwd, Mod) - when is_list(Pattern), (is_list(Cwd) or is_binary(Cwd)), is_atom(Mod) -> + when is_list(Pattern), is_list(Cwd), is_atom(Mod) -> ?HANDLE_ERROR(do_wildcard(Pattern, Cwd, Mod)). -spec is_dir(Name) -> boolean() when @@ -124,47 +122,6 @@ file_size(File, Mod) when is_atom(Mod) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -do_wildcard(Pattern, Mod) when is_list(Pattern) -> - do_wildcard_comp(do_compile_wildcard(Pattern), Mod). - -do_wildcard_comp({compiled_wildcard,{exists,File}}, Mod) -> - case eval_read_file_info(File, Mod) of - {ok,_} -> [File]; - _ -> [] - end; -do_wildcard_comp({compiled_wildcard,[cwd,Base|Rest]}, Mod) -> - do_wildcard_1([Base], Rest, Mod); -do_wildcard_comp({compiled_wildcard,[Base|Rest]}, Mod) -> - do_wildcard_1([Base], Rest, Mod). - -do_wildcard(Pattern, Cwd, Mod) when is_list(Pattern), (is_list(Cwd) or is_binary(Cwd)) -> - do_wildcard_comp(do_compile_wildcard(Pattern), Cwd, Mod). - -do_wildcard_comp({compiled_wildcard,{exists,File}}, Cwd, Mod) -> - case eval_read_file_info(filename:absname(File, Cwd), Mod) of - {ok,_} -> [File]; - _ -> [] - end; -do_wildcard_comp({compiled_wildcard,[cwd|Rest0]}, Cwd0, Mod) -> - case Rest0 of - [current|Rest] -> ok; - Rest -> ok - end, - {Cwd,PrefixLen} = case filename:join([Cwd0]) of - Bin when is_binary(Bin) -> {Bin,byte_size(Bin)+1}; - Other -> {Other,length(Other)+1} - end, %Slash away redundant slashes. - [ - if - is_binary(N) -> - <<_:PrefixLen/binary,Res/binary>> = N, - Res; - true -> - lists:nthtail(PrefixLen, N) - end || N <- do_wildcard_1([Cwd], Rest, Mod)]; -do_wildcard_comp({compiled_wildcard,[Base|Rest]}, _Cwd, Mod) -> - do_wildcard_1([Base], Rest, Mod). - do_is_dir(Dir, Mod) -> case eval_read_file_info(Dir, Mod) of {ok, #file_info{type=directory}} -> @@ -293,8 +250,24 @@ ensure_dir(F) -> %%% Pattern matching using a compiled wildcard. %%% -do_wildcard_1(Files, Pattern, Mod) -> - do_wildcard_2(Files, Pattern, [], Mod). +do_wildcard(Pattern, Cwd, Mod) -> + {Compiled,PrefixLen} = compile_wildcard(Pattern, Cwd), + Files0 = do_wildcard_1(Compiled, Mod), + Files = if + PrefixLen =:= 0 -> + Files0; + true -> + [lists:nthtail(PrefixLen, File) || File <- Files0] + end, + lists:sort(Files). + +do_wildcard_1({exists,File}, Mod) -> + case eval_read_file_info(File, Mod) of + {ok,_} -> [File]; + _ -> [] + end; +do_wildcard_1([Base|Rest], Mod) -> + do_wildcard_2([Base], Rest, [], Mod). do_wildcard_2([File|Rest], Pattern, Result, Mod) -> do_wildcard_2(Rest, Pattern, do_wildcard_3(File, Pattern, Result, Mod), Mod); @@ -302,12 +275,12 @@ do_wildcard_2([], _, Result, _Mod) -> Result. do_wildcard_3(Base, [[double_star]|Rest], Result, Mod) -> - lists:sort(do_double_star(current, [Base], Rest, Result, Mod, true)); -do_wildcard_3(Base, [Pattern|Rest], Result, Mod) -> - case do_list_dir(Base, Mod) of - {ok, Files0} -> - Files = lists:sort(Files0), - Matches = wildcard_4(Pattern, Files, Base, []), + do_double_star(".", [Base], Rest, Result, Mod, true); +do_wildcard_3(Base0, [Pattern|Rest], Result, Mod) -> + case do_list_dir(Base0, Mod) of + {ok, Files} -> + Base = prepare_base(Base0), + Matches = do_wildcard_4(Pattern, Base, Files), do_wildcard_2(Matches, Rest, Result, Mod); _ -> Result @@ -315,51 +288,50 @@ do_wildcard_3(Base, [Pattern|Rest], Result, Mod) -> do_wildcard_3(Base, [], Result, _Mod) -> [Base|Result]. -wildcard_4(Pattern, [File|Rest], Base, Result) when is_binary(File) -> - case wildcard_5(Pattern, binary_to_list(File)) of - true -> - wildcard_4(Pattern, Rest, Base, [join(Base, File)|Result]); +do_wildcard_4(Pattern, Base, Files) -> + case will_always_match(Pattern) of false -> - wildcard_4(Pattern, Rest, Base, Result) - end; -wildcard_4(Pattern, [File|Rest], Base, Result) -> - case wildcard_5(Pattern, File) of + [Base++F || F <- Files, match_part(Pattern, F)]; true -> - wildcard_4(Pattern, Rest, Base, [join(Base, File)|Result]); - false -> - wildcard_4(Pattern, Rest, Base, Result) - end; -wildcard_4(_Patt, [], _Base, Result) -> - Result. + [Base++F || F <- Files] + end. -wildcard_5([question|Rest1], [_|Rest2]) -> - wildcard_5(Rest1, Rest2); -wildcard_5([accept], _) -> +match_part([question|Rest1], [_|Rest2]) -> + match_part(Rest1, Rest2); +match_part([accept], _) -> true; -wildcard_5([double_star], _) -> +match_part([double_star], _) -> true; -wildcard_5([star|Rest], File) -> +match_part([star|Rest], File) -> do_star(Rest, File); -wildcard_5([{one_of, Ordset}|Rest], [C|File]) -> - case ordsets:is_element(C, Ordset) of - true -> wildcard_5(Rest, File); - false -> false - end; -wildcard_5([{alt, Alts}], File) -> +match_part([{one_of, Ordset}|Rest], [C|File]) -> + gb_sets:is_element(C, Ordset) andalso match_part(Rest, File); +match_part([{alt, Alts}], File) -> do_alt(Alts, File); -wildcard_5([C|Rest1], [C|Rest2]) when is_integer(C) -> - wildcard_5(Rest1, Rest2); -wildcard_5([X|_], [Y|_]) when is_integer(X), is_integer(Y) -> +match_part([C|Rest1], [C|Rest2]) when is_integer(C) -> + match_part(Rest1, Rest2); +match_part([X|_], [Y|_]) when is_integer(X), is_integer(Y) -> false; -wildcard_5([], []) -> +match_part([], []) -> true; -wildcard_5([], [_|_]) -> +match_part([], [_|_]) -> false; -wildcard_5([_|_], []) -> +match_part([_|_], []) -> false. +will_always_match([accept]) -> true; +will_always_match(_) -> false. + +prepare_base(Base0) -> + Base1 = filename:join(Base0, "x"), + "x"++Base2 = lists:reverse(Base1), + lists:reverse(Base2). + do_double_star(Base, [H|T], Rest, Result, Mod, Root) -> - Full = join(Base, H), + Full = case Root of + false -> filename:join(Base, H); + true -> H + end, Result1 = case do_list_dir(Full, Mod) of {ok, Files} -> do_double_star(Full, Files, Rest, Result, Mod, false); @@ -373,62 +345,64 @@ do_double_star(Base, [H|T], Rest, Result, Mod, Root) -> do_double_star(_Base, [], _Rest, Result, _Mod, _Root) -> Result. -do_star(Pattern, [X|Rest]) -> - case wildcard_5(Pattern, [X|Rest]) of - true -> true; - false -> do_star(Pattern, Rest) - end; +do_star(Pattern, [_|Rest]=File) -> + match_part(Pattern, File) orelse do_star(Pattern, Rest); do_star(Pattern, []) -> - wildcard_5(Pattern, []). + match_part(Pattern, []). do_alt([Alt|Rest], File) -> - case wildcard_5(Alt, File) of - true -> true; - false -> do_alt(Rest, File) - end; + match_part(Alt, File) orelse do_alt(Rest, File); do_alt([], _File) -> false. -do_list_dir(current, Mod) -> eval_list_dir(".", Mod); do_list_dir(Dir, Mod) -> eval_list_dir(Dir, Mod). -join(current, File) -> File; -join(Base, File) -> filename:join(Base, File). - %%% Compiling a wildcard. -compile_wildcard(Pattern) -> - ?HANDLE_ERROR(do_compile_wildcard(Pattern)). - -do_compile_wildcard(Pattern) -> - {compiled_wildcard,compile_wildcard_1(Pattern)}. +%% Only for debugging. +compile_wildcard(Pattern) when is_list(Pattern) -> + {compiled_wildcard,?HANDLE_ERROR(compile_wildcard(Pattern, "."))}. -compile_wildcard_1(Pattern) -> +compile_wildcard(Pattern, Cwd0) -> [Root|Rest] = filename:split(Pattern), case filename:pathtype(Root) of relative -> - case compile_wildcard_2([Root|Rest], current) of - {exists,_}=Wc -> Wc; - [_|_]=Wc -> [cwd|Wc] - end; + Cwd = filename:join([Cwd0]), + compile_wildcard_2([Root|Rest], {cwd,Cwd}); _ -> - compile_wildcard_2(Rest, [Root]) + compile_wildcard_2(Rest, {root,0,Root}) end. compile_wildcard_2([Part|Rest], Root) -> case compile_part(Part) of Part -> - compile_wildcard_2(Rest, join(Root, Part)); + compile_wildcard_2(Rest, compile_join(Root, Part)); Pattern -> compile_wildcard_3(Rest, [Pattern,Root]) end; -compile_wildcard_2([], Root) -> {exists,Root}. +compile_wildcard_2([], {root,PrefixLen,Root}) -> + {{exists,Root},PrefixLen}. compile_wildcard_3([Part|Rest], Result) -> compile_wildcard_3(Rest, [compile_part(Part)|Result]); compile_wildcard_3([], Result) -> - lists:reverse(Result). + case lists:reverse(Result) of + [{root,PrefixLen,Root}|Compiled] -> + {[Root|Compiled],PrefixLen}; + [{cwd,Root}|Compiled] -> + {[Root|Compiled],length(filename:join(Root, "x"))-1} + end. + +compile_join({cwd,"."}, File) -> + {root,0,File}; +compile_join({cwd,Cwd}, File0) -> + File = filename:join([File0]), + Root = filename:join(Cwd, File), + PrefixLen = length(Root) - length(File), + {root,PrefixLen,Root}; +compile_join({root,PrefixLen,Root}, File) -> + {root,PrefixLen,filename:join(Root, File)}. compile_part(Part) -> compile_part(Part, false, []). @@ -437,7 +411,7 @@ compile_part_to_sep(Part) -> compile_part(Part, true, []). compile_part([], true, _) -> - error(missing_delimiter); + badpattern(missing_delimiter); compile_part([$,|Rest], true, Result) -> {ok, $,, lists:reverse(Result), Rest}; compile_part([$}|Rest], true, Result) -> @@ -473,8 +447,6 @@ compile_part([], _Upto, Result) -> compile_charset([$]|Rest], Ordset) -> compile_charset1(Rest, ordsets:add_element($], Ordset)); -compile_charset([$-|Rest], Ordset) -> - compile_charset1(Rest, ordsets:add_element($-, Ordset)); compile_charset([], _Ordset) -> error; compile_charset(List, Ordset) -> @@ -483,7 +455,7 @@ compile_charset(List, Ordset) -> compile_charset1([Lower, $-, Upper|Rest], Ordset) when Lower =< Upper -> compile_charset1(Rest, compile_range(Lower, Upper, Ordset)); compile_charset1([$]|Rest], Ordset) -> - {ok, {one_of, Ordset}, Rest}; + {ok, {one_of, gb_sets:from_ordset(Ordset)}, Rest}; compile_charset1([X|Rest], Ordset) -> compile_charset1(Rest, ordsets:add_element(X, Ordset)); compile_charset1([], _Ordset) -> @@ -509,8 +481,8 @@ compile_alt(Pattern, Result) -> error end. -error(Reason) -> - erlang:error({badpattern,Reason}). +badpattern(Reason) -> + error({badpattern,Reason}). eval_read_file_info(File, file) -> file:read_file_info(File); diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index 0c50eb34e6..e944dd4c43 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -61,13 +61,13 @@ %% (for WIN32): absname("/") -> "D:/" --spec absname(Filename) -> file:filename() when +-spec absname(Filename) -> file:filename_all() when Filename :: file:name(). absname(Name) -> {ok, Cwd} = file:get_cwd(), absname(Name, Cwd). --spec absname(Filename, Dir) -> file:filename() when +-spec absname(Filename, Dir) -> file:filename_all() when Filename :: file:name(), Dir :: file:name(). absname(Name, AbsBase) when is_binary(Name), is_list(AbsBase) -> @@ -122,7 +122,7 @@ absname_vr([[X, $:]|Name], _, _AbsBase) -> %% This is just a join/2, but assumes that %% AbsBase must be absolute and Name must be relative. --spec absname_join(Dir, Filename) -> file:filename() when +-spec absname_join(Dir, Filename) -> file:filename_all() when Dir :: file:name(), Filename :: file:name(). absname_join(AbsBase, Name) -> @@ -136,7 +136,7 @@ absname_join(AbsBase, Name) -> %% basename("/usr/foo/") -> "foo" (trailing slashes ignored) %% basename("/") -> [] --spec basename(Filename) -> file:filename() when +-spec basename(Filename) -> file:filename_all() when Filename :: file:name(). basename(Name) when is_binary(Name) -> case os:type() of @@ -201,7 +201,7 @@ skip_prefix(Name, _) -> %% rootname(basename("xxx.jam")) -> "xxx" %% rootname(basename("xxx.erl")) -> "xxx" --spec basename(Filename, Ext) -> file:filename() when +-spec basename(Filename, Ext) -> file:filename_all() when Filename :: file:name(), Ext :: file:name(). basename(Name, Ext) when is_binary(Name), is_list(Ext) -> @@ -251,7 +251,7 @@ basename([], _Ext, Tail, _DrvSep2) -> %% Example: dirname("/usr/src/kalle.erl") -> "/usr/src", %% dirname("kalle.erl") -> "." --spec dirname(Filename) -> file:filename() when +-spec dirname(Filename) -> file:filename_all() when Filename :: file:name(). dirname(Name) when is_binary(Name) -> {Dsep,Drivesep} = separators(), @@ -344,7 +344,7 @@ dirjoin1([H|T],Acc,Sep) -> %% %% On Windows: fn:dirname("\\usr\\src/kalle.erl") -> "/usr/src" --spec extension(Filename) -> file:filename() when +-spec extension(Filename) -> file:filename_all() when Filename :: file:name(). extension(Name) when is_binary(Name) -> {Dsep,_} = separators(), @@ -387,7 +387,7 @@ extension([], Result, _OsType) -> %% Joins a list of filenames with directory separators. --spec join(Components) -> file:filename() when +-spec join(Components) -> file:filename_all() when Components :: [file:name()]. join([Name1, Name2|Rest]) -> join([join(Name1, Name2)|Rest]); @@ -400,7 +400,7 @@ join([Name]) when is_atom(Name) -> %% Joins two filenames with directory separators. --spec join(Name1, Name2) -> file:filename() when +-spec join(Name1, Name2) -> file:filename_all() when Name1 :: file:name(), Name2 :: file:name(). join(Name1, Name2) when is_list(Name1), is_list(Name2) -> @@ -488,7 +488,7 @@ maybe_remove_dirsep(Name, _) -> %% a given base directory, which is is assumed to be normalised %% by a previous call to join/{1,2}. --spec append(file:filename(), file:name()) -> file:filename(). +-spec append(file:filename_all(), file:name()) -> file:filename_all(). append(Dir, Name) when is_binary(Dir), is_binary(Name) -> <<Dir/binary,$/:8,Name/binary>>; append(Dir, Name) when is_binary(Dir) -> @@ -564,7 +564,7 @@ win32_pathtype(_) -> relative. %% Examples: rootname("/jam.src/kalle") -> "/jam.src/kalle" %% rootname("/jam.src/foo.erl") -> "/jam.src/foo" --spec rootname(Filename) -> file:filename() when +-spec rootname(Filename) -> file:filename_all() when Filename :: file:name(). rootname(Name) when is_binary(Name) -> list_to_binary(rootname(binary_to_list(Name))); % No need to handle unicode, . is < 128 @@ -594,7 +594,7 @@ rootname([], Root, _Ext, _OsType) -> %% Examples: rootname("/jam.src/kalle.jam", ".erl") -> "/jam.src/kalle.jam" %% rootname("/jam.src/foo.erl", ".erl") -> "/jam.src/foo" --spec rootname(Filename, Ext) -> file:filename() when +-spec rootname(Filename, Ext) -> file:filename_all() when Filename :: file:name(), Ext :: file:name(). rootname(Name, Ext) when is_binary(Name), is_binary(Ext) -> @@ -717,7 +717,7 @@ split([], Comp, Components, OsType) -> %% will be converted to backslashes. On all platforms, the %% name will be normalized as done by join/1. --spec nativename(Path) -> file:filename() when +-spec nativename(Path) -> file:filename_all() when Path :: file:name(). nativename(Name0) -> Name = join([Name0]), %Normalize. @@ -921,7 +921,7 @@ major_os_type() -> %% flatten(List) %% Flatten a list, also accepting atoms. --spec flatten(Filename) -> file:filename() when +-spec flatten(Filename) -> file:filename_all() when Filename :: file:name(). flatten(Bin) when is_binary(Bin) -> Bin; diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl index 6a06d9448b..56e15a17ec 100644 --- a/lib/stdlib/src/io_lib_format.erl +++ b/lib/stdlib/src/io_lib_format.erl @@ -58,14 +58,22 @@ collect_cseq(Fmt0, Args0) -> {P,Fmt2,Args2} = precision(Fmt1, Args1), {Pad,Fmt3,Args3} = pad_char(Fmt2, Args2), {Encoding,Fmt4,Args4} = encoding(Fmt3, Args3), - {C,As,Fmt5,Args5} = collect_cc(Fmt4, Args4), - {{C,As,F,Ad,P,Pad,Encoding},Fmt5,Args5}. + {Strings,Fmt5,Args5} = strings(Fmt4, Args4), + {C,As,Fmt6,Args6} = collect_cc(Fmt5, Args5), + {{C,As,F,Ad,P,Pad,Encoding,Strings},Fmt6,Args6}. encoding([$t|Fmt],Args) -> + true = hd(Fmt) =/= $l, {unicode,Fmt,Args}; encoding(Fmt,Args) -> {latin1,Fmt,Args}. +strings([$l|Fmt],Args) -> + true = hd(Fmt) =/= $t, + {false,Fmt,Args}; +strings(Fmt,Args) -> + {true,Fmt,Args}. + field_width([$-|Fmt0], Args0) -> {F,Fmt,Args} = field_value(Fmt0, Args0), field_width(-F, Fmt, Args); @@ -128,8 +136,8 @@ collect_cc([$i|Fmt], [A|Args]) -> {$i,[A],Fmt,Args}. pcount(Cs) -> pcount(Cs, 0). -pcount([{$p,_As,_F,_Ad,_P,_Pad,_Enc}|Cs], Acc) -> pcount(Cs, Acc+1); -pcount([{$P,_As,_F,_Ad,_P,_Pad,_Enc}|Cs], Acc) -> pcount(Cs, Acc+1); +pcount([{$p,_As,_F,_Ad,_P,_Pad,_Enc,_Str}|Cs], Acc) -> pcount(Cs, Acc+1); +pcount([{$P,_As,_F,_Ad,_P,_Pad,_Enc,_Str}|Cs], Acc) -> pcount(Cs, Acc+1); pcount([_|Cs], Acc) -> pcount(Cs, Acc); pcount([], Acc) -> Acc. @@ -138,8 +146,8 @@ pcount([], Acc) -> Acc. %% remaining and only calculate indentation when necessary. Must also %% be smart when calculating indentation for characters in format. -build([{C,As,F,Ad,P,Pad,Enc}|Cs], Pc0, I) -> - S = control(C, As, F, Ad, P, Pad, Enc, I), +build([{C,As,F,Ad,P,Pad,Enc,Str}|Cs], Pc0, I) -> + S = control(C, As, F, Ad, P, Pad, Enc, Str, I), Pc1 = decr_pc(C, Pc0), if Pc1 > 0 -> [S|build(Cs, Pc1, indentation(S, I))]; @@ -171,60 +179,59 @@ indentation([], I) -> I. %% This is the main dispatch function for the various formatting commands. %% Field widths and precisions have already been calculated. -control($w, [A], F, Adj, P, Pad, _Enc,_I) -> +control($w, [A], F, Adj, P, Pad, _Enc, _Str, _I) -> term(io_lib:write(A, -1), F, Adj, P, Pad); -control($p, [A], F, Adj, P, Pad, Enc, I) -> - print(A, -1, F, Adj, P, Pad, Enc, I); -control($W, [A,Depth], F, Adj, P, Pad, _Enc, _I) when is_integer(Depth) -> +control($p, [A], F, Adj, P, Pad, Enc, Str, I) -> + print(A, -1, F, Adj, P, Pad, Enc, Str, I); +control($W, [A,Depth], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(Depth) -> term(io_lib:write(A, Depth), F, Adj, P, Pad); -control($P, [A,Depth], F, Adj, P, Pad, Enc, I) when is_integer(Depth) -> - print(A, Depth, F, Adj, P, Pad, Enc, I); -control($s, [A], F, Adj, P, Pad, _Enc, _I) when is_atom(A) -> +control($P, [A,Depth], F, Adj, P, Pad, Enc, Str, I) when is_integer(Depth) -> + print(A, Depth, F, Adj, P, Pad, Enc, Str, I); +control($s, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_atom(A) -> string(atom_to_list(A), F, Adj, P, Pad); -control($s, [L0], F, Adj, P, Pad, latin1, _I) -> +control($s, [L0], F, Adj, P, Pad, latin1, _Str, _I) -> L = iolist_to_chars(L0), string(L, F, Adj, P, Pad); -control($s, [L0], F, Adj, P, Pad, unicode, _I) -> - L = unicode:characters_to_list(L0), - true = is_list(L), +control($s, [L0], F, Adj, P, Pad, unicode, _Str, _I) -> + L = cdata_to_chars(L0), uniconv(string(L, F, Adj, P, Pad)); -control($e, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($e, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_e(A, F, Adj, P, Pad); -control($f, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($f, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_f(A, F, Adj, P, Pad); -control($g, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($g, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_g(A, F, Adj, P, Pad); -control($b, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($b, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, true); -control($B, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($B, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, false); -control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A), +control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A), is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), true); -control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, true); -control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A), +control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A), is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), false); -control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, false); -control($+, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($+, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> Base = base(P), Prefix = [integer_to_list(Base), $#], prefixed_integer(A, F, Adj, Base, Pad, Prefix, true); -control($#, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($#, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> Base = base(P), Prefix = [integer_to_list(Base), $#], prefixed_integer(A, F, Adj, Base, Pad, Prefix, false); -control($c, [A], F, Adj, P, Pad, unicode, _I) when is_integer(A) -> +control($c, [A], F, Adj, P, Pad, unicode, _Str, _I) when is_integer(A) -> char(A, F, Adj, P, Pad); -control($c, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($c, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> char(A band 255, F, Adj, P, Pad); -control($~, [], F, Adj, P, Pad, _Enc, _I) -> char($~, F, Adj, P, Pad); -control($n, [], F, Adj, P, Pad, _Enc, _I) -> newline(F, Adj, P, Pad); -control($i, [_A], _F, _Adj, _P, _Pad, _Enc, _I) -> []. +control($~, [], F, Adj, P, Pad, _Enc, _Str, _I) -> char($~, F, Adj, P, Pad); +control($n, [], F, Adj, P, Pad, _Enc, _Str, _I) -> newline(F, Adj, P, Pad); +control($i, [_A], _F, _Adj, _P, _Pad, _Enc, _Str, _I) -> []. -ifdef(UNICODE_AS_BINARIES). uniconv(C) -> @@ -260,12 +267,16 @@ term(T, F, Adj, P0, Pad) -> %% Indentation) %% Print a term. -print(T, D, none, Adj, P, Pad, E, I) -> print(T, D, 80, Adj, P, Pad, E, I); -print(T, D, F, Adj, none, Pad, E, I) -> print(T, D, F, Adj, I+1, Pad, E, I); -print(T, D, F, right, P, _Pad, latin1, _I) -> - io_lib_pretty:print(T, P, F, D); -print(T, D, F, right, P, _Pad, Enc, _I) -> - Options = [{column, P}, {line_length, F}, {depth, D}, {encoding, Enc}], +print(T, D, none, Adj, P, Pad, E, Str, I) -> + print(T, D, 80, Adj, P, Pad, E, Str, I); +print(T, D, F, Adj, none, Pad, E, Str, I) -> + print(T, D, F, Adj, I+1, Pad, E, Str, I); +print(T, D, F, right, P, _Pad, Enc, Str, _I) -> + Options = [{column, P}, + {line_length, F}, + {depth, D}, + {encoding, Enc}, + {strings, Str}], io_lib_pretty:print(T, Options). %% fwrite_e(Float, Field, Adjust, Precision, PadChar) @@ -558,6 +569,25 @@ iolist_to_chars([]) -> iolist_to_chars(B) when is_binary(B) -> binary_to_list(B). +%% cdata() :: clist() | cbinary() +%% clist() :: maybe_improper_list(char() | cbinary() | clist(), +%% cbinary() | nil()) +%% cbinary() :: unicode:unicode_binary() | unicode:latin1_binary() + +%% cdata_to_chars(cdata()) -> io_lib:deep_char_list() + +cdata_to_chars([C|Cs]) when is_integer(C), C >= $\000 -> + [C | cdata_to_chars(Cs)]; +cdata_to_chars([I|Cs]) -> + [cdata_to_chars(I) | cdata_to_chars(Cs)]; +cdata_to_chars([]) -> + []; +cdata_to_chars(B) when is_binary(B) -> + case catch unicode:characters_to_list(B) of + L when is_list(L) -> L; + _ -> binary_to_list(B) + end. + %% string(String, Field, Adjust, Precision, PadChar) string(S, none, _Adj, none, _Pad) -> S; diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index b05db3d290..525b534249 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -56,6 +56,7 @@ print(Term) -> | {depth, depth()} | {max_chars, max_chars()} | {record_print_fun, rec_print_fun()} + | {strings, boolean()} | {encoding, latin1 | utf8 | unicode}. -type options() :: [option()]. @@ -69,7 +70,8 @@ print(Term, Options) when is_list(Options) -> M = proplists:get_value(max_chars, Options, -1), RecDefFun = proplists:get_value(record_print_fun, Options, no_fun), Encoding = proplists:get_value(encoding, Options, epp:default_encoding()), - print(Term, Col, Ll, D, M, RecDefFun, Encoding); + Strings = proplists:get_value(strings, Options, true), + print(Term, Col, Ll, D, M, RecDefFun, Encoding, Strings); print(Term, RecDefFun) -> print(Term, -1, RecDefFun). @@ -81,7 +83,7 @@ print(Term, Depth, RecDefFun) -> -spec print(term(), column(), line_length(), depth()) -> chars(). print(Term, Col, Ll, D) -> - print(Term, Col, Ll, D, _M=-1, no_fun, latin1). + print(Term, Col, Ll, D, _M=-1, no_fun, latin1, true). -spec print(term(), column(), line_length(), depth(), rec_print_fun()) -> chars(). @@ -92,15 +94,15 @@ print(Term, Col, Ll, D, RecDefFun) -> rec_print_fun()) -> chars(). print(Term, Col, Ll, D, M, RecDefFun) -> - print(Term, Col, Ll, D, M, RecDefFun, latin1). - -print(_, _, _, 0, _M, _RF, _Enc) -> "..."; -print(Term, Col, Ll, D, M, RecDefFun, Enc) when Col =< 0 -> - print(Term, 1, Ll, D, M, RecDefFun, Enc); -print(Term, Col, Ll, D, M0, RecDefFun, Enc) when is_tuple(Term); - is_list(Term); - is_bitstring(Term) -> - If = {_S, Len} = print_length(Term, D, RecDefFun, Enc), + print(Term, Col, Ll, D, M, RecDefFun, latin1, true). + +print(_, _, _, 0, _M, _RF, _Enc, _Str) -> "..."; +print(Term, Col, Ll, D, M, RecDefFun, Enc, Str) when Col =< 0 -> + print(Term, 1, Ll, D, M, RecDefFun, Enc, Str); +print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term); + is_list(Term); + is_bitstring(Term) -> + If = {_S, Len} = print_length(Term, D, RecDefFun, Enc, Str), M = max_cs(M0, Len), if Len < Ll - Col, Len =< M -> @@ -111,7 +113,7 @@ print(Term, Col, Ll, D, M0, RecDefFun, Enc) when is_tuple(Term); 1), pp(If, Col, Ll, M, TInd, indent(Col), 0, 0) end; -print(Term, _Col, _Ll, _D, _M, _RF, _Enc) -> +print(Term, _Col, _Ll, _D, _M, _RF, _Enc, _Str) -> io_lib:write(Term). %%% @@ -325,12 +327,12 @@ write_tail(E, S) -> %% counted but need to be added later. %% D =/= 0 -print_length([], _D, _RF, _Enc) -> +print_length([], _D, _RF, _Enc, _Str) -> {"[]", 2}; -print_length({}, _D, _RF, _Enc) -> +print_length({}, _D, _RF, _Enc, _Str) -> {"{}", 2}; -print_length(List, D, RF, Enc) when is_list(List) -> - case printable_list(List, D, Enc) of +print_length(List, D, RF, Enc, Str) when is_list(List) -> + case Str andalso printable_list(List, D, Enc) of true -> S = write_string(List, Enc), {S, length(S)}; @@ -339,30 +341,30 @@ print_length(List, D, RF, Enc) when is_list(List) -> % S = write_string(Prefix, Enc), % {[S | "..."], 3 + length(S)}; false -> - print_length_list(List, D, RF, Enc) + print_length_list(List, D, RF, Enc, Str) end; -print_length(Fun, _D, _RF, _Enc) when is_function(Fun) -> +print_length(Fun, _D, _RF, _Enc, _Str) when is_function(Fun) -> S = io_lib:write(Fun), {S, iolist_size(S)}; -print_length(R, D, RF, Enc) when is_atom(element(1, R)), - is_function(RF) -> +print_length(R, D, RF, Enc, Str) when is_atom(element(1, R)), + is_function(RF) -> case RF(element(1, R), tuple_size(R) - 1) of no -> - print_length_tuple(R, D, RF, Enc); + print_length_tuple(R, D, RF, Enc, Str); RDefs -> - print_length_record(R, D, RF, RDefs, Enc) + print_length_record(R, D, RF, RDefs, Enc, Str) end; -print_length(Tuple, D, RF, Enc) when is_tuple(Tuple) -> - print_length_tuple(Tuple, D, RF, Enc); -print_length(<<>>, _D, _RF, _Enc) -> +print_length(Tuple, D, RF, Enc, Str) when is_tuple(Tuple) -> + print_length_tuple(Tuple, D, RF, Enc, Str); +print_length(<<>>, _D, _RF, _Enc, _Str) -> {"<<>>", 4}; -print_length(<<_/bitstring>>, 1, _RF, _Enc) -> +print_length(<<_/bitstring>>, 1, _RF, _Enc, _Str) -> {"<<...>>", 7}; -print_length(<<_/bitstring>>=Bin, D, _RF, Enc) -> +print_length(<<_/bitstring>>=Bin, D, _RF, Enc, Str) -> case bit_size(Bin) rem 8 of 0 -> D1 = D - 1, - case printable_bin(Bin, D1, Enc) of + case Str andalso printable_bin(Bin, D1, Enc) of {true, List} when is_list(List) -> S = io_lib:write_string(List, $"), %" {[$<,$<,S,$>,$>], 4 + length(S)}; @@ -383,51 +385,53 @@ print_length(<<_/bitstring>>=Bin, D, _RF, Enc) -> S = io_lib:write(Bin, D), {{bin,S}, iolist_size(S)} end; -print_length(Term, _D, _RF, _Enc) -> +print_length(Term, _D, _RF, _Enc, _Str) -> S = io_lib:write(Term), {S, lists:flatlength(S)}. -print_length_tuple(_Tuple, 1, _RF, _Enc) -> +print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) -> {"{...}", 5}; -print_length_tuple(Tuple, D, RF, Enc) -> - L = print_length_list1(tuple_to_list(Tuple), D, RF, Enc), +print_length_tuple(Tuple, D, RF, Enc, Str) -> + L = print_length_list1(tuple_to_list(Tuple), D, RF, Enc, Str), IsTagged = is_atom(element(1, Tuple)) and (tuple_size(Tuple) > 1), {{tuple,IsTagged,L}, list_length(L, 2)}. -print_length_record(_Tuple, 1, _RF, _RDefs, _Enc) -> +print_length_record(_Tuple, 1, _RF, _RDefs, _Enc, _Str) -> {"{...}", 5}; -print_length_record(Tuple, D, RF, RDefs, Enc) -> +print_length_record(Tuple, D, RF, RDefs, Enc, Str) -> Name = [$# | io_lib:write_atom(element(1, Tuple))], NameL = length(Name), - L = print_length_fields(RDefs, D - 1, tl(tuple_to_list(Tuple)), RF, Enc), + Elements = tl(tuple_to_list(Tuple)), + L = print_length_fields(RDefs, D - 1, Elements, RF, Enc, Str), {{record, [{Name,NameL} | L]}, list_length(L, NameL + 2)}. -print_length_fields([], _D, [], _RF, _Enc) -> +print_length_fields([], _D, [], _RF, _Enc, _Str) -> []; -print_length_fields(_, 1, _, _RF, _Enc) -> +print_length_fields(_, 1, _, _RF, _Enc, _Str) -> {dots, 3}; -print_length_fields([Def | Defs], D, [E | Es], RF, Enc) -> - [print_length_field(Def, D - 1, E, RF, Enc) | - print_length_fields(Defs, D - 1, Es, RF, Enc)]. +print_length_fields([Def | Defs], D, [E | Es], RF, Enc, Str) -> + [print_length_field(Def, D - 1, E, RF, Enc, Str) | + print_length_fields(Defs, D - 1, Es, RF, Enc, Str)]. -print_length_field(Def, D, E, RF, Enc) -> +print_length_field(Def, D, E, RF, Enc, Str) -> Name = io_lib:write_atom(Def), - {S, L} = print_length(E, D, RF, Enc), + {S, L} = print_length(E, D, RF, Enc, Str), NameL = length(Name) + 3, {{field, Name, NameL, {S, L}}, NameL + L}. -print_length_list(List, D, RF, Enc) -> - L = print_length_list1(List, D, RF, Enc), +print_length_list(List, D, RF, Enc, Str) -> + L = print_length_list1(List, D, RF, Enc, Str), {{list, L}, list_length(L, 2)}. -print_length_list1([], _D, _RF, _Enc) -> +print_length_list1([], _D, _RF, _Enc, _Str) -> []; -print_length_list1(_, 1, _RF, _Enc) -> +print_length_list1(_, 1, _RF, _Enc, _Str) -> {dots, 3}; -print_length_list1([E | Es], D, RF, Enc) -> - [print_length(E, D - 1, RF, Enc) | print_length_list1(Es, D - 1, RF, Enc)]; -print_length_list1(E, D, RF, Enc) -> - print_length(E, D - 1, RF, Enc). +print_length_list1([E | Es], D, RF, Enc, Str) -> + [print_length(E, D - 1, RF, Enc, Str) | + print_length_list1(Es, D - 1, RF, Enc, Str)]; +print_length_list1(E, D, RF, Enc, Str) -> + print_length(E, D - 1, RF, Enc, Str). list_length([], Acc) -> Acc; diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 9257953071..a4f4035c79 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -353,7 +353,7 @@ obsolete_1(inviso, _, _) -> %% Added in R15B01. obsolete_1(gs, _, _) -> - {deprecated,"the gs application has been deprecated and will be removed in R16; use the wx application instead"}; + {deprecated,"the gs application has been deprecated and will be removed in R17; use the wx application instead"}; obsolete_1(ssh, sign_data, 2) -> {deprecated,"deprecated (will be removed in R16A); use public_key:pem_decode/1, public_key:pem_entry_decode/1 " "and public_key:sign/3 instead"}; diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 6a27cff589..48f6622565 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -3709,7 +3709,7 @@ maybe_error_logger(Name, Why) -> Trimmer = fun(M, _F, _A) -> M =:= erl_eval end, Formater = fun(Term, I) -> io_lib:print(Term, I, 80, -1) end, X = lib:format_stacktrace(1, Stacktrace, Trimmer, Formater), - error_logger:Name("qlc: temporary file was needed for ~w\n~s\n", + error_logger:Name("qlc: temporary file was needed for ~w\n~ts\n", [Why, lists:flatten(X)]). expand_stacktrace() -> diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index c94f052b24..df66acb97b 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -22,7 +22,7 @@ -export([whereis_evaluator/0, whereis_evaluator/1]). -export([start_restricted/1, stop_restricted/0]). -export([local_allowed/3, non_local_allowed/3]). --export([prompt_func/1]). +-export([prompt_func/1, strings/1]). -define(LINEMAX, 30). -define(CHAR_MAX, 60). @@ -30,6 +30,7 @@ -define(DEF_RESULTS, 20). -define(DEF_CATCH_EXCEPTION, false). -define(DEF_PROMPT_FUNC, default). +-define(DEF_STRINGS, true). -define(RECORDS, shell_records). @@ -1366,8 +1367,16 @@ pp(V, I, RT) -> pp(V, I, RT, enc()). pp(V, I, RT, Enc) -> + Strings = + case application:get_env(stdlib, shell_strings) of + {ok, false} -> + false; + _ -> + true + end, io_lib_pretty:print(V, ([{column, I}, {line_length, columns()}, {depth, ?LINEMAX}, {max_chars, ?CHAR_MAX}, + {strings, Strings}, {record_print_fun, record_print_fun(RT)}] ++ Enc)). @@ -1444,14 +1453,22 @@ history(L) when is_integer(L), L >= 0 -> results(L) when is_integer(L), L >= 0 -> set_env(stdlib, shell_saved_results, L, ?DEF_RESULTS). --spec catch_exception(Bool) -> Bool when +-spec catch_exception(Bool) -> boolean() when Bool :: boolean(). catch_exception(Bool) -> set_env(stdlib, shell_catch_exception, Bool, ?DEF_CATCH_EXCEPTION). --spec prompt_func(PromptFunc) -> PromptFunc when - PromptFunc :: 'default' | {module(),atom()}. +-spec prompt_func(PromptFunc) -> PromptFunc2 when + PromptFunc :: 'default' | {module(),atom()}, + PromptFunc2 :: 'default' | {module(),atom()}. prompt_func(String) -> set_env(stdlib, shell_prompt_func, String, ?DEF_PROMPT_FUNC). + +-spec strings(Strings) -> Strings2 when + Strings :: boolean(), + Strings2 :: boolean(). + +strings(Strings) -> + set_env(stdlib, shell_strings, Strings, ?DEF_STRINGS). diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index dc17e5d33c..4a51ef564c 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -96,7 +96,7 @@ misc1_do/1, safe_fixtable_do/1, info_do/1, dups_do/1, heavy_lookup_do/1, heavy_lookup_element_do/1, member_do/1, otp_5340_do/1, otp_7665_do/1, meta_wb_do/1, do_heavy_concurrent/1, tab2file2_do/2, exit_large_table_owner_do/2, - types_do/1, sleeper/0, rpc_externals/0, memory_do/1, + types_do/1, sleeper/0, memory_do/1, ms_tracee_dummy/1, ms_tracee_dummy/2, ms_tracee_dummy/3, ms_tracee_dummy/4 ]). @@ -5989,33 +5989,103 @@ make_ext_ref() -> init_externals() -> case get(externals) of undefined -> - SysDistSz = ets:info(sys_dist,size), - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {ok, Node} = test_server:start_node(plopp, slave, [{args, " -pa " ++ Pa}]), - ?line Res = case rpc:call(Node, ?MODULE, rpc_externals, []) of - {badrpc, {'EXIT', E}} -> - test_server:fail({rpcresult, E}); - R -> R - end, - ?line test_server:stop_node(Node), - - %% Wait for table 'sys_dist' to stabilize - repeat_while(fun() -> - case ets:info(sys_dist,size) of - SysDistSz -> false; - Sz -> - io:format("Waiting for sys_dist to revert size from ~p to size ~p\n", - [Sz, SysDistSz]), - receive after 1000 -> true end - end - end), + OtherNode = {gurka@sallad, 1}, + Res = {mk_pid(OtherNode, 7645, 8123), + mk_port(OtherNode, 187489773), + mk_ref(OtherNode, [262143, 1293964255, 3291964278])}, put(externals, Res); {_,_,_} -> ok end. -rpc_externals() -> - {self(), make_port(), make_ref()}. +%% +%% Node container constructor functions +%% + +-define(VERSION_MAGIC, 131). +-define(PORT_EXT, 102). +-define(PID_EXT, 103). +-define(NEW_REFERENCE_EXT, 114). + +uint32_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 32 -> + [(Uint bsr 24) band 16#ff, + (Uint bsr 16) band 16#ff, + (Uint bsr 8) band 16#ff, + Uint band 16#ff]; +uint32_be(Uint) -> + exit({badarg, uint32_be, [Uint]}). + +uint16_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 16 -> + [(Uint bsr 8) band 16#ff, + Uint band 16#ff]; +uint16_be(Uint) -> + exit({badarg, uint16_be, [Uint]}). + +uint8(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 8 -> + Uint band 16#ff; +uint8(Uint) -> + exit({badarg, uint8, [Uint]}). + +mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> + <<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName), + mk_pid({NodeNameExt, Creation}, Number, Serial); +mk_pid({NodeNameExt, Creation}, Number, Serial) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?PID_EXT, + NodeNameExt, + uint32_be(Number), + uint32_be(Serial), + uint8(Creation)])) of + Pid when is_pid(Pid) -> + Pid; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_pid, [{NodeNameExt, Creation}, Number, Serial]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + +mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> + <<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName), + mk_port({NodeNameExt, Creation}, Number); +mk_port({NodeNameExt, Creation}, Number) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?PORT_EXT, + NodeNameExt, + uint32_be(Number), + uint8(Creation)])) of + Port when is_port(Port) -> + Port; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_port, [{NodeNameExt, Creation}, Number]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + +mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName), + is_integer(Creation), + is_list(Numbers) -> + <<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName), + mk_ref({NodeNameExt, Creation}, Numbers); +mk_ref({NodeNameExt, Creation}, Numbers) when is_binary(NodeNameExt), + is_integer(Creation), + is_list(Numbers) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?NEW_REFERENCE_EXT, + uint16_be(length(Numbers)), + NodeNameExt, + uint8(Creation), + lists:map(fun (N) -> + uint32_be(N) + end, + Numbers)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeNameExt, Creation}, Numbers]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + make_sub_binary(Bin) when is_binary(Bin) -> {_,B} = split_binary(list_to_binary([0,1,3,Bin]), 3), diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 27078f0914..4a67d68428 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -65,19 +65,26 @@ wildcard_one(Config) when is_list(Config) -> ?line {ok,OldCwd} = file:get_cwd(), ?line Dir = filename:join(?config(priv_dir, Config), "wildcard_one"), ?line ok = file:make_dir(Dir), + do_wildcard_1(Dir, + fun(Wc) -> + filelib:wildcard(Wc, Dir, erl_prim_loader) + end), ?line file:set_cwd(Dir), - ?line do_wildcard_1(Dir, fun(Wc) -> filelib:wildcard(Wc) end), + do_wildcard_1(Dir, + fun(Wc) -> + L = filelib:wildcard(Wc), + L = filelib:wildcard(Wc, erl_prim_loader), + L = filelib:wildcard(Wc, "."), + L = filelib:wildcard(Wc, Dir) + end), ?line file:set_cwd(OldCwd), ?line ok = file:del_dir(Dir), ok. wildcard_two(Config) when is_list(Config) -> ?line Dir = filename:join(?config(priv_dir, Config), "wildcard_two"), - ?line DirB = unicode:characters_to_binary(Dir, file:native_name_encoding()), ?line ok = file:make_dir(Dir), ?line do_wildcard_1(Dir, fun(Wc) -> io:format("~p~n",[{Wc,Dir, X = filelib:wildcard(Wc, Dir)}]),X end), - ?line do_wildcard_1(Dir, fun(Wc) -> io:format("~p~n",[{Wc,DirB, X = filelib:wildcard(Wc, DirB)}]), - [unicode:characters_to_list(Y,file:native_name_encoding()) || Y <- X] end), ?line do_wildcard_1(Dir, fun(Wc) -> filelib:wildcard(Wc, Dir++"/") end), case os:type() of {win32,_} -> @@ -130,6 +137,9 @@ do_wildcard_2(Dir, Wcf) -> ?line ["abc","abcdef"] = Wcf("a*{def,}"), ?line ["abc","abcdef"] = Wcf("a*{,def}"), + %% Constant wildcard. + ["abcdef"] = Wcf("abcdef"), + %% Negative tests. ?line [] = Wcf("b*"), ?line [] = Wcf("bufflig"), @@ -157,6 +167,8 @@ do_wildcard_4(Dir, Wcf) -> All = ["a-","aA","aB","aC","a[","a]"], ?line Files = mkfiles(lists:reverse(All), Dir), ?line All = Wcf("a[][A-C-]"), + ["a-"] = Wcf("a[-]"), + ["a["] = Wcf("a["), ?line del(Files), do_wildcard_5(Dir, Wcf). @@ -173,6 +185,7 @@ do_wildcard_5(Dir, Wcf) -> ?line ["blurf/nisse"] = Wcf("*/nisse"), ?line [] = Wcf("mountain/*"), ?line [] = Wcf("xa/gurka"), + ["blurf/nisse"] = Wcf("blurf/nisse"), %% Cleanup ?line del(Files), @@ -233,7 +246,24 @@ do_wildcard_8(Dir, Wcf) -> del(Files), foreach(fun(D) -> ok = file:del_dir(filename:join(Dir, D)) - end, Dirs2 ++ Dirs1 ++ Dirs0). + end, Dirs2 ++ Dirs1 ++ Dirs0), + do_wildcard_9(Dir, Wcf). + +do_wildcard_9(Dir, Wcf) -> + Dirs0 = ["lib","lib/app","lib/app/ebin"], + Dirs = [filename:join(Dir, D) || D <- Dirs0], + [ok = file:make_dir(D) || D <- Dirs], + Files0 = [filename:join("lib/app/ebin", F++".bar") || + F <- ["abc","foo","foobar"]], + Files = [filename:join(Dir, F) || F <- Files0], + [ok = file:write_file(F, <<"some content\n">>) || F <- Files], + Files0 = Wcf("lib/app/ebin/*.bar"), + + %% Cleanup. + del(Files), + [ok = file:del_dir(D) || D <- lists:reverse(Dirs)], + ok. + fold_files(Config) when is_list(Config) -> ?line Dir = filename:join(?config(priv_dir, Config), "fold_files"), diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 05009fa570..aa698ecaa2 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -29,7 +29,8 @@ manpage/1, otp_6708/1, otp_7084/1, otp_7421/1, io_lib_collect_line_3_wb/1, cr_whitespace_in_string/1, io_fread_newlines/1, otp_8989/1, io_lib_fread_literal/1, - io_lib_print_binary_depth_one/1, otp_10302/1]). + io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1, + otp_10836/1]). %-define(debug, true). @@ -65,7 +66,7 @@ all() -> manpage, otp_6708, otp_7084, otp_7421, io_lib_collect_line_3_wb, cr_whitespace_in_string, io_fread_newlines, otp_8989, io_lib_fread_literal, - io_lib_print_binary_depth_one, otp_10302]. + io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836]. groups() -> []. @@ -2078,3 +2079,47 @@ pretty(Term, Opts) when is_list(Opts) -> is_latin1(S) -> S >= 0 andalso S =< 255. + +otp_10836(doc) -> + "OTP-10836. ~ts extended to latin1"; +otp_10836(Suite) when is_list(Suite) -> + S = io_lib:format("~ts", [[<<"äpple"/utf8>>, <<"äpple">>]]), + "äppleäpple" = lists:flatten(S), + ok. + +otp_10755(doc) -> + "OTP-10755. The 'l' modifier"; +otp_10755(Suite) when is_list(Suite) -> + S = "string", + "\"string\"" = fmt("~p", [S]), + "[115,116,114,105,110,103]" = fmt("~lp", [S]), + "\"string\"" = fmt("~P", [S, 2]), + "[115|...]" = fmt("~lP", [S, 2]), + {'EXIT',{badarg,_}} = (catch fmt("~ltp", [S])), + {'EXIT',{badarg,_}} = (catch fmt("~tlp", [S])), + {'EXIT',{badarg,_}} = (catch fmt("~ltP", [S])), + {'EXIT',{badarg,_}} = (catch fmt("~tlP", [S])), + Text = + "-module(l_mod).\n" + "-export([t/0]).\n" + "t() ->\n" + " S = \"string\",\n" + " io:format(\"~ltp\", [S]),\n" + " io:format(\"~tlp\", [S]),\n" + " io:format(\"~ltP\", [S, 1]),\n" + " io:format(\"~tlP\", [S, 1]).\n", + {ok,l_mod,[{_File,Ws}]} = compile_file("l_mod.erl", Text, Suite), + ["format string invalid (invalid control ~lt)", + "format string invalid (invalid control ~tl)", + "format string invalid (invalid control ~lt)", + "format string invalid (invalid control ~tl)"] = + [lists:flatten(M:format_error(E)) || {_L,M,E} <- Ws], + ok. + +compile_file(File, Text, Config) -> + PrivDir = ?privdir(Config), + Fname = filename:join(PrivDir, File), + ok = file:write_file(Fname, Text), + try compile:file(Fname, [return]) + after ok %file:delete(Fname) + end. diff --git a/lib/syntax_tools/src/erl_comment_scan.erl b/lib/syntax_tools/src/erl_comment_scan.erl index a70e7ba413..dae7530ce7 100644 --- a/lib/syntax_tools/src/erl_comment_scan.erl +++ b/lib/syntax_tools/src/erl_comment_scan.erl @@ -282,7 +282,7 @@ join_lines([], Txt, L, Col, Ind) -> %% ===================================================================== %% Utility functions for internal use -filename([C|T]) when is_integer(C), C > 0, C =< 255 -> +filename([C|T]) when is_integer(C), C > 0 -> [C | filename(T)]; filename([]) -> []; @@ -291,7 +291,7 @@ filename(N) -> exit(error). error_read_file(Name) -> - report_error("error reading file `~s'.", [Name]). + report_error("error reading file `~ts'.", [Name]). report_error(S, Vs) -> error_logger:error_msg(lists:concat([?MODULE, ": ", S, "\n"]), Vs). diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl index e9a88caff3..0c149634f6 100644 --- a/lib/syntax_tools/src/erl_tidy.erl +++ b/lib/syntax_tools/src/erl_tidy.erl @@ -151,7 +151,7 @@ dir_1(Dir, Regexp, Env) -> lists:foreach(fun (X) -> dir_2(X, Regexp, Dir, Env) end, Files); {error, _} -> - report_error("error reading directory `~s'", + report_error("error reading directory `~ts'", [filename(Dir)]), exit(error) end. @@ -180,7 +180,7 @@ dir_2(Name, Regexp, Dir, Env) -> dir_3(Name, Dir, Regexp, Env) -> Dir1 = filename:join(Dir, Name), - verbose("tidying directory `~s'.", [Dir1], Env#dir.options), + verbose("tidying directory `~ts'.", [Dir1], Env#dir.options), dir_1(Dir1, Regexp, Env). dir_4(File, Regexp, Env) -> @@ -189,7 +189,7 @@ dir_4(File, Regexp, Env) -> Opts = [{outfile, File}, {dir, ""} | Env#dir.options], case catch file(File, Opts) of {'EXIT', Value} -> - warn("error tidying `~s'.~n~p", [File,Value], Opts); + warn("error tidying `~ts'.~n~p", [File,Value], Opts); _ -> ok end; @@ -314,7 +314,7 @@ file_2(Name, Opts) -> end. read_module(Name, Opts) -> - verbose("reading module `~s'.", [filename(Name)], Opts), + verbose("reading module `~ts'.", [filename(Name)], Opts), case epp_dodger:parse_file(Name, [no_fail]) of {ok, Forms} -> check_forms(Forms, Name), @@ -335,7 +335,7 @@ check_forms(Fs, Name) -> "unknown error" end, report_error({Name, erl_syntax:get_pos(F), - "\n ~s"}, [S]), + "\n ~ts"}, [S]), exit(error); _ -> ok @@ -357,18 +357,18 @@ write_module(Tree, Name, Opts) -> {value, directory} -> ok; {value, _} -> - report_error("`~s' is not a directory.", + report_error("`~ts' is not a directory.", [filename(Dir)]), exit(error); none -> case file:make_dir(Dir) of ok -> - verbose("created directory `~s'.", + verbose("created directory `~ts'.", [filename(Dir)], Opts), ok; E -> report_error("failed to create " - "directory `~s'.", + "directory `~ts'.", [filename(Dir)]), exit({make_dir, E}) end @@ -385,7 +385,7 @@ write_module(Tree, Name, Opts) -> end, Printer = proplists:get_value(printer, Opts), FD = open_output_file(File, Encoding), - verbose("writing to file `~s'.", [File], Opts), + verbose("writing to file `~ts'.", [File], Opts), V = (catch {ok, output(FD, Printer, Tree, Opts++Encoding)}), ok = file:close(FD), case V of @@ -435,7 +435,6 @@ file_type(Name, Links) -> end. open_output_file(FName, Options) -> -io:format("Options ~p~n", [Options]), case catch file:open(FName, [write]++Options) of {ok, FD} -> FD; @@ -472,7 +471,7 @@ backup_file_1(Name, Opts) -> filename:basename(Name) ++ Suffix), case catch file:rename(Name, Dest) of ok -> - verbose("made backup of file `~s'.", [Name], Opts); + verbose("made backup of file `~ts'.", [Name], Opts); {error, R} -> error_backup_file(Name), exit({error, R}); @@ -1805,7 +1804,7 @@ get_free_vars_1([{free, B} | _Bs]) -> B; get_free_vars_1([_ | Bs]) -> get_free_vars_1(Bs); get_free_vars_1([]) -> []. -filename([C | T]) when is_integer(C), C > 0, C =< 255 -> +filename([C | T]) when is_integer(C), C > 0 -> [C | filename(T)]; filename([H|T]) -> filename(H) ++ filename(T); @@ -1840,17 +1839,17 @@ report_export_vars(F, L, Type, Opts) -> [Type], Opts). error_read_file(Name) -> - report_error("error reading file `~s'.", [filename(Name)]). + report_error("error reading file `~ts'.", [filename(Name)]). error_write_file(Name) -> - report_error("error writing to file `~s'.", [filename(Name)]). + report_error("error writing to file `~ts'.", [filename(Name)]). error_backup_file(Name) -> - report_error("could not create backup of file `~s'.", + report_error("could not create backup of file `~ts'.", [filename(Name)]). error_open_output(Name) -> - report_error("cannot open file `~s' for output.", [filename(Name)]). + report_error("cannot open file `~ts' for output.", [filename(Name)]). verbosity(Opts) -> case proplists:get_bool(quiet, Opts) of @@ -1909,9 +1908,9 @@ format({"", L, D}, Vs) when is_integer(L), L > 0 -> format({"", _L, D}, Vs) -> format(D, Vs); format({F, L, D}, Vs) when is_integer(L), L > 0 -> - [io_lib:fwrite("~s:~w: ", [filename(F), L]), format(D, Vs)]; + [io_lib:fwrite("~ts:~w: ", [filename(F), L]), format(D, Vs)]; format({F, _L, D}, Vs) -> - [io_lib:fwrite("~s: ", [filename(F)]), format(D, Vs)]; + [io_lib:fwrite("~ts: ", [filename(F)]), format(D, Vs)]; format(S, Vs) when is_list(S) -> [io_lib:fwrite(S, Vs), $\n]. diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index 8abc3f41cb..d385c2b690 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -2749,7 +2749,7 @@ read_module(Name, Options) -> end. read_module_1(Name, Options) -> - verbose("reading module `~s'.", [filename(Name)], Options), + verbose("reading module `~ts'.", [filename(Name)], Options), {Forms, Enc} = read_module_2(Name, Options), case proplists:get_bool(comments, Options) of false -> @@ -2794,7 +2794,7 @@ check_forms([F | Fs], File) -> _ -> "unknown error" end, - report_error("in file `~s' at line ~w:\n ~ts", + report_error("in file `~ts' at line ~w:\n ~ts", [filename(File), erl_syntax:get_pos(F), S]), exit(error); _ -> @@ -2841,18 +2841,18 @@ write_module(Tree, Name, Dir, Opts) -> {value, directory} -> ok; {value, _} -> - report_error("`~s' is not a directory.", + report_error("`~ts' is not a directory.", [Dir1]), exit(error); none -> case file:make_dir(Dir1) of ok -> - verbose("created directory `~s'.", + verbose("created directory `~ts'.", [Dir1], Opts), ok; E -> report_error("failed to create " - "directory `~s'.", + "directory `~ts'.", [Dir1]), exit({make_dir, E}) end @@ -2870,7 +2870,7 @@ write_module(Tree, Name, Dir, Opts) -> Printer = proplists:get_value(printer, Opts), FD = open_output_file(File), ok = output_encoding(FD, Opts), - verbose("writing to file `~s'.", [File], Opts), + verbose("writing to file `~ts'.", [File], Opts), V = (catch {ok, output(FD, Printer, Tree, Opts)}), ok = file:close(FD), case V of @@ -2911,7 +2911,7 @@ backup_file_1(Name, Opts) -> filename:basename(Name1) ++ Suffix), case catch file:rename(Name1, Dest) of ok -> - verbose("made backup of file `~s'.", [Name1], Opts); + verbose("made backup of file `~ts'.", [Name1], Opts); {error, R} -> error_backup_file(Name1), exit({error, R}); @@ -2956,7 +2956,7 @@ timestamp() -> "~2.2.0w:~2.2.0w:~2.2.0w.", [Yr, Mth, Dy, Hr, Mt, Sc])). -filename([C | T]) when is_integer(C), C > 0, C =< 255 -> +filename([C | T]) when is_integer(C), C > 0 -> [C | filename(T)]; filename([H|T]) -> filename(H) ++ filename(T); @@ -3036,19 +3036,19 @@ warning_apply_2(Module, Target) -> "possibly unsafe in `~s'.", [Module, Target]). error_open_output(Name) -> - report_error("cannot open file `~s' for output.", [filename(Name)]). + report_error("cannot open file `~ts' for output.", [filename(Name)]). error_read_file(Name) -> - report_error("error reading file `~s'.", [filename(Name)]). + report_error("error reading file `~ts'.", [filename(Name)]). error_read_file_info(Name) -> - report_error("error getting file info: `~s'.", [filename(Name)]). + report_error("error getting file info: `~ts'.", [filename(Name)]). error_write_file(Name) -> - report_error("error writing to file `~s'.", [filename(Name)]). + report_error("error writing to file `~ts'.", [filename(Name)]). error_backup_file(Name) -> - report_error("could not create backup of file `~s'.", + report_error("could not create backup of file `~ts'.", [filename(Name)]). verbose(S, Opts) -> diff --git a/lib/test_server/src/config.guess b/lib/test_server/src/config.guess index 38a833903b..f475ceb413 100755 --- a/lib/test_server/src/config.guess +++ b/lib/test_server/src/config.guess @@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-05-17' +timestamp='2013-02-12' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -17,26 +15,22 @@ timestamp='2007-05-17' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <[email protected]>. -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. # -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# Please send patches with a ChangeLog entry to [email protected]. + me=`echo "$0" | sed -e 's,.*/,,'` @@ -56,8 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -144,7 +137,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward @@ -170,7 +163,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -180,7 +173,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -201,6 +194,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} @@ -223,7 +220,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on @@ -269,7 +266,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead @@ -295,12 +295,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo s390-ibm-zvmoe exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 + echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) + arm*:riscos:*:*|arm*:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) @@ -324,14 +324,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; - i86pc:SunOS:5.*:* | ix86xen:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -375,23 +394,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; @@ -461,8 +480,8 @@ EOF echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -475,7 +494,7 @@ EOF else echo i586-dg-dgux${UNAME_RELEASE} fi - exit ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; @@ -532,7 +551,7 @@ EOF echo rs6000-ibm-aix3.2 fi exit ;; - *:AIX:*:[45]) + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -575,52 +594,52 @@ EOF 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -640,7 +659,7 @@ EOF # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -711,22 +730,22 @@ EOF exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; @@ -750,14 +769,14 @@ EOF exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} @@ -769,40 +788,51 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in amd64) echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 + exit ;; *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - *:Interix*:[3456]*) - case ${UNAME_MACHINE} in - x86) + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) echo i586-pc-interix${UNAME_RELEASE} exit ;; - EM64T | authenticamd) + authenticamd | genuineintel | EM64T) echo x86_64-unknown-interix${UNAME_RELEASE} exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we @@ -832,20 +862,68 @@ EOF i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; - arm*:Linux:*:*) + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) - echo cris-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) - echo frv-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -856,74 +934,36 @@ EOF m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + padre:Linux:*:*) + echo sparc-unknown-linux-gnu exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level @@ -933,14 +973,17 @@ EOF *) echo hppa-unknown-linux-gnu ;; esac exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -948,81 +991,18 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - tile:Linux:*:*) - echo tile-unknown-linux-gnu + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - xtensa:Linux:*:*) - echo xtensa-unknown-linux-gnu + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both @@ -1030,11 +1010,11 @@ EOF echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) @@ -1051,7 +1031,7 @@ EOF i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) @@ -1066,7 +1046,7 @@ EOF fi exit ;; i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; @@ -1094,10 +1074,13 @@ EOF exit ;; pc:*:*:*) # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; @@ -1132,8 +1115,18 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; @@ -1146,7 +1139,7 @@ EOF rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) @@ -1166,10 +1159,10 @@ EOF echo ns32k-sni-sysv fi exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <[email protected]> - echo i586-unisys-sysv4 - exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <[email protected]> + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <[email protected]>. # How about differentiating between stratus architectures? -djm @@ -1195,11 +1188,11 @@ EOF exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; @@ -1209,6 +1202,12 @@ EOF BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; @@ -1236,6 +1235,16 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1251,7 +1260,10 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NSE-?:NONSTOP_KERNEL:*:*) + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) @@ -1296,13 +1308,13 @@ EOF echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} + echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` + UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; @@ -1317,11 +1329,14 @@ EOF i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; esac -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ @@ -1339,11 +1354,11 @@ main () #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif @@ -1477,9 +1492,9 @@ This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff --git a/lib/test_server/src/config.sub b/lib/test_server/src/config.sub index f43233b104..bb6edbdb47 100755 --- a/lib/test_server/src/config.sub +++ b/lib/test_server/src/config.sub @@ -1,44 +1,40 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-04-29' +timestamp='2013-02-12' -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# Please send patches with a ChangeLog entry to [email protected]. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -72,8 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -120,12 +115,18 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ - uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] @@ -148,10 +149,13 @@ case $os in -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray) + -apple | -axis | -knuth | -cray | -microblaze*) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -166,10 +170,10 @@ case $os in os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; @@ -214,6 +218,12 @@ case $os in -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; -lynx*) os=-lynxos ;; @@ -238,24 +248,34 @@ case $basic_machine in # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ + | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | arc \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ + | epiphany \ | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | mcore | mep \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ @@ -266,31 +286,45 @@ case $basic_machine in | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ | mt \ | msp430 \ - | nios | nios2 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | or32 \ + | open8 \ + | or1k | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ + | rl78 | rx \ | score \ - | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu | strongarm \ - | tahoe | thumb | tic4x | tic80 | tron \ - | v850 | v850e \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; @@ -300,6 +334,21 @@ case $basic_machine in basic_machine=mt-unknown ;; + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; + # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. @@ -314,29 +363,37 @@ case $basic_machine in # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ + | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* | avr32-* \ + | be32-* | be64-* \ | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ @@ -347,31 +404,41 @@ case $basic_machine in | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ - | nios-* | nios2-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ - | xstormy16-* | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -389,7 +456,7 @@ case $basic_machine in basic_machine=a29k-amd os=-udi ;; - abacus) + abacus) basic_machine=abacus-unknown ;; adobe68k) @@ -435,6 +502,10 @@ case $basic_machine in basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -443,10 +514,35 @@ case $basic_machine in basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -475,8 +571,8 @@ case $basic_machine in basic_machine=craynv-cray os=-unicosmp ;; - cr16c) - basic_machine=cr16c-unknown + cr16 | cr16-*) + basic_machine=cr16-unknown os=-elf ;; crds | unos) @@ -514,6 +610,10 @@ case $basic_machine in basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp @@ -629,7 +729,6 @@ case $basic_machine in i370-ibm* | ibm*) basic_machine=i370-ibm ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 @@ -668,6 +767,14 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -679,6 +786,13 @@ case $basic_machine in basic_machine=ns32k-utek os=-sysv ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; mingw32) basic_machine=i386-pc os=-mingw32 @@ -715,10 +829,18 @@ case $basic_machine in ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -783,6 +905,12 @@ case $basic_machine in np1) basic_machine=np1-gould ;; + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem + ;; nsr-tandem) basic_machine=nsr-tandem ;; @@ -813,6 +941,14 @@ case $basic_machine in basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -857,9 +993,10 @@ case $basic_machine in ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -884,7 +1021,11 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; - rdos) + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) basic_machine=i386-pc os=-rdos ;; @@ -953,6 +1094,9 @@ case $basic_machine in basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -1009,17 +1153,9 @@ case $basic_machine in basic_machine=t90-cray os=-unicos ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -1027,10 +1163,6 @@ case $basic_machine in tx39el) basic_machine=mipstx39el-unknown ;; - tile*) - basic_machine=tile-tilera - os=-linux-gnu - ;; toad1) basic_machine=pdp10-xkl os=-tops20 @@ -1092,6 +1224,9 @@ case $basic_machine in xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1100,6 +1235,10 @@ case $basic_machine in basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1138,7 +1277,7 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) @@ -1185,9 +1324,12 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1208,21 +1350,23 @@ case $os in # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -openbsd* | -solidbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ @@ -1230,7 +1374,7 @@ case $os in | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1269,7 +1413,7 @@ case $os in -opened*) os=-openedition ;; - -os400*) + -os400*) os=-os400 ;; -wince*) @@ -1318,7 +1462,7 @@ case $os in -sinix*) os=-sysv4 ;; - -tpf*) + -tpf*) os=-tpf ;; -triton*) @@ -1354,12 +1498,14 @@ case $os in -aros*) os=-aros ;; - -kaos*) - os=-kaos - ;; -zvmoe) os=-zvmoe ;; + -dicos*) + os=-dicos + ;; + -nacl*) + ;; -none) ;; *) @@ -1382,10 +1528,10 @@ else # system, and we'll never get to this point. case $basic_machine in - score-*) + score-*) os=-elf ;; - spu-*) + spu-*) os=-elf ;; *-acorn) @@ -1397,8 +1543,20 @@ case $basic_machine in arm*-semi) os=-aout ;; - c4x-* | tic4x-*) - os=-coff + c4x-* | tic4x-*) + os=-coff + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff ;; # This must come before the *-dec entry. pdp10-*) @@ -1418,14 +1576,11 @@ case $basic_machine in ;; m68000-sun) os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 ;; m68*-cisco) os=-aout ;; - mep-*) + mep-*) os=-elf ;; mips*-cisco) @@ -1434,6 +1589,9 @@ case $basic_machine in mips*-*) os=-elf ;; + or1k-*) + os=-elf + ;; or32-*) os=-coff ;; @@ -1452,7 +1610,7 @@ case $basic_machine in *-ibm) os=-aix ;; - *-knuth) + *-knuth) os=-mmixware ;; *-wec) @@ -1557,7 +1715,7 @@ case $basic_machine in -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1628,3 +1786,4 @@ exit # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: + diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index 70cb6fa220..5d4d392166 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -681,7 +681,7 @@ handle_call({abort_current_testcase,Reason}, _From, State) -> handle_call({finish,Fini}, _From, State) -> case State#state.jobs of [] -> - lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Fini) end, State#state.idle_notify), State2 = State#state{finish=false}, {stop,shutdown,{ok,self()}, State2}; @@ -699,14 +699,11 @@ handle_call({finish,Fini}, _From, State) -> handle_call({idle_notify,Fun}, {Cli,_Ref}, State) -> case State#state.jobs of - [] -> - Fun(Cli), - {reply, {ok,self()}, State}; - _ -> - Subscribed = State#state.idle_notify, - {reply, {ok,self()}, - State#state{idle_notify=[{Cli,Fun}|Subscribed]}} - end; + [] -> self() ! report_idle; + _ -> ok + end, + Subscribed = State#state.idle_notify, + {reply, {ok,self()}, State#state{idle_notify=[{Cli,Fun}|Subscribed]}}; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% handle_call(start_get_totals, From, State) -> {ok,Pid} @@ -1000,6 +997,13 @@ handle_cast({node_started,Node}, State) -> %% lost contact with target. The test_server_ctrl process is %% terminated, and teminate/2 will do the cleanup +handle_info(report_idle, State) -> + Finish = State#state.finish, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, + State#state.idle_notify), + {noreply,State#state{idle_notify=[]}}; + + handle_info({'EXIT',Pid,Reason}, State) -> case lists:keysearch(Pid,2,State#state.jobs) of false -> @@ -1017,11 +1021,12 @@ handle_info({'EXIT',Pid,Reason}, State) -> [Name,Reason]) end, State2 = State#state{jobs=NewJobs}, + Finish = State2#state.finish, case NewJobs of [] -> - lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, State2#state.idle_notify), - case State2#state.finish of + case Finish of false -> {noreply,State2#state{idle_notify=[]}}; _ -> % true | abort @@ -1031,9 +1036,9 @@ handle_info({'EXIT',Pid,Reason}, State) -> {stop,shutdown,State2#state{finish=false}} end; _ -> % pending jobs - case State2#state.finish of + case Finish of abort -> % abort test now! - lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, State2#state.idle_notify), {stop,shutdown,State2#state{finish=false}}; _ -> % true | false diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index 741dd483f5..2be892d8d3 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -261,13 +261,17 @@ run_batch(Vars, _Spec, State) -> ts_lib:progress(Vars, 1, "Command: ~s~n", [Command]), io:format(user, "Command: ~s~n",[Command]), Port = open_port({spawn, Command}, [stream, in, eof]), - tricky_print_data(Port). + Timeout = 30000 * case os:getenv("TS_RUN_VALGRIND") of + false -> 1; + _ -> 100 + end, + tricky_print_data(Port, Timeout). -tricky_print_data(Port) -> +tricky_print_data(Port, Timeout) -> receive {Port, {data, Bytes}} -> io:put_chars(Bytes), - tricky_print_data(Port); + tricky_print_data(Port, Timeout); {Port, eof} -> Port ! {self(), close}, receive @@ -280,7 +284,7 @@ tricky_print_data(Port) -> after 1 -> % force context switch ok end - after 30000 -> + after Timeout -> case erl_epmd:names() of {ok,Names} -> case is_testnode_dead(Names) of @@ -288,10 +292,10 @@ tricky_print_data(Port) -> io:put_chars("WARNING: No EOF, but " "test_server node is down!\n"); false -> - tricky_print_data(Port) + tricky_print_data(Port, Timeout) end; _ -> - tricky_print_data(Port) + tricky_print_data(Port, Timeout) end end. diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index d6d4457920..ddd22707dd 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -728,6 +728,8 @@ resulting regexp is surrounded by \\_< and \\_>." "atom_to_list" "binary_to_atom" "binary_to_existing_atom" + "binary_to_float" + "binary_to_integer" "binary_to_list" "binary_to_term" "binary_part" @@ -746,6 +748,7 @@ resulting regexp is surrounded by \\_< and \\_>." "error" "exit" "float" + "float_to_binary" "float_to_list" "garbage_collect" "get" @@ -754,6 +757,7 @@ resulting regexp is surrounded by \\_< and \\_>." "halt" "hd" "integer_to_list" + "integer_to_binary" "iolist_size" "iolist_to_binary" "is_alive" diff --git a/lib/wx/autoconf/config.guess b/lib/wx/autoconf/config.guess index ec46d18caf..f475ceb413 100755 --- a/lib/wx/autoconf/config.guess +++ b/lib/wx/autoconf/config.guess @@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2006-02-27' +timestamp='2013-02-12' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -17,26 +15,22 @@ timestamp='2006-02-27' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <[email protected]>. -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. # -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# Please send patches with a ChangeLog entry to [email protected]. + me=`echo "$0" | sed -e 's,.*/,,'` @@ -56,8 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -144,7 +137,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward @@ -161,6 +154,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*) machine=arm-unknown ;; sh3el) machine=shl-unknown ;; sh3eb) machine=sh-unknown ;; + sh5el) machine=sh5le-unknown ;; *) machine=${UNAME_MACHINE_ARCH}-unknown ;; esac # The Operating System including object format, if it has switched @@ -169,7 +163,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -179,7 +173,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -200,6 +194,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} @@ -211,7 +209,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} exit ;; macppc:MirBSD:*:*) - echo powerppc-unknown-mirbsd${UNAME_RELEASE} + echo powerpc-unknown-mirbsd${UNAME_RELEASE} exit ;; *:MirBSD:*:*) echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} @@ -222,7 +220,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on @@ -268,7 +266,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead @@ -294,12 +295,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo s390-ibm-zvmoe exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 + echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) + arm*:riscos:*:*|arm*:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) @@ -323,14 +324,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; - i86pc:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -374,23 +394,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; @@ -460,8 +480,8 @@ EOF echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -474,7 +494,7 @@ EOF else echo i586-dg-dgux${UNAME_RELEASE} fi - exit ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; @@ -531,7 +551,7 @@ EOF echo rs6000-ibm-aix3.2 fi exit ;; - *:AIX:*:[45]) + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -574,52 +594,52 @@ EOF 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -639,7 +659,7 @@ EOF # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -710,22 +730,22 @@ EOF exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; @@ -749,14 +769,14 @@ EOF exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} @@ -768,38 +788,51 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in + amd64) + echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; - i*:MINGW*:*) - echo ${UNAME_MACHINE}-pc-mingw32 + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 exit ;; - i*:MSYS_NT-*:*:*) + *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - x86:Interix*:[345]*) - echo i586-pc-interix${UNAME_RELEASE} - exit ;; - EM64T:Interix*:[345]*) - echo x86_64-unknown-interix${UNAME_RELEASE} - exit ;; + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) + echo i586-pc-interix${UNAME_RELEASE} + exit ;; + authenticamd | genuineintel | EM64T) + echo x86_64-unknown-interix${UNAME_RELEASE} + exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; + esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we @@ -829,17 +862,68 @@ EOF i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; + avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) - echo cris-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) - echo frv-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -850,74 +934,36 @@ EOF m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + padre:Linux:*:*) + echo sparc-unknown-linux-gnu exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level @@ -927,14 +973,17 @@ EOF *) echo hppa-unknown-linux-gnu ;; esac exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -942,75 +991,18 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__sun) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both @@ -1018,11 +1010,11 @@ EOF echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) @@ -1039,7 +1031,7 @@ EOF i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) @@ -1054,7 +1046,7 @@ EOF fi exit ;; i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; @@ -1082,10 +1074,13 @@ EOF exit ;; pc:*:*:*) # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; @@ -1120,8 +1115,18 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; @@ -1134,7 +1139,7 @@ EOF rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) @@ -1154,10 +1159,10 @@ EOF echo ns32k-sni-sysv fi exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <[email protected]> - echo i586-unisys-sysv4 - exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <[email protected]> + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <[email protected]>. # How about differentiating between stratus architectures? -djm @@ -1183,11 +1188,11 @@ EOF exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; @@ -1197,6 +1202,12 @@ EOF BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; @@ -1206,6 +1217,15 @@ EOF SX-6:SUPER-UX:*:*) echo sx6-nec-superux${UNAME_RELEASE} exit ;; + SX-7:SUPER-UX:*:*) + echo sx7-nec-superux${UNAME_RELEASE} + exit ;; + SX-8:SUPER-UX:*:*) + echo sx8-nec-superux${UNAME_RELEASE} + exit ;; + SX-8R:SUPER-UX:*:*) + echo sx8r-nec-superux${UNAME_RELEASE} + exit ;; Power*:Rhapsody:*:*) echo powerpc-apple-rhapsody${UNAME_RELEASE} exit ;; @@ -1215,6 +1235,16 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1230,7 +1260,10 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NSE-?:NONSTOP_KERNEL:*:*) + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) @@ -1275,13 +1308,13 @@ EOF echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} + echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` + UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; @@ -1296,11 +1329,14 @@ EOF i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; esac -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ @@ -1318,11 +1354,11 @@ main () #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif @@ -1456,9 +1492,9 @@ This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff --git a/lib/wx/autoconf/config.sub b/lib/wx/autoconf/config.sub index 9772e87d24..bb6edbdb47 100755 --- a/lib/wx/autoconf/config.sub +++ b/lib/wx/autoconf/config.sub @@ -1,42 +1,40 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2003-02-22' +timestamp='2013-02-12' -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. - +# along with this program; if not, see <http://www.gnu.org/licenses/>. +# # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. + +# Please send patches with a ChangeLog entry to [email protected]. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -70,8 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -83,11 +80,11 @@ Try \`$me --help' for more information." while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) - echo "$timestamp" ; exit 0 ;; + echo "$timestamp" ; exit ;; --version | -v ) - echo "$version" ; exit 0 ;; + echo "$version" ; exit ;; --help | --h* | -h ) - echo "$usage"; exit 0 ;; + echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. @@ -99,7 +96,7 @@ while test $# -gt 0 ; do *local*) # First pass through any local machine types. echo $1 - exit 0;; + exit ;; * ) break ;; @@ -118,10 +115,18 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | freebsd*-gnu* | netbsd*-gnu* | storm-chaos* | os2-emx* | rtmk-nova*) + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ + storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] @@ -144,10 +149,13 @@ case $os in -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis) + -apple | -axis | -knuth | -cray | -microblaze*) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -162,13 +170,17 @@ case $os in os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; + -sco6) + os=-sco5v6 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; -sco5) os=-sco3.2v5 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` @@ -185,6 +197,10 @@ case $os in # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -sco5v6*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; -sco*) os=-sco3.2v2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` @@ -202,6 +218,12 @@ case $os in -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; -lynx*) os=-lynxos ;; @@ -226,55 +248,106 @@ case $basic_machine in # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ + | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \ - | clipper \ + | am33_2.0 \ + | arc \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ + | bfin \ + | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ - | fr30 | frv \ + | epiphany \ + | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ - | ip2k \ - | m32r | m68000 | m68k | m88k | mcore \ + | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ + | m32c | m32r | m32rle | m68000 | m68k | m88k \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ + | mips64vr5900 | mips64vr5900el \ | mipsisa32 | mipsisa32el \ | mipsisa32r2 | mipsisa32r2el \ | mipsisa64 | mipsisa64el \ + | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ + | mt \ | msp430 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | openrisc | or32 \ + | open8 \ + | or1k | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ - | sh | sh[1234] | sh[23]e | sh[34]eb | shbe | shle | sh[1234]le | sh3ele \ + | rl78 | rx \ + | score \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ - | sparc | sparc64 | sparc86x | sparclet | sparclite | sparcv9 | sparcv9b \ - | strongarm \ - | tahoe | thumb | tic80 | tron \ - | v850 | v850e \ + | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ + | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xscale | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) ;; + ms1) + basic_machine=mt-unknown + ;; + + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; # We use `pc' rather than `unknown' # because (1) that's what they normally are, and @@ -290,58 +363,82 @@ case $basic_machine in # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ + | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ - | avr-* \ - | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ - | clipper-* | cydra-* \ + | avr-* | avr32-* \ + | be32-* | be64-* \ + | bfin-* | bs2000-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ + | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ - | f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \ + | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ - | ip2k-* \ - | m32r-* \ + | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ + | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ + | mips64vr5900-* | mips64vr5900el-* \ | mipsisa32-* | mipsisa32el-* \ | mipsisa32r2-* | mipsisa32r2el-* \ | mipsisa64-* | mipsisa64el-* \ + | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ + | mmix-* \ + | mt-* \ | msp430-* \ - | none-* | np1-* | nv1-* | ns16k-* | ns32k-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ + | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[23]e-* | sh[34]eb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ - | sparc-* | sparc64-* | sparc86x-* | sparclet-* | sparclite-* \ - | sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ + | sparclite-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xps100-* | xscale-* | xstormy16-* \ - | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -359,6 +456,9 @@ case $basic_machine in basic_machine=a29k-amd os=-udi ;; + abacus) + basic_machine=abacus-unknown + ;; adobe68k) basic_machine=m68010-adobe os=-scout @@ -373,6 +473,12 @@ case $basic_machine in basic_machine=a29k-none os=-bsd ;; + amd64) + basic_machine=x86_64-pc + ;; + amd64-*) + basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; amdahl) basic_machine=580-amdahl os=-sysv @@ -396,6 +502,10 @@ case $basic_machine in basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -404,10 +514,35 @@ case $basic_machine in basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -432,12 +567,27 @@ case $basic_machine in basic_machine=j90-cray os=-unicos ;; + craynv) + basic_machine=craynv-cray + os=-unicosmp + ;; + cr16 | cr16-*) + basic_machine=cr16-unknown + os=-elf + ;; crds | unos) basic_machine=m68k-crds ;; + crisv32 | crisv32-* | etraxfs*) + basic_machine=crisv32-axis + ;; cris | cris-* | etrax*) basic_machine=cris-axis ;; + crx) + basic_machine=crx-unknown + os=-elf + ;; da30 | da30-*) basic_machine=m68k-da30 ;; @@ -460,6 +610,14 @@ case $basic_machine in basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; + djgpp) + basic_machine=i586-pc + os=-msdosdjgpp + ;; dpx20 | dpx20-*) basic_machine=rs6000-bull os=-bosx @@ -571,7 +729,6 @@ case $basic_machine in i370-ibm* | ibm*) basic_machine=i370-ibm ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 @@ -610,6 +767,14 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -621,10 +786,21 @@ case $basic_machine in basic_machine=ns32k-utek os=-sysv ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; mingw32) basic_machine=i386-pc os=-mingw32 ;; + mingw32ce) + basic_machine=arm-unknown + os=-mingw32ce + ;; miniframe) basic_machine=m68000-convergent ;; @@ -638,10 +814,6 @@ case $basic_machine in mips3*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown ;; - mmix*) - basic_machine=mmix-knuth - os=-mmixware - ;; monitor) basic_machine=m68k-rom68k os=-coff @@ -654,10 +826,21 @@ case $basic_machine in basic_machine=i386-pc os=-msdos ;; + ms1-*) + basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` + ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -722,9 +905,11 @@ case $basic_machine in np1) basic_machine=np1-gould ;; - nv1) - basic_machine=nv1-cray - os=-unicosmp + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem ;; nsr-tandem) basic_machine=nsr-tandem @@ -733,9 +918,12 @@ case $basic_machine in basic_machine=hppa1.1-oki os=-proelf ;; - or32 | or32-*) + openrisc | openrisc-*) basic_machine=or32-unknown - os=-coff + ;; + os400) + basic_machine=powerpc-ibm + os=-os400 ;; OSE68000 | ose68000) basic_machine=m68000-ericsson @@ -753,6 +941,14 @@ case $basic_machine in basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -762,32 +958,45 @@ case $basic_machine in pc532 | pc532-*) basic_machine=ns32k-pc532 ;; + pc98) + basic_machine=i386-pc + ;; + pc98-*) + basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; pentium | p5 | k5 | k6 | nexgen | viac3) basic_machine=i586-pc ;; pentiumpro | p6 | 6x86 | athlon | athlon_*) basic_machine=i686-pc ;; - pentiumii | pentium2) + pentiumii | pentium2 | pentiumiii | pentium3) basic_machine=i686-pc ;; + pentium4) + basic_machine=i786-pc + ;; pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumpro-* | p6-* | 6x86-* | athlon-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; - pentiumii-* | pentium2-*) + pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; + pentium4-*) + basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; pn) basic_machine=pn-gould ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -812,6 +1021,14 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) + basic_machine=i386-pc + os=-rdos + ;; rom68k) basic_machine=m68k-rom68k os=-coff @@ -838,6 +1055,14 @@ case $basic_machine in sb1el) basic_machine=mipsisa64sb1el-unknown ;; + sde) + basic_machine=mipsisa32-sde + os=-elf + ;; + sei) + basic_machine=mips-sei + os=-seiux + ;; sequent) basic_machine=i386-sequent ;; @@ -845,6 +1070,12 @@ case $basic_machine in basic_machine=sh-hitachi os=-hms ;; + sh5el) + basic_machine=sh5le-unknown + ;; + sh64) + basic_machine=sh64-unknown + ;; sparclite-wrs | simso-wrs) basic_machine=sparclite-wrs os=-vxworks @@ -863,6 +1094,9 @@ case $basic_machine in basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -919,21 +1153,9 @@ case $basic_machine in basic_machine=t90-cray os=-unicos ;; - tic4x | c4x*) - basic_machine=tic4x-unknown - os=-coff - ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -948,6 +1170,10 @@ case $basic_machine in tower | tower-32) basic_machine=m68k-ncr ;; + tpf) + basic_machine=s390x-ibm + os=-tpf + ;; udi29k) basic_machine=a29k-amd os=-udi @@ -991,9 +1217,16 @@ case $basic_machine in basic_machine=hppa1.1-winbond os=-proelf ;; + xbox) + basic_machine=i686-pc + os=-mingw32 + ;; xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1002,6 +1235,10 @@ case $basic_machine in basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1021,6 +1258,9 @@ case $basic_machine in romp) basic_machine=romp-ibm ;; + mmix) + basic_machine=mmix-knuth + ;; rs6000) basic_machine=rs6000-ibm ;; @@ -1037,13 +1277,10 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh3 | sh4 | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; - sh64) - basic_machine=sh64-unknown - ;; - sparc | sparcv9 | sparcv9b) + sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) basic_machine=sparc-sun ;; cydra) @@ -1087,9 +1324,12 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1110,25 +1350,31 @@ case $os in # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ - | -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \ - | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ + | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ + | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ + | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -uxpv* | -beos* | -mpeix* | -udk* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ + | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ - | -powermax* | -dnix*) + | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1146,12 +1392,15 @@ case $os in os=`echo $os | sed -e 's|nto|nto-qnx|'` ;; -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ - | -windows* | -osx | -abug | -netware* | -os9* | -beos* \ + | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) ;; -mac*) os=`echo $os | sed -e 's|mac|macos|'` ;; + -linux-dietlibc) + os=-linux-dietlibc + ;; -linux*) os=`echo $os | sed -e 's|linux|linux-gnu|'` ;; @@ -1164,6 +1413,9 @@ case $os in -opened*) os=-openedition ;; + -os400*) + os=-os400 + ;; -wince*) os=-wince ;; @@ -1185,6 +1437,9 @@ case $os in -atheos*) os=-atheos ;; + -syllable*) + os=-syllable + ;; -386bsd) os=-bsd ;; @@ -1207,6 +1462,9 @@ case $os in -sinix*) os=-sysv4 ;; + -tpf*) + os=-tpf + ;; -triton*) os=-sysv3 ;; @@ -1240,8 +1498,13 @@ case $os in -aros*) os=-aros ;; - -kaos*) - os=-kaos + -zvmoe) + os=-zvmoe + ;; + -dicos*) + os=-dicos + ;; + -nacl*) ;; -none) ;; @@ -1265,6 +1528,12 @@ else # system, and we'll never get to this point. case $basic_machine in + score-*) + os=-elf + ;; + spu-*) + os=-elf + ;; *-acorn) os=-riscix1.2 ;; @@ -1274,6 +1543,21 @@ case $basic_machine in arm*-semi) os=-aout ;; + c4x-* | tic4x-*) + os=-coff + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff + ;; # This must come before the *-dec entry. pdp10-*) os=-tops20 @@ -1292,19 +1576,22 @@ case $basic_machine in ;; m68000-sun) os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 ;; m68*-cisco) os=-aout ;; + mep-*) + os=-elf + ;; mips*-cisco) os=-elf ;; mips*-*) os=-elf ;; + or1k-*) + os=-elf + ;; or32-*) os=-coff ;; @@ -1317,9 +1604,15 @@ case $basic_machine in *-be) os=-beos ;; + *-haiku) + os=-haiku + ;; *-ibm) os=-aix ;; + *-knuth) + os=-mmixware + ;; *-wec) os=-proelf ;; @@ -1422,7 +1715,7 @@ case $basic_machine in -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1452,9 +1745,15 @@ case $basic_machine in -mvs* | -opened*) vendor=ibm ;; + -os400*) + vendor=ibm + ;; -ptx*) vendor=sequent ;; + -tpf*) + vendor=ibm + ;; -vxsim* | -vxworks* | -windiss*) vendor=wrs ;; @@ -1479,7 +1778,7 @@ case $basic_machine in esac echo $basic_machine$os -exit 0 +exit # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) @@ -1487,3 +1786,4 @@ exit 0 # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: + diff --git a/system/doc/reference_manual/data_types.xml b/system/doc/reference_manual/data_types.xml index df1c0f8fa8..73ec6e2b82 100644 --- a/system/doc/reference_manual/data_types.xml +++ b/system/doc/reference_manual/data_types.xml @@ -393,7 +393,15 @@ hello 12> <input>term_to_binary({a,b,c}).</input> <<131,104,3,100,0,1,97,100,0,1,98,100,0,1,99>> 13> <input>binary_to_term(<<131,104,3,100,0,1,97,100,0,1,98,100,0,1,99>>).</input> -{a,b,c}</pre> +{a,b,c} +14> <input>binary_to_integer(<<"77">>).</input> +77 +15> <input>integer_to_binary(77).</input> +<<"77">> +16> <input>float_to_binary(7.0).</input> +<<"7.00000000000000000000e+00">> +17> <input>binary_to_float(<<"7.000e+00>>").</input> +7.0</pre> </section> </chapter> diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml index 9207d536d5..1279493ba8 100644 --- a/system/doc/reference_manual/typespec.xml +++ b/system/doc/reference_manual/typespec.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> @@ -13,12 +13,12 @@ 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. - + </legalnotice> <title>Types and Function Specifications</title> @@ -30,111 +30,121 @@ </header> <section> - <title>Introduction of Types</title> - <p> - Erlang is a dynamically typed language. Still, it comes with a - language extension for declaring sets of Erlang terms to form a - particular type, effectively forming a specific sub-type of the set - of all Erlang terms. - </p> - <p> - Subsequently, these types can be used to specify types of record fields - and the argument and return types of functions. - </p> - <p> - Type information can be used to document function interfaces, - provide more information for bug detection tools such as <c>Dialyzer</c>, - and can be exploited by documentation tools such as <c>Edoc</c> for - generating program documentation of various forms. - It is expected that the type language described in this document will - supersede and replace the purely comment-based <c>@type</c> and - <c>@spec</c> declarations used by <c>Edoc</c>. - </p> + <title>The Erlang Type Language</title> + <p> + Erlang is a dynamically typed language. Still, it comes with a + notation for declaring sets of Erlang terms to form a particular + type, effectively forming a specific sub-type of the set of all + Erlang terms. + </p> + <p> + Subsequently, these types can be used to specify types of record fields + and the argument and return types of functions. + </p> + <p> + Type information can be used to document function interfaces, + provide more information for bug detection tools such as <c>Dialyzer</c>, + and can be exploited by documentation tools such as <c>Edoc</c> for + generating program documentation of various forms. + It is expected that the type language described in this document will + supersede and replace the purely comment-based <c>@type</c> and + <c>@spec</c> declarations used by <c>Edoc</c>. + </p> </section> <section> <marker id="syntax"></marker> <title>Types and their Syntax</title> <p> - Types describe sets of Erlang terms. - Types consist and are built from a set of predefined types (e.g. <c>integer()</c>, - <c>atom()</c>, <c>pid()</c>, ...) described below. - Predefined types represent a typically infinite set of Erlang terms which - belong to this type. - For example, the type <c>atom()</c> stands for the set of all Erlang atoms. - </p> - <p> - For integers and atoms, we allow for singleton types (e.g. the integers <c>-1</c> - and <c>42</c> or the atoms <c>'foo'</c> and <c>'bar'</c>). + Types describe sets of Erlang terms. + Types consist and are built from a set of predefined types + (e.g. <c>integer()</c>, <c>atom()</c>, <c>pid()</c>, ...) + described below. + Predefined types represent a typically infinite set of Erlang terms which + belong to this type. For example, the type <c>atom()</c> stands for the + set of all Erlang atoms. + </p> + <p> + For integers and atoms, we allow for singleton types (e.g. the integers + <c>-1</c> and <c>42</c> or the atoms <c>'foo'</c> and <c>'bar'</c>). - All other types are built using unions of either predefined types or singleton - types. In a type union between a type and one of its sub-types the sub-type is - absorbed by the super-type and the union is subsequently treated as if the - sub-type was not a constituent of the union. For example, the type union: + All other types are built using unions of either predefined + types or singleton types. In a type union between a type and one + of its sub-types the sub-type is absorbed by the super-type and + the union is subsequently treated as if the sub-type was not a + constituent of the union. For example, the type union: </p> - <pre> - atom() | 'bar' | integer() | 42</pre> - <p> - describes the same set of terms as the type union: - </p> - <pre> -atom() | integer()</pre> - <p> - Because of sub-type relations that exist between types, types form a lattice - where the topmost element, any(), denotes the set of all Erlang terms and - the bottom-most element, none(), denotes the empty set of terms. - </p> - <p> - The set of predefined types and the syntax for types is given below: - </p> - <pre><![CDATA[ -Type :: any() %% The top type, the set of all Erlang terms. - | none() %% The bottom type, contains no terms. - | pid() - | port() - | reference() - | [] %% nil - | Atom - | Binary - | float() - | Fun - | Integer - | List - | Tuple - | Union - | UserDefined %% described in Section 2 + <pre> atom() | 'bar' | integer() | 42</pre> + <p> + describes the same set of terms as the type union: + </p> + <pre> atom() | integer()</pre> + <p> + Because of sub-type relations that exist between types, types + form a lattice where the topmost element, <c>any()</c>, denotes + the set of all Erlang terms and the bottom-most element, <c>none()</c>, + denotes the empty set of terms. + </p> + <p> + The set of predefined types and the syntax for types is given below: + </p> + <pre><![CDATA[ + Type :: any() %% The top type, the set of all Erlang terms + | none() %% The bottom type, contains no terms + | pid() + | port() + | reference() + | [] %% nil + | Atom + | Bitstring + | float() + | Fun + | Integer + | List + | Tuple + | Union + | UserDefined %% described in Section 6.3 -Union :: Type1 | Type2 + Atom :: atom() + | Erlang_Atom %% 'foo', 'bar', ... -Atom :: atom() - | Erlang_Atom %% 'foo', 'bar', ... + Bitstring :: <<>> + | <<_:M>> %% M is a positive integer + | <<_:_*N>> %% N is a positive integer + | <<_:M, _:_*N>> -Binary :: binary() %% <<_:_ * 8>> - | <<>> - | <<_:Erlang_Integer>> %% Base size - | <<_:_*Erlang_Integer>> %% Unit size - | <<_:Erlang_Integer, _:_*Erlang_Integer>> + Fun :: fun() %% any function + | fun((...) -> Type) %% any arity, returning Type + | fun(() -> Type) + | fun((TList) -> Type) -Fun :: fun() %% any function - | fun((...) -> Type) %% any arity, returning Type - | fun(() -> Type) - | fun((TList) -> Type) + Integer :: integer() + | Erlang_Integer %% ..., -1, 0, 1, ... 42 ... + | Erlang_Integer..Erlang_Integer %% specifies an integer range -Integer :: integer() - | Erlang_Integer %% ..., -1, 0, 1, ... 42 ... - | Erlang_Integer..Erlang_Integer %% specifies an integer range + List :: list(Type) %% Proper list ([]-terminated) + | improper_list(Type1, Type2) %% Type1=contents, Type2=termination + | maybe_improper_list(Type1, Type2) %% Type1 and Type2 as above -List :: list(Type) %% Proper list ([]-terminated) - | improper_list(Type1, Type2) %% Type1=contents, Type2=termination - | maybe_improper_list(Type1, Type2) %% Type1 and Type2 as above + Tuple :: tuple() %% stands for a tuple of any size + | {} + | {TList} -Tuple :: tuple() %% stands for a tuple of any size - | {} - | {TList} + TList :: Type + | Type, TList -TList :: Type - | Type, TList + Union :: Type1 | Type2 ]]></pre> <p> + The general form of bitstrings is <c><<_:M, _:_*N>></c>, + where <c>M</c> and <c>N</c> are positive integers. It denotes a + bitstring that is <c>M + (k*N)</c> bits long (i.e., a bitstring that + starts with <c>M</c> bits and continues with <c>k</c> segments of + <c>N</c> bits each, where <c>k</c> is also a positive integer). + The notations <c><<_:_*N>></c>, <c><<_:M>></c>, + and <c><<>></c> are convenient shorthands for the cases + that <c>M</c>, <c>N</c>, or both, respectively, are zero. + </p> + <p> Because lists are commonly used, they have shorthand type notations. The type <c>list(T)</c> has the shorthand <c>[T]</c>. The shorthand <c>[T,...]</c> stands for @@ -154,11 +164,17 @@ TList :: Type </p> <table> <row> - <cell><b>Built-in type</b></cell><cell><b>Stands for</b></cell> + <cell><b>Built-in type</b></cell><cell><b>Defined as</b></cell> </row> <row> <cell><c>term()</c></cell><cell><c>any()</c></cell> </row> + <row> + <cell><c>binary()</c></cell><cell><c><<_:*8>></c></cell> + </row> + <row> + <cell><c>bitstring()</c></cell><cell><c><<_:*1>></c></cell> + </row> <row> <cell><c>boolean()</c></cell><cell><c>'false' | 'true'</c></cell> </row> @@ -169,15 +185,6 @@ TList :: Type <cell><c>char()</c></cell><cell><c>0..16#10ffff</c></cell> </row> <row> - <cell><c>non_neg_integer()</c></cell><cell><c>0..</c></cell> - </row> - <row> - <cell><c>pos_integer()</c></cell><cell><c>1..</c></cell> - </row> - <row> - <cell><c>neg_integer()</c></cell><cell><c>..-1</c></cell> - </row> - <row> <cell><c>number()</c></cell><cell><c>integer() | float()</c></cell> </row> <row> @@ -214,35 +221,54 @@ TList :: Type <cell><c>no_return()</c></cell><cell><c>none()</c></cell> </row> </table> + <p> + In addition, the following three built-in types exist and can be + thought as defined below, though strictly their "type definition" is + not valid syntax according to the type language defined above. + </p> + <table> + <row> + <cell><b>Built-in type</b></cell><cell><b>Could be thought defined by the syntax</b></cell> + </row> + <row> + <cell><c>non_neg_integer()</c></cell><cell><c>0..</c></cell> + </row> + <row> + <cell><c>pos_integer()</c></cell><cell><c>1..</c></cell> + </row> + <row> + <cell><c>neg_integer()</c></cell><cell><c>..-1</c></cell> + </row> + </table> <p> Users are not allowed to define types with the same names as the predefined or built-in ones. This is checked by the compiler and its violation results in a compilation error. - (For bootstrapping purposes, it can also result to just a warning if this - involves a built-in type which has just been introduced.) + (For bootstrapping purposes, it can also result to just a warning + if this involves a built-in type which has just been introduced.) </p> <note> The following built-in list types also exist, but they are expected to be rarely used. Hence, they have long names: </note> <pre> -nonempty_maybe_improper_list(Type) :: nonempty_maybe_improper_list(Type, any()) -nonempty_maybe_improper_list() :: nonempty_maybe_improper_list(any())</pre> + nonempty_maybe_improper_list(Type) :: nonempty_maybe_improper_list(Type, any()) + nonempty_maybe_improper_list() :: nonempty_maybe_improper_list(any())</pre> <p> where the following two types define the set of Erlang terms one would expect: </p> <pre> -nonempty_improper_list(Type1, Type2) -nonempty_maybe_improper_list(Type1, Type2)</pre> + nonempty_improper_list(Type1, Type2) + nonempty_maybe_improper_list(Type1, Type2)</pre> <p> Also for convenience, we allow for record notation to be used. Records are just shorthands for the corresponding tuples. </p> <pre> -Record :: #Erlang_Atom{} - | #Erlang_Atom{Fields}</pre> + Record :: #Erlang_Atom{} + | #Erlang_Atom{Fields}</pre> <p> Records have been extended to possibly contain type information. This is described in the sub-section <seealso marker="#typeinrecords">"Type information in record declarations"</seealso> below. @@ -257,8 +283,8 @@ Record :: #Erlang_Atom{} compiler attributes as in the following: </p> <pre> --type my_struct_type() :: Type. --opaque my_opaq_type() :: Type.</pre> + -type my_struct_type() :: Type. + -opaque my_opaq_type() :: Type.</pre> <p> where the type name is an atom (<c>'my_struct_type'</c> in the above) followed by parentheses. Type is a type as defined in the @@ -279,23 +305,23 @@ Record :: #Erlang_Atom{} definition. A concrete example appears below: </p> <pre> --type orddict(Key, Val) :: [{Key, Val}].</pre> + -type orddict(Key, Val) :: [{Key, Val}].</pre> <p> A module can export some types in order to declare that other modules are allowed to refer to them as <em>remote types</em>. This declaration has the following form: <pre> --export_type([T1/A1, ..., Tk/Ak]).</pre> + -export_type([T1/A1, ..., Tk/Ak]).</pre> where the Ti's are atoms (the name of the type) and the Ai's are their arguments. An example is given below: <pre> --export_type([my_struct_type/0, orddict/2]).</pre> + -export_type([my_struct_type/0, orddict/2]).</pre> Assuming that these types are exported from module <c>'mod'</c> then one can refer to them from other modules using remote type expressions like those below: <pre> -mod:my_struct_type() -mod:orddict(atom(), term())</pre> + mod:my_struct_type() + mod:orddict(atom(), term())</pre> One is not allowed to refer to types which are not declared as exported. </p> <p> @@ -317,19 +343,19 @@ mod:orddict(atom(), term())</pre> record. The syntax for this is: </p> <pre> --record(rec, {field1 :: Type1, field2, field3 :: Type3}).</pre> + -record(rec, {field1 :: Type1, field2, field3 :: Type3}).</pre> <p> For fields without type annotations, their type defaults to any(). I.e., the above is a shorthand for: </p> <pre> --record(rec, {field1 :: Type1, field2 :: any(), field3 :: Type3}).</pre> + -record(rec, {field1 :: Type1, field2 :: any(), field3 :: Type3}).</pre> <p> In the presence of initial values for fields, the type must be declared after the initialization as in the following: </p> <pre> --record(rec, {field1 = [] :: Type1, field2, field3 = 42 :: Type3}).</pre> + -record(rec, {field1 = [] :: Type1, field2, field3 = 42 :: Type3}).</pre> <p> Naturally, the initial values for fields should be compatible with (i.e. a member of) the corresponding types. @@ -340,13 +366,13 @@ mod:orddict(atom(), term())</pre> effects: </p> <pre> --record(rec, {f1 = 42 :: integer(), - f2 :: float(), - f3 :: 'a' | 'b'}). + -record(rec, {f1 = 42 :: integer(), + f2 :: float(), + f3 :: 'a' | 'b'}). --record(rec, {f1 = 42 :: integer(), - f2 :: 'undefined' | float(), - f3 :: 'undefined' | 'a' | 'b'}).</pre> + -record(rec, {f1 = 42 :: integer(), + f2 :: 'undefined' | float(), + f3 :: 'undefined' | 'a' | 'b'}).</pre> <p> For this reason, it is recommended that records contain initializers, whenever possible. @@ -355,15 +381,13 @@ mod:orddict(atom(), term())</pre> Any record, containing type information or not, once defined, can be used as a type using the syntax: </p> - <pre> -#rec{}</pre> + <pre> #rec{}</pre> <p> In addition, the record fields can be further specified when using a record type by adding type information about the field in the following manner: </p> - <pre> -#rec{some_field :: Type}</pre> + <pre> #rec{some_field :: Type}</pre> <p> Any unspecified fields are assumed to have the type in the original record declaration. @@ -377,7 +401,7 @@ mod:orddict(atom(), term())</pre> compiler attribute <c>'-spec'</c>. The general format is as follows: </p> <pre> --spec Module:Function(ArgType1, ..., ArgTypeN) -> ReturnType.</pre> + -spec Module:Function(ArgType1, ..., ArgTypeN) -> ReturnType.</pre> <p> The arity of the function has to match the number of arguments, or else a compilation error occurs. @@ -392,19 +416,19 @@ mod:orddict(atom(), term())</pre> For most uses within a given module, the following shorthand suffices: </p> <pre> --spec Function(ArgType1, ..., ArgTypeN) -> ReturnType.</pre> + -spec Function(ArgType1, ..., ArgTypeN) -> ReturnType.</pre> <p> Also, for documentation purposes, argument names can be given: </p> <pre> --spec Function(ArgName1 :: Type1, ..., ArgNameN :: TypeN) -> RT.</pre> + -spec Function(ArgName1 :: Type1, ..., ArgNameN :: TypeN) -> RT.</pre> <p> A function specification can be overloaded. That is, it can have several types, separated by a semicolon (<c>;</c>): </p> <pre> --spec foo(T1, T2) -> T3 - ; (T4, T5) -> T6.</pre> + -spec foo(T1, T2) -> T3 + ; (T4, T5) -> T6.</pre> <p> A current restriction, which currently results in a warning (OBS: not an error) by the compiler, is that the domains of @@ -412,8 +436,8 @@ mod:orddict(atom(), term())</pre> For example, the following specification results in a warning: </p> <pre> --spec foo(pos_integer()) -> pos_integer() - ; (integer()) -> integer().</pre> + -spec foo(pos_integer()) -> pos_integer() + ; (integer()) -> integer().</pre> <p> Type variables can be used in specifications to specify relations for the input and output arguments of a function. @@ -421,47 +445,66 @@ mod:orddict(atom(), term())</pre> polymorphic identity function: </p> <pre> --spec id(X) -> X.</pre> + -spec id(X) -> X.</pre> <p> However, note that the above specification does not restrict the input and output type in any way. - We can constrain these types by guard-like subtype constraints: + We can constrain these types by guard-like subtype constraints + and provide bounded quantification: </p> - <pre> --spec id(X) -> X when is_subtype(X, tuple()).</pre> + <pre> -spec id(X) -> X when X :: tuple().</pre> <p> - or equivalently by the more succinct and more modern form of the above: - </p> - <pre> --spec id(X) -> X when X :: tuple().</pre> - <p> - and provide bounded quantification. Currently, the <c>::</c> constraint - (the <c>is_subtype/2</c> guard) is the only guard constraint which can - be used in the <c>'when'</c> part of a <c>'-spec'</c> attribute. + Currently, the <c>::</c> constraint (read as <c>is_subtype</c>) is + the only guard constraint which can be used in the <c>'when'</c> + part of a <c>'-spec'</c> attribute. </p> + <note> + <p> + The above function specification, using multiple occurrences of + the same type variable, provides more type information than the + function specification below where the type variables are missing: + </p> + <pre> -spec id(tuple()) -> tuple().</pre> + <p> + The latter specification says that the function takes some tuple + and returns some tuple, while the one with the <c>X</c> type + variable specifies that the function takes a tuple and returns + <em>the same</em> tuple. + </p> + <p> + However, it's up to the tools that process the specs to choose + whether to take this extra information into account or ignore it. + </p> + </note> <p> The scope of an <c>::</c> constraint is the <c>(...) -> RetType</c> specification after which it appears. To avoid confusion, we suggest that different variables are used in different - constituents of an overloaded contract as in the example below: + constituents of an overloaded contract as in the example below: </p> <pre> --spec foo({X, integer()}) -> X when X :: atom() - ; ([Y]) -> Y when Y :: number().</pre> + -spec foo({X, integer()}) -> X when X :: atom() + ; ([Y]) -> Y when Y :: number().</pre> + <note> + For backwards compatibility the following form is also allowed: + <pre> -spec id(X) -> X when is_subtype(X, tuple()).</pre> + <p> + but its use is discouraged. It will be taken out in a future + Erlang/OTP release. + </p> + </note> <p> Some functions in Erlang are not meant to return; either because they define servers or because they are used to throw exceptions as the function below: </p> - <pre> -my_error(Err) -> erlang:throw({error, Err}).</pre> + <pre> my_error(Err) -> erlang:throw({error, Err}).</pre> <p> - For such functions we recommend the use of the special no_return() + For such functions we recommend the use of the special <c>no_return()</c> type for their "return", via a contract of the form: </p> - <pre> --spec my_error(term()) -> no_return().</pre> + <pre> -spec my_error(term()) -> no_return().</pre> </section> </chapter> diff --git a/xcomp/erl-xcomp-powerpc64-bgq-linux.conf b/xcomp/erl-xcomp-powerpc64-bgq-linux.conf new file mode 100644 index 0000000000..1c45aaf86b --- /dev/null +++ b/xcomp/erl-xcomp-powerpc64-bgq-linux.conf @@ -0,0 +1,272 @@ +## -*-shell-script-*- +## +## %CopyrightBegin% +## +## Copyright Ericsson AB 2009-2013. 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% +## +## File: erl-xcomp.conf.template +## Author: Rickard Green +## +## ----------------------------------------------------------------------------- +## When cross compiling Erlang/OTP using `otp_build', copy this file and set +## the variables needed below. Then pass the path to the copy of this file as +## an argument to `otp_build' in the configure stage: +## `otp_build configure --xcomp-conf=<FILE>' +## ----------------------------------------------------------------------------- + +## Note that you cannot define arbitrary variables in a cross compilation +## configuration file. Only the ones listed below will be guaranteed to be +## visible throughout the whole execution of all `configure' scripts. Other +## variables needs to be defined as arguments to `configure' or exported in +## the environment. + +## -- Variables for `otp_build' Only ------------------------------------------- + +## Variables in this section are only used, when configuring Erlang/OTP for +## cross compilation using `$ERL_TOP/otp_build configure'. + +## *NOTE*! These variables currently have *no* effect if you configure using +## the `configure' script directly. + +# * `erl_xcomp_build' - The build system used. This value will be passed as +# `--build=$erl_xcomp_build' argument to the `configure' script. It does +# not have to be a full `CPU-VENDOR-OS' triplet, but can be. The full +# `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_build'. If set to `guess', +# the build system will be guessed using +# `$ERL_TOP/erts/autoconf/config.guess'. +erl_xcomp_build=guess + +# * `erl_xcomp_host' - Cross host/target system to build for. This value will +# be passed as `--host=$erl_xcomp_host' argument to the `configure' script. +# It does not have to be a full `CPU-VENDOR-OS' triplet, but can be. The +# full `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_host'. +erl_xcomp_host=powerpc64-bgq-linux + +# * `erl_xcomp_configure_flags' - Extra configure flags to pass to the +# `configure' script. +erl_xcomp_configure_flags="--without-termcap" + +## -- Cross Compiler and Other Tools ------------------------------------------- + +## If the cross compilation tools are prefixed by `<HOST>-' you probably do +## not need to set these variables (where `<HOST>' is what has been passed as +## `--host=<HOST>' argument to `configure'). + +## This path should really be part of the user's PATH environment, but +## since it is highly unlikely that it will differ between Blue Gene/Q +## installations, the path is hard-coded here for convenience. +TOP_BIN=/bgsys/drivers/ppcfloor/gnu-linux/bin + +## All variables in this section can also be used when native compiling. + +# * `CC' - C compiler. +CC=${TOP_BIN}/${erl_xcomp_host}-gcc + +# * `CFLAGS' - C compiler flags. +#CFLAGS= + +# * `STATIC_CFLAGS' - Static C compiler flags. +#STATIC_CFLAGS= + +# * `CFLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for the shared libraries. Note that this actually is a +# linker flag, but it needs to be passed via the compiler. +#CFLAG_RUNTIME_LIBRARY_PATH= + +# * `CPP' - C pre-processor. +#CPP= + +# * `CPPFLAGS' - C pre-processor flags. +#CPPFLAGS= + +# * `CXX' - C++ compiler. +CXX=${TOP_BIN}/${erl_xcomp_host}-g++ + +# * `CXXFLAGS' - C++ compiler flags. +#CXXFLAGS= + +# * `LD' - Linker. +LD=${TOP_BIN}/${erl_xcomp_host}-ld + +# * `LDFLAGS' - Linker flags. +#LDFLAGS= + +# * `LIBS' - Libraries. +#LIBS= + +## -- *D*ynamic *E*rlang *D*river Linking -- + +## *NOTE*! Either set all or none of the `DED_LD*' variables. + +# * `DED_LD' - Linker for Dynamically loaded Erlang Drivers. +#DED_LD= + +# * `DED_LDFLAGS' - Linker flags to use with `DED_LD'. +#DED_LDFLAGS= + +# * `DED_LD_FLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for shared libraries when linking with `DED_LD'. +#DED_LD_FLAG_RUNTIME_LIBRARY_PATH= + +## -- Large File Support -- + +## *NOTE*! Either set all or none of the `LFS_*' variables. + +# * `LFS_CFLAGS' - Large file support C compiler flags. +#LFS_CFLAGS= + +# * `LFS_LDFLAGS' - Large file support linker flags. +#LFS_LDFLAGS= + +# * `LFS_LIBS' - Large file support libraries. +#LFS_LIBS= + +## -- Other Tools -- + +# * `RANLIB' - `ranlib' archive index tool. +RANLIB=${TOP_BIN}/${erl_xcomp_host}-ranlib + +# * `AR' - `ar' archiving tool. +AR=${TOP_BIN}/${erl_xcomp_host}-ar + +# * `GETCONF' - `getconf' system configuration inspection tool. `getconf' is +# currently used for finding out large file support flags to use, and +# on Linux systems for finding out if we have an NPTL thread library or +# not. +#GETCONF= + +## -- Cross System Root Locations ---------------------------------------------- + +# * `erl_xcomp_sysroot' - The absolute path to the system root of the cross +# compilation environment. Currently, the `crypto', `odbc', `ssh' and +# `ssl' applications need the system root. These applications will be +# skipped if the system root has not been set. The system root might be +# needed for other things too. If this is the case and the system root +# has not been set, `configure' will fail and request you to set it. +#erl_xcomp_sysroot= + +# * `erl_xcomp_isysroot' - The absolute path to the system root for includes +# of the cross compilation environment. If not set, this value defaults +# to `$erl_xcomp_sysroot', i.e., only set this value if the include system +# root path is not the same as the system root path. +#erl_xcomp_isysroot= + +## -- Optional Feature, and Bug Tests ------------------------------------------ + +## These tests cannot (always) be done automatically when cross compiling. You +## usually do not need to set these variables. Only set these if you really +## know what you are doing. + +## Note that some of these values will override results of tests performed +## by `configure', and some will not be used until `configure' is sure that +## it cannot figure the result out. + +## The `configure' script will issue a warning when a default value is used. +## When a variable has been set, no warning will be issued. + +# * `erl_xcomp_after_morecore_hook' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `__after_morecore_hook' that can be +# used for tracking used `malloc()' implementations core memory usage. +# This is currently only used by unsupported features. +#erl_xcomp_after_morecore_hook= + +# * `erl_xcomp_bigendian' - `yes|no'. No default. If `yes', the target system +# must be big endian. If `no', little endian. This can often be +# automatically detected, but not always. If not automatically detected, +# `configure' will fail unless this variable is set. Since no default +# value is used, `configure' will try to figure this out automatically. +#erl_xcomp_bigendian= + +# * `erl_xcomp_double_middle` - `yes|no`. No default. If `yes`, the +# target system must have doubles in "middle-endian" format. If +# `no`, it has "regular" endianness. This can often be automatically +# detected, but not always. If not automatically detected, +# `configure` will fail unless this variable is set. Since no +# default value is used, `configure` will try to figure this out +# automatically. +#erl_xcomp_double_middle_endian + +# * `erl_xcomp_clock_gettime_cpu_time' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `clock_gettime()' implementation +# that can be used for retrieving process CPU time. +#erl_xcomp_clock_gettime_cpu_time= + +# * `erl_xcomp_getaddrinfo' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `getaddrinfo()' implementation that can +# handle both IPv4 and IPv6. +#erl_xcomp_getaddrinfo= + +# * `erl_xcomp_gethrvtime_procfs_ioctl' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `gethrvtime()' implementation and +# is used with procfs `ioctl()'. +#erl_xcomp_gethrvtime_procfs_ioctl= + +# * `erl_xcomp_dlsym_brk_wrappers' - `yes|no'. Defaults to `no'. If `yes', the +# target system must have a working `dlsym(RTLD_NEXT, <S>)' implementation +# that can be used on `brk' and `sbrk' symbols used by the `malloc()' +# implementation in use, and by this track the `malloc()' implementations +# core memory usage. This is currently only used by unsupported features. +#erl_xcomp_dlsym_brk_wrappers= + +# * `erl_xcomp_kqueue' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `kqueue()' implementation that returns a file +# descriptor which can be used by `poll()' and/or `select()'. If `no' and +# the target system has not got `epoll()' or `/dev/poll', the kernel-poll +# feature will be disabled. +#erl_xcomp_kqueue= + +# * `erl_xcomp_linux_clock_gettime_correction' - `yes|no'. Defaults to `yes' on +# Linux; otherwise, `no'. If `yes', `clock_gettime(CLOCK_MONOTONIC, _)' on +# the target system must work. This variable is recommended to be set to +# `no' on Linux systems with kernel versions less than 2.6. +#erl_xcomp_linux_clock_gettime_correction= + +# * `erl_xcomp_linux_nptl' - `yes|no'. Defaults to `yes' on Linux; otherwise, +# `no'. If `yes', the target system must have NPTL (Native POSIX Thread +# Library). Older Linux systems have LinuxThreads instead of NPTL (Linux +# kernel versions typically less than 2.6). +#erl_xcomp_linux_nptl= + +# * `erl_xcomp_linux_usable_sigaltstack' - `yes|no'. Defaults to `yes' on Linux; +# otherwise, `no'. If `yes', `sigaltstack()' must be usable on the target +# system. `sigaltstack()' on Linux kernel versions less than 2.4 are +# broken. +#erl_xcomp_linux_usable_sigaltstack= + +# * `erl_xcomp_linux_usable_sigusrx' - `yes|no'. Defaults to `yes'. If `yes', +# the `SIGUSR1' and `SIGUSR2' signals must be usable by the ERTS. Old +# LinuxThreads thread libraries (Linux kernel versions typically less than +# 2.2) used these signals and made them unusable by the ERTS. +#erl_xcomp_linux_usable_sigusrx= + +# * `erl_xcomp_poll' - `yes|no'. Defaults to `no' on Darwin/MacOSX; otherwise, +# `yes'. If `yes', the target system must have a working `poll()' +# implementation that also can handle devices. If `no', `select()' will be +# used instead of `poll()'. +#erl_xcomp_poll= + +# * `erl_xcomp_putenv_copy' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a `putenv()' implementation that stores a copy of the +# key/value pair. +#erl_xcomp_putenv_copy= + +# * `erl_xcomp_reliable_fpe' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have reliable floating point exceptions. +#erl_xcomp_reliable_fpe= + +## ----------------------------------------------------------------------------- |
