diff options
Diffstat (limited to 'lib')
689 files changed, 22082 insertions, 27004 deletions
diff --git a/lib/Makefile b/lib/Makefile index 98d746925f..7e52d6e32e 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -33,20 +33,6 @@ ifeq ($(findstring vxworks,$(TARGET)),vxworks) cosFileTransfer cosEventDomain endif else - ifeq ($(findstring ose,$(TARGET)),ose) - ERTS_SUB_DIRECTORIES = stdlib sasl kernel compiler erl_interface - OTHER_SUB_DIRECTORIES = \ - snmp otp_mibs appmon tools -# OTHER_SUB_DIRECTORIES = \ -# appmon os_mon tools runtime_tools - ifdef BUILD_ALL - OTHER_SUB_DIRECTORIES += mnesia \ - inets pman tv observer -# OTHER_SUB_DIRECTORIES += mnesia ic asn1 debugger \ -# inets orber pman tv observer cosTransactions cosEvent \ -# cosTime cosNotification cosProperty cosFileTransfer cosEventDomain - endif - else # # unix and win32 # -------------- @@ -59,10 +45,11 @@ else snmp otp_mibs appmon erl_interface asn1 jinterface gs wx inets ic \ mnesia crypto orber os_mon parsetools syntax_tools pman \ public_key ssl toolbar tv observer debugger reltool odbc \ - runtime_tools diameter \ + diameter \ cosTransactions cosEvent cosTime cosNotification cosProperty \ cosFileTransfer cosEventDomain et megaco webtool \ - xmerl edoc eunit ssh inviso typer docbuilder erl_docgen common_test percept + xmerl edoc eunit ssh inviso typer docbuilder erl_docgen \ + common_test percept dialyzer # dialyzer OTHER_SUB_DIRECTORIES += hipe else # BUILD_ALL on unix @@ -70,15 +57,15 @@ else snmp otp_mibs appmon erl_interface asn1 jinterface wx debugger reltool gs inets \ ic mnesia crypto orber os_mon parsetools syntax_tools \ pman public_key ssl toolbar tv observer odbc \ - runtime_tools diameter \ + diameter \ cosTransactions cosEvent cosTime cosNotification \ cosProperty cosFileTransfer cosEventDomain et megaco webtool \ - xmerl edoc eunit ssh inviso typer docbuilder erl_docgen common_test percept + xmerl edoc eunit ssh inviso typer docbuilder erl_docgen \ + common_test percept dialyzer # dialyzer OTHER_SUB_DIRECTORIES += hipe $(TSP_APP) endif endif - endif endif ifdef BOOTSTRAP diff --git a/lib/appmon/doc/src/make.dep b/lib/appmon/doc/src/make.dep deleted file mode 100644 index ce0d7571a3..0000000000 --- a/lib/appmon/doc/src/make.dep +++ /dev/null @@ -1,26 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: appmon.tex appmon_chapter.tex book.tex part.tex \ - ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: app_win.ps listbox_win.ps main_win.ps pinfo_win.ps - diff --git a/lib/appmon/src/appmon_web.erl b/lib/appmon/src/appmon_web.erl index fb7144246c..7c0451c3c3 100644 --- a/lib/appmon/src/appmon_web.erl +++ b/lib/appmon/src/appmon_web.erl @@ -578,9 +578,9 @@ htmlify_pid([],New)-> %% the HTTP protocol %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% urlify_pid(Pid) -> - case regexp:first_match(Pid,"[<].*[>]") of - {match,Start,Len}-> - "%3C"++string:substr(Pid,Start+1,Len-2)++"%3E"; + case re:run(Pid,"[<](.*)[>]",[{capture,all_but_first,list}]) of + {match,[PidStr]}-> + "%3C"++PidStr++"%3E"; _-> Pid end. diff --git a/lib/asn1/c_src/Makefile b/lib/asn1/c_src/Makefile index 9e9cb18524..8c06be56f8 100644 --- a/lib/asn1/c_src/Makefile +++ b/lib/asn1/c_src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2010. All Rights Reserved. +# Copyright Ericsson AB 2002-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 @@ -51,33 +51,26 @@ EI_LIBDIR = $(ERL_TOP)/lib/erl_interface/obj$(TYPEMARKER)/$(TARGET) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -EI_INCLUDES = -I$(ERL_TOP)/lib/erl_interface/include CFLAGS = $(DED_INCLUDES) $(EI_INCLUDES) $(DED_CFLAGS) LDFLAGS += $(DED_LDFLAGS) -LD_INCL_EI = -L$(EI_LIBDIR) - # ---------------------------------------------------- # Target Specs # ---------------------------------------------------- -C_FILES = asn1_erl_driver.c +NIF_OBJ_FILES = $(OBJDIR)/asn1_erl_nif.o ifeq ($(TARGET),win32) -LD_EI = -lei_md -SHARED_OBJ_FILES = $(LIBDIR)/asn1_erl_drv.dll -OBJ_FILES = $(OBJDIR)/asn1_erl_drv.o +NIF_SHARED_OBJ_FILE = $(LIBDIR)/asn1_erl_nif.dll CLIB_FLAGS = LN=cp else -LD_EI = -lei -OBJ_FILES = $(OBJDIR)/asn1_erl_drv.o ifeq ($(findstring vxworks,$(TARGET)),vxworks) -SHARED_OBJ_FILES = $(LIBDIR)/asn1_erl_drv.eld +NIF_SHARED_OBJ_FILE = $(LIBDIR)/asn1_erl_nif.eld CLIB_FLAGS = else -SHARED_OBJ_FILES = $(LIBDIR)/asn1_erl_drv.so +NIF_SHARED_OBJ_FILE = $(LIBDIR)/asn1_erl_nif.so CLIB_FLAGS = -lc endif LN= ln -s @@ -87,7 +80,9 @@ endif # Targets # ---------------------------------------------------- -opt: $(OBJDIR) $(LIBDIR) $(SHARED_OBJ_FILES) +_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) + +opt: $(NIF_SHARED_OBJ_FILE) debug: opt @@ -103,20 +98,12 @@ docs: # ---------------------------------------------------- -$(OBJ_FILES): $(C_FILES) - $(CC) -c $(CFLAGS) -o $(OBJ_FILES) $(C_FILES) - -$(SHARED_OBJ_FILES): $(OBJ_FILES) - $(LD) $(LDFLAGS) $(LD_INCL_EI) -o $(SHARED_OBJ_FILES) $(OBJ_FILES) $(LD_EI) $(CLIB_FLAGS) $(LIBS) - -$(LIBDIR): - -mkdir -p $(LIBDIR) - -$(OBJDIR): - -mkdir -p $(OBJDIR) +$(OBJDIR)/%.o: %.c + $(CC) -c $(CFLAGS) -O3 -o $@ $< +$(NIF_SHARED_OBJ_FILE): $(NIF_OBJ_FILES) + $(LD) $(LDFLAGS) -o $(NIF_SHARED_OBJ_FILE) $(NIF_OBJ_FILES) $(CLIB_FLAGS) $(LIBS) - # ---------------------------------------------------- # Release Target # ---------------------------------------------------- @@ -124,9 +111,9 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/priv/lib - $(INSTALL_PROGRAM) $(SHARED_OBJ_FILES) $(RELSYSDIR)/priv/lib + $(INSTALL_PROGRAM) $(NIF_SHARED_OBJ_FILE) $(RELSYSDIR)/priv/lib $(INSTALL_DIR) $(RELSYSDIR)/c_src - $(INSTALL_DATA) $(C_FILES) $(RELSYSDIR)/c_src + $(INSTALL_DATA) *.c $(RELSYSDIR)/c_src release_docs_spec: diff --git a/lib/asn1/c_src/asn1_erl_driver.c b/lib/asn1/c_src/asn1_erl_driver.c deleted file mode 100644 index 18d4157941..0000000000 --- a/lib/asn1/c_src/asn1_erl_driver.c +++ /dev/null @@ -1,1677 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2002-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% - * - */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include "erl_driver.h" -#include "ei.h" - - -/* #define ASN1_DEBUG 1 */ - -#define ASN1_OK 0 -#define ASN1_ERROR -1 -#define ASN1_COMPL_ERROR 1 -#define ASN1_MEMORY_ERROR 0 -#define ASN1_DECODE_ERROR 2 -#define ASN1_TAG_ERROR -3 -#define ASN1_LEN_ERROR -4 -#define ASN1_INDEF_LEN_ERROR -5 -#define ASN1_VALUE_ERROR -6 - - -#define ASN1_CLASS 0xc0 -#define ASN1_FORM 0x20 -#define ASN1_CLASSFORM (ASN1_CLASS | ASN1_FORM) -#define ASN1_TAG 0x1f -#define ASN1_LONG_TAG 0x7f - -#define ASN1_INDEFINITE_LENGTH 0x80 -#define ASN1_SHORT_DEFINITE_LENGTH 0 - -#define ASN1_PRIMITIVE 0 -#define ASN1_CONSTRUCTED 0x20 - -#define ASN1_COMPLETE 1 -#define ASN1_BER_TLV_DECODE 2 -#define ASN1_BER_TLV_PARTIAL_DECODE 3 - -#define ASN1_NOVALUE 0 - -#define ASN1_SKIPPED 0 -#define ASN1_OPTIONAL 1 -#define ASN1_CHOOSEN 2 - - -#define CEIL(X,Y) ((X-1) / Y + 1) - -#define INVMASK(X,M) (X & (M ^ 0xff)) -#define MASK(X,M) (X & M) - -typedef struct { - ErlDrvPort port; - int buffer_size; -} asn1_data; - -/* int min_alloc_bytes; */ - - -static ErlDrvData asn1_drv_start(ErlDrvPort, char *); - -static void asn1_drv_stop(ErlDrvData); - -int asn1_drv_control(ErlDrvData, unsigned int, char *, int, char **, int); - -int complete(ErlDrvBinary **,unsigned char *,unsigned char *, int); - -int insert_octets(int, unsigned char **, unsigned char **, int *); - -int insert_octets_except_unused(int, unsigned char **, unsigned char **, - int *, int); - -int insert_octets_as_bits_exact_len(int, int, unsigned char **, - unsigned char **, int *); - -int insert_octets_as_bits(int, unsigned char **, unsigned char **,int *); - -int pad_bits(int, unsigned char **, int *); - -int insert_least_sign_bits(int, unsigned char, unsigned char **, int *); - -int insert_most_sign_bits(int, unsigned char, unsigned char **, int *); - -int insert_bits_as_bits(int, int, unsigned char **, unsigned char **, int *); - -int insert_octets_unaligned(int, unsigned char **, unsigned char **, int); - -int realloc_decode_buf(ErlDrvBinary **,int); - -int realloc_memory(ErlDrvBinary **,int,unsigned char **,unsigned char **); - -int decode_begin(ErlDrvBinary **,unsigned char *, int, unsigned int *); - -int decode(ErlDrvBinary **,int *,unsigned char *,int *, int); - -int decode_tag(char *,int *,unsigned char *,int,int *); - -int decode_value(int *,unsigned char *,int *,ErlDrvBinary **,int ,int); - - -/* declaration of functions used for partial decode of a BER encoded - message */ - -int decode_partial(ErlDrvBinary **,unsigned char *, int); - -int skip_tag(unsigned char *,int *,int); - -int skip_length_and_value(unsigned char *,int *,int); - -int get_tag(unsigned char *,int *,int); - -int get_length(unsigned char *,int *,int *,int); - -int get_value(char *,unsigned char *,int *,int); - -static ErlDrvEntry asn1_drv_entry = { - NULL, /* init, always NULL for dynamic drivers */ - asn1_drv_start, /* start, called when port is opened */ - asn1_drv_stop, /* stop, called when port is closed */ - NULL, /* output, called when erlang has sent */ - NULL, /* ready_input, called when input descriptor ready */ - NULL, /* ready_output, called when output descriptor ready */ - "asn1_erl_drv", /* char *driver_name, the argument to open_port */ - NULL, /* finish, called when unloaded */ - NULL, /* void * that is not used (BC) */ - asn1_drv_control, /* control, port_control callback */ - NULL, /* timeout, called on timeouts */ - NULL, /* outputv, vector output interface */ - - 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 /* process_exit */ -}; - - - -DRIVER_INIT(asn1_erl_drv) /* must match name in driver_entry */ -{ - return &asn1_drv_entry; -} - -static ErlDrvData asn1_drv_start(ErlDrvPort port, char *buff) -{ - /* extern int min_alloc_bytes; */ - char *ptr; - asn1_data* d; - - d = (asn1_data*)driver_alloc(sizeof(asn1_data)); - set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY); - d->port = port; - - if ((ptr = getenv("ASN1_MIN_BUF_SIZE")) == NULL) - d->buffer_size = 1024; - else - d->buffer_size = atoi(ptr); - return (ErlDrvData)d; -} - - -static void asn1_drv_stop(ErlDrvData handle) -{ - driver_free((char*)handle); -} - - - -int asn1_drv_control(ErlDrvData handle, - unsigned int command, - char *buf, - int buf_len, - char **res_buf, - int res_buf_len) -{ - unsigned char *complete_buf; - int complete_len, decode_len; - ErlDrvBinary *drv_binary; - ErlDrvBinary **drv_bin_ptr; - asn1_data* a_data; - int min_alloc_bytes; - unsigned int err_pos = 0; /* in case of error, return last correct position */ - int ret_err; /* return value in case of error in TLV decode, i.e. length of list in res_buf */ - - /* In case previous call to asn1_drv_control resulted in a change of - return value from binary to integer list */ - a_data = (asn1_data *)handle; - min_alloc_bytes = a_data->buffer_size; - set_port_control_flags(a_data->port, PORT_CONTROL_FLAG_BINARY); - - if (command == ASN1_COMPLETE) - { - if (buf_len==0) { - return 0; /* Avoid binary buffer overwrite (OTP-8451) */ - } - /* Do the PER complete encode step */ - if ((drv_binary = driver_alloc_binary(buf_len))==NULL) { - /* error handling */ - set_port_control_flags(a_data->port, 0); - return ASN1_MEMORY_ERROR; - } - complete_buf = (unsigned char*) drv_binary->orig_bytes; - if ((complete_len = complete(&drv_binary,complete_buf,(unsigned char*) buf,buf_len)) == ASN1_ERROR) - { - /* error handling due to failure in complete */ - /* printf("error when running complete\n\r"); */ - driver_free_binary(drv_binary); - set_port_control_flags(a_data->port, 0); - **res_buf = '1'; - return ASN1_COMPL_ERROR; - } - /* printf("complete_len=%dbuf_len=%d,orig_size=%d\n\r",complete_len,buf_len,drv_binary->orig_size); */ - /* now the message is complete packed, return to Erlang */ - /* if (complete_len < buf_len) {*/ - if (complete_len < drv_binary->orig_size) { - ErlDrvBinary *tmp; - if ((tmp=driver_realloc_binary(drv_binary,complete_len)) == NULL){ - /*error handling due to memory allocation failure */ - driver_free_binary(drv_binary); - set_port_control_flags(a_data->port, 0); - return ASN1_MEMORY_ERROR; - }else - drv_binary=tmp; - } - *res_buf = (char *)drv_binary; - return complete_len; - } else if (command == ASN1_BER_TLV_DECODE) { /* control == 2 */ - /* Do the tlv decode, - return the resulting term encoded on the Erlang - external format */ -/* printf("driver: buffer_len = %d, min_alloc_bytes = %d\r\n",buf_len,min_alloc_bytes); */ - if ((drv_binary = driver_alloc_binary((buf_len*5)+min_alloc_bytes))==NULL) { - /* error handling */ - set_port_control_flags(a_data->port, 0); - return ASN1_MEMORY_ERROR; - } - drv_bin_ptr = &drv_binary; - if ((decode_len = decode_begin(drv_bin_ptr,(unsigned char*)buf,buf_len,&err_pos)) <= ASN1_ERROR) - { - /* error handling due to failure in decode */ - char tmp_res_buf[5]; - driver_free_binary(*drv_bin_ptr); - set_port_control_flags(a_data->port, 0); - - if(decode_len==ASN1_ERROR) - tmp_res_buf[0]='1'; - else if(decode_len==ASN1_TAG_ERROR) - tmp_res_buf[0]='2'; - else if(decode_len==ASN1_LEN_ERROR) - tmp_res_buf[0]='3'; - else if(decode_len==ASN1_INDEF_LEN_ERROR) - tmp_res_buf[0]='4'; - else if(decode_len==ASN1_VALUE_ERROR) - tmp_res_buf[0]='5'; -/* printf("err_pos=%d\r\n",err_pos); */ -/* printf("decode_len:%d\r\n",decode_len); */ - ret_err = 1; - while(err_pos>0){ - tmp_res_buf[ret_err] =(char)err_pos;/* c;*/ - err_pos = err_pos >> 8; - ret_err++; - } - strncpy(*res_buf,tmp_res_buf,ret_err); - return ret_err; - } -/* printf("decode_len=%d\r\n",decode_len); */ - if (decode_len < ((buf_len * 5) + min_alloc_bytes)) { - /* not all memory was used => we have to reallocate */ - ErlDrvBinary *tmp; - if ((tmp=driver_realloc_binary(*drv_bin_ptr,decode_len)) == NULL){ - /*error handling due to memory allocation failure */ - driver_free_binary(*drv_bin_ptr); - set_port_control_flags(a_data->port, 0); - return ASN1_MEMORY_ERROR; - }else - *drv_bin_ptr=tmp; - } - *res_buf = (char *)(*drv_bin_ptr); - return decode_len; - } else { /*command == ASN1_BER_TLV_PARTIAL_DECODE */ - if ((drv_binary = driver_alloc_binary(buf_len))==NULL) { - /* error handling */ - set_port_control_flags(a_data->port, 0); - return ASN1_MEMORY_ERROR; - } - drv_bin_ptr = &drv_binary; - if ((decode_len = decode_partial(drv_bin_ptr,(unsigned char*)buf,buf_len)) - <= ASN1_ERROR) { - /* error handling due to failure in decode */ - driver_free_binary(*drv_bin_ptr); - set_port_control_flags(a_data->port, 0); - -/* printf("asn1_drv_control 1: decode_len=%d\r\n",decode_len); */ - - if(decode_len==ASN1_ERROR) - **res_buf = '1'; - return ASN1_DECODE_ERROR; - } - if (decode_len < buf_len) { - /* not all memory was used => we have to reallocate */ - ErlDrvBinary *tmp; -/* printf("asn1_drv_control 2: decode_len=%d\r\n",decode_len); */ - if ((tmp=driver_realloc_binary(*drv_bin_ptr,decode_len)) == NULL){ - /*error handling due to memory allocation failure */ - driver_free_binary(*drv_bin_ptr); - set_port_control_flags(a_data->port, 0); - return ASN1_MEMORY_ERROR; - }else - *drv_bin_ptr=tmp; - } - *res_buf = (char *)(*drv_bin_ptr); - return decode_len; - } -} - - - -/* - * - * This section defines functionality for the complete encode of a - * PER encoded message - * - */ - -int complete(ErlDrvBinary **drv_binary,unsigned char *complete_buf, - unsigned char *in_buf, int in_buf_len) -{ - int counter = in_buf_len; - /* counter keeps track of number of bytes left in the - input buffer */ - - int buf_space = in_buf_len; - /* This is the amount of allocated space left of the complete_buf. It - is possible when padding is applied that more space is needed than - was originally allocated. */ - - int buf_size = in_buf_len; - /* Size of the buffer. May become reallocated and thus other than - in_buf_len */ - - unsigned char *in_ptr, *ptr; - /* in_ptr points at the next byte in in_buf to be moved to - complete_buf. - ptr points into the new completed buffer, complete_buf, at the - position of the next byte that will be set */ - int unused = 8; - /* unused = [1,...,8] indicates how many of the rigthmost bits of - the byte that ptr points at that are unassigned */ - - int no_bits,no_bytes,in_unused,desired_len,ret, saved_mem, needed, pad_bits; - - unsigned char val; - - in_ptr = in_buf; - ptr = complete_buf; - *ptr = 0x00; - while(counter > 0) { - counter--; -/* printf("*in_ptr = %d\n\r",*in_ptr); */ - switch (*in_ptr) { - case 0: - /* just one zero-bit should be added to the buffer */ - if(unused == 1){ - unused = 8; - *++ptr = 0x00; - buf_space--; - } else - unused--; - break; - - case 1: - /* one one-bit should be added to the buffer */ - if(unused == 1){ - *ptr = *ptr | 1; - unused = 8; - *++ptr = 0x00; - buf_space--; - } else { - *ptr = *ptr | (1 << (unused - 1)); - unused--; - } - break; - - case 2: - /* align buffer to end of byte */ - if (unused != 8) { - *++ptr = 0x00; - buf_space--; - unused = 8; - } - break; - - case 10: - /* next byte in in_buf tells how many bits in the second next - byte that will be used */ - /* The leftmost unused bits in the value byte are supposed to be - zero bits */ - no_bits = (int)*(++in_ptr); - val = *(++in_ptr); - counter -= 2; - if ((ret=insert_least_sign_bits(no_bits,val,&ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 20: - /* in this case the next value in_ptr points at holds the number - of following bytes that holds the value that will be inserted - in the completed buffer */ - no_bytes = (int)*(++in_ptr); - counter -= (no_bytes + 1); - if ((counter<0) || - (ret=insert_octets(no_bytes,&in_ptr,&ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 21: - /* in this case the next two bytes in_ptr points at holds the number - of following bytes that holds the value that will be inserted - in the completed buffer */ - no_bytes = (int)*(++in_ptr); - no_bytes = no_bytes << 8; - no_bytes = no_bytes | (int)*(++in_ptr); - counter -= (2 + no_bytes); - if ((counter<0) || - (ret=insert_octets(no_bytes,&in_ptr,&ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 30: - /* If we call the following bytes, in the buffer in_ptr points at, - By1,By2,Rest then Rest is the value that will be transfered to - the completed buffer. By1 tells how many of the rightmost bits in - Rest that should not be used. By2 is the length of Rest in bytes.*/ - in_unused = (int)*(++in_ptr); - no_bytes = (int)*(++in_ptr); - counter -= (2 + no_bytes); -/* printf("%d: case 30: in_unused=%d, no_bytes=%d,counter=%d\n\r",__LINE__,in_unused,no_bytes,counter); */ - ret = -4711; - if ((counter<0) || - (ret=insert_octets_except_unused(no_bytes,&in_ptr,&ptr,&unused,in_unused)) == ASN1_ERROR) - return ASN1_ERROR; -/* printf("%d: ret=%d\n\r",__LINE__, ret); */ - buf_space -= ret; - break; - - case 31: - /* If we call the following bytes, in the buffer in_ptr points at, - By1,By2,By3,Rest then Rest is the value that will be transfered to - the completed buffer. By1 tells how many of the rightmost bits in - Rest that should not be used. By2 and By3 is the length of - Rest in bytes.*/ - in_unused = (int)*(++in_ptr); - no_bytes = (int)*(++in_ptr); - no_bytes = no_bytes << 8; - no_bytes = no_bytes | (int)*(++in_ptr); - counter -= (3 + no_bytes); - if ((counter<0) || - (ret=insert_octets_except_unused(no_bytes,&in_ptr,&ptr,&unused,in_unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 40: - /* This case implies that next byte,By1,(..,By1,By2,Bin,...) - is the desired length of the completed value, maybe needs - padding zero bits or removal of trailing zero bits from Bin. - By2 is the length of Bin and Bin is the value that will be - put into the completed buffer. Each byte in Bin has the value - 1 or 0.*/ - desired_len = (int)*(++in_ptr); - no_bytes=(int)*(++in_ptr); - - /* This is the algorithm for need of memory reallocation: - Only when padding (cases 40 - 43,45 - 47) more memory may be - used than allocated. Therefore one has to keep track of how - much of the allocated memory that has been saved, i.e. the - difference between the number of parsed bytes of the input buffer - and the number of used bytes of the output buffer. - If saved memory is less than needed for the padding then we - need more memory. */ - saved_mem = buf_space - counter; - pad_bits = desired_len - no_bytes - unused; - needed = (pad_bits > 0) ? CEIL(pad_bits,8) : 0; - if (saved_mem < needed) { - /* Have to allocate more memory */ - buf_size += needed; - buf_space += needed; - if (realloc_memory(drv_binary,buf_size,&ptr, - &complete_buf) == ASN1_ERROR) - return ASN1_ERROR; - } - - counter -= (2 + no_bytes); - if ((counter<0) || - (ret=insert_octets_as_bits_exact_len(desired_len,no_bytes,&in_ptr, - &ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 41: - /* Same as case 40 apart from By2, the length of Bin, which is in - two bytes*/ - desired_len = (int)*(++in_ptr); - no_bytes=(int)*(++in_ptr); - no_bytes = no_bytes << 8; - no_bytes = no_bytes | (int)*(++in_ptr); - - saved_mem = buf_space - counter; - needed = CEIL((desired_len-unused),8) - no_bytes; - if (saved_mem < needed) { - /* Have to allocate more memory */ - buf_size += needed; - buf_space += needed; - if (realloc_memory(drv_binary,buf_size,&ptr, - &complete_buf) == ASN1_ERROR) - return ASN1_ERROR; - } - - counter -= (3 + no_bytes); - if ((counter<0) || - (ret=insert_octets_as_bits_exact_len(desired_len,no_bytes,&in_ptr, - &ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 42: - /* Same as case 40 apart from By1, the desired length, which is in - two bytes*/ - desired_len = (int)*(++in_ptr); - desired_len = desired_len << 8; - desired_len = desired_len | (int)*(++in_ptr); - no_bytes=(int)*(++in_ptr); - - saved_mem = buf_space - counter; - needed = CEIL((desired_len-unused),8) - no_bytes; - if (saved_mem < needed) { - /* Have to allocate more memory */ - buf_size += needed; - buf_space += needed; - if (realloc_memory(drv_binary,buf_size,&ptr, - &complete_buf) == ASN1_ERROR) - return ASN1_ERROR; - } - - counter -= (3 + no_bytes); - if ((counter<0) || - (ret=insert_octets_as_bits_exact_len(desired_len,no_bytes,&in_ptr, - &ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 43: - /* Same as case 40 apart from By1 and By2, the desired length and - the length of Bin, which are in two bytes each. */ - desired_len = (int)*(++in_ptr); - desired_len = desired_len << 8; - desired_len = desired_len | (int)*(++in_ptr); - no_bytes=(int)*(++in_ptr); - no_bytes = no_bytes << 8; - no_bytes = no_bytes | (int)*(++in_ptr); - - saved_mem = buf_space - counter; - needed = CEIL((desired_len-unused),8) - no_bytes; - if (saved_mem < needed) { - /* Have to allocate more memory */ - buf_size += needed; - buf_space += needed; - if (realloc_memory(drv_binary,buf_size,&ptr, - &complete_buf) == ASN1_ERROR) - return ASN1_ERROR; - } - - counter -= (4 + no_bytes); - if ((counter<0) || - (ret=insert_octets_as_bits_exact_len(desired_len,no_bytes,&in_ptr, - &ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 45: - /* This case assumes that the following bytes in the incoming buffer - (called By1,By2,Bin) is By1, which is the number of bits (n) that - will be inserted in the completed buffer. By2 is the number of - bytes in Bin. Each bit in the buffer Bin should be inserted from - the leftmost until the nth.*/ - desired_len = (int)*(++in_ptr); - no_bytes=(int)*(++in_ptr); - - saved_mem = buf_space - counter; - needed = CEIL((desired_len-unused),8) - no_bytes; -/* printf("buf_space=%d, counter=%d, needed=%d",buf_space,counter,needed); */ - if (saved_mem < needed) { - /* Have to allocate more memory */ - buf_size += needed; - buf_space += needed; - if (realloc_memory(drv_binary,buf_size,&ptr, - &complete_buf) == ASN1_ERROR) - return ASN1_ERROR; - } - - counter -= (2 + no_bytes); -/* printf("calling insert_bits_as_bits: desired_len=%d, no_bytes=%d\n\r",desired_len,no_bytes); */ -/* printf("1in_ptr=%d\n\r",in_ptr); */ - - if((counter<0) || - (ret=insert_bits_as_bits(desired_len,no_bytes,&in_ptr, - &ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; -/* printf("2in_ptr=%d, ptr=%d, complete_buf=%d\n\r",in_ptr,ptr,complete_buf); */ -/* printf("buf_space=%d, ret=%d, counter=%d\n\r",buf_space,ret,counter); */ - buf_space -= ret; - break; - - case 46: - /* Same as case 45 apart from By1, the desired length, which is - in two bytes. */ - desired_len = (int)*(++in_ptr); - desired_len = desired_len << 8; - desired_len = desired_len | (int)*(++in_ptr); - no_bytes=(int)*(++in_ptr); - - saved_mem = buf_space - counter; - needed = CEIL((desired_len-unused),8) - no_bytes; - if (saved_mem < needed) { - /* Have to allocate more memory */ - buf_size += needed; - buf_space += needed; - if (realloc_memory(drv_binary,buf_size,&ptr, - &complete_buf) == ASN1_ERROR) - return ASN1_ERROR; - } - - counter -= (3 + no_bytes); - if((counter<0) || - (ret=insert_bits_as_bits(desired_len,no_bytes,&in_ptr, - &ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 47: - /* Same as case 45 apart from By1 and By2, the desired length - and the length of Bin, which are in two bytes each. */ - desired_len = (int)*(++in_ptr); - desired_len = desired_len << 8; - desired_len = desired_len | (int)*(++in_ptr); - no_bytes=(int)*(++in_ptr); - no_bytes = no_bytes << 8; - no_bytes = no_bytes | (int)*(++in_ptr); - - saved_mem = buf_space - counter; - needed = CEIL((desired_len-unused),8) - no_bytes; - if (saved_mem < needed) { - /* Have to allocate more memory */ - buf_size += needed; - buf_space += needed; - if (realloc_memory(drv_binary,buf_size,&ptr, - &complete_buf) == ASN1_ERROR) - return ASN1_ERROR; - } - - counter -= (4 + no_bytes); - if((counter<0) || - (ret=insert_bits_as_bits(desired_len,no_bytes,&in_ptr, - &ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - default: - return ASN1_ERROR; - } - in_ptr++; - } - /* The returned buffer must be at least one byte and - it must be octet aligned */ - if ((unused == 8) && (ptr != complete_buf)) - return (ptr - complete_buf); - else { - ptr++; /* octet align buffer */ - return (ptr - complete_buf); - } -} - - -int realloc_memory(ErlDrvBinary **drv_binary, - int amount, - unsigned char **ptr, - unsigned char **complete_buf) { - - ErlDrvBinary *tmp_bin; - int i; - -/* printf("realloc_momory: amount = %d\n",amount); */ - if ((tmp_bin=driver_realloc_binary(*drv_binary,amount)) == NULL) { - /*error handling due to memory allocation failure */ -/* printf("error when allocating memory\n"); */ - return ASN1_ERROR; - }else { - i = *ptr - *complete_buf; - *drv_binary=tmp_bin; - *complete_buf = (unsigned char*)(*drv_binary)->orig_bytes; - *ptr = *complete_buf + i; - } - return ASN1_OK; -} - - -int insert_most_sign_bits(int no_bits, - unsigned char val, - unsigned char **output_ptr, - int *unused) { - unsigned char *ptr = *output_ptr; - - if (no_bits < *unused){ - *ptr = *ptr | (val >> (8 - *unused)); - *unused -= no_bits; - } else if (no_bits == *unused) { - *ptr = *ptr | (val >> (8 - *unused)); - *unused = 8; - *++ptr = 0x00; - } else { - *ptr = *ptr | (val >> (8 - *unused)); - *++ptr = 0x00; - *ptr = *ptr | (val << *unused); - *unused = 8 - (no_bits - *unused); - } - *output_ptr = ptr; - return ASN1_OK; -} - - -int insert_least_sign_bits(int no_bits, - unsigned char val, - unsigned char **output_ptr, - int *unused) { - unsigned char *ptr = *output_ptr; - int ret = 0; - - if (no_bits < *unused){ - *ptr = *ptr | (val << (*unused - no_bits)); - *unused -= no_bits; - } else if (no_bits == *unused){ - *ptr = *ptr | val; - *unused = 8; - *++ptr = 0x00; - ret++; - } else { - /* first in the begun byte in the completed buffer insert - so many bits that fit, then insert the rest in next byte.*/ - *ptr = *ptr | (val >> (no_bits - *unused)); - *++ptr = 0x00; - ret++; - *ptr = *ptr | (val << (8 - (no_bits - *unused))); - *unused = 8 - (no_bits - *unused); - } - *output_ptr = ptr; - return ret; -} - -/* pad_bits adds no_bits bits in the buffer that output_ptr - points at. - */ -int pad_bits(int no_bits, unsigned char **output_ptr, int *unused) - { - unsigned char *ptr = *output_ptr; - int ret = 0; - - while (no_bits > 0) { - if(*unused == 1){ - *unused = 8; - *++ptr = 0x00; - ret++; - } else - (*unused)--; - no_bits--; - } - *output_ptr = ptr; - return ret; - } - - -/* insert_bits_as_bits removes no_bytes bytes from the buffer that in_ptr - points at and takes the desired_no leftmost bits from those removed - bytes and inserts them in the buffer(output buffer) that ptr points at. - The unused parameter tells how many bits that are not set in the - actual byte in the output buffer. If desired_no is more bits than the - input buffer has in no_bytes bytes, then zero bits is padded.*/ -int insert_bits_as_bits(int desired_no, - int no_bytes, - unsigned char **input_ptr, - unsigned char **output_ptr, - int *unused) -{ - unsigned char *in_ptr = *input_ptr; - unsigned char val; - int no_bits, ret, ret2; - - if (desired_no == (no_bytes * 8)) { - if(insert_octets_unaligned(no_bytes,&in_ptr,output_ptr,*unused) - == ASN1_ERROR) - return ASN1_ERROR; - ret = no_bytes; - } - else if (desired_no < (no_bytes * 8)) { -/* printf("insert_bits_as_bits 1\n\r"); */ - if(insert_octets_unaligned(desired_no/8,&in_ptr,output_ptr,*unused) - == ASN1_ERROR) - return ASN1_ERROR; -/* printf("insert_bits_as_bits 2\n\r"); */ - val = *++in_ptr; -/* printf("val = %d\n\r",(int)val); */ - no_bits = desired_no % 8; -/* printf("no_bits = %d\n\r",no_bits); */ - insert_most_sign_bits(no_bits,val,output_ptr,unused); - ret = CEIL(desired_no,8); - } - else { - if(insert_octets_unaligned(no_bytes,&in_ptr,output_ptr,*unused) - == ASN1_ERROR) - return ASN1_ERROR; - ret2 = pad_bits(desired_no - (no_bytes * 8),output_ptr,unused); -/* printf("ret2 = %d\n\r",ret2); */ - ret = CEIL(desired_no,8); -/* printf("ret = %d\n\r",ret); */ - } -/* printf("*unused = %d\n\r",*unused); */ - *input_ptr = in_ptr; - return ret; -} - - -/* insert_octets_as_bits_exact_len */ -int -insert_octets_as_bits_exact_len(int desired_len, - int in_buff_len, - unsigned char **in_ptr, - unsigned char **ptr, - int *unused) -{ - int ret = 0; - int ret2 = 0; - - if (desired_len == in_buff_len) { - if ((ret = insert_octets_as_bits(in_buff_len,in_ptr,ptr,unused)) == ASN1_ERROR) - return ASN1_ERROR; - } - else if(desired_len > in_buff_len) { - if((ret = insert_octets_as_bits(in_buff_len,in_ptr,ptr,unused)) == ASN1_ERROR) - return ASN1_ERROR; - /* now pad with zero bits */ -/* printf("~npad_bits: called with %d bits padding~n~n~r",desired_len - in_buff_len); */ - if ((ret2=pad_bits(desired_len - in_buff_len,ptr,unused)) == ASN1_ERROR) - return ASN1_ERROR; - } - else {/* desired_len < no_bits */ - if ((ret=insert_octets_as_bits(desired_len,in_ptr,ptr,unused)) == ASN1_ERROR) - return ASN1_ERROR; - /* now remove no_bits - desired_len bytes from in buffer */ - *in_ptr += (in_buff_len - desired_len); - } - return (ret+ret2); -} - - - -/* insert_octets_as_bits takes no_bytes bytes from the buffer that input_ptr - points at and inserts the least significant bit of it in the buffer that - output_ptr points at. Each byte in the input buffer must be 1 or 0 - otherwise the function returns ASN1_ERROR. The output buffer is concatenated - without alignment. - */ -int insert_octets_as_bits(int no_bytes, - unsigned char **input_ptr, - unsigned char **output_ptr, - int *unused) -{ - unsigned char *in_ptr = *input_ptr; - unsigned char *ptr = *output_ptr; - int used_bits = 8 - *unused; - - while (no_bytes > 0) { - switch (*++in_ptr) { - case 0: - if(*unused == 1){ - *unused = 8; - *++ptr = 0x00; - } else - (*unused)--; - break; - case 1: - if(*unused == 1){ - *ptr = *ptr | 1; - *unused = 8; - *++ptr = 0x00; - } else { - *ptr = *ptr | (1 << (*unused - 1)); - (*unused)--; - } - break; - default: - return ASN1_ERROR; - } - no_bytes--; - } - *input_ptr = in_ptr; - *output_ptr = ptr; - return ((used_bits+no_bytes) / 8); /*return number of new bytes - in completed buffer */ -} - -/* insert_octets inserts bytes from the input buffer, *input_ptr, - into the output buffer, *output_ptr. Before the first byte is - inserted the input buffer is aligned. - */ -int insert_octets(int no_bytes, - unsigned char **input_ptr, - unsigned char **output_ptr, - int *unused) -{ - unsigned char *in_ptr = *input_ptr; - unsigned char *ptr = *output_ptr; - int ret = 0; - - if (*unused != 8) {/* must align before octets are added */ - *++ptr = 0x00; - ret++; - *unused = 8; - } - while(no_bytes > 0) { - *ptr = *(++in_ptr); - *++ptr = 0x00; - /* *unused = *unused - 1; */ - no_bytes--; - } - *input_ptr = in_ptr; - *output_ptr = ptr; - return (ret + no_bytes); -} - -/* insert_octets_unaligned inserts bytes from the input buffer, *input_ptr, - into the output buffer, *output_ptr.No alignment is done. - */ -int insert_octets_unaligned(int no_bytes, - unsigned char **input_ptr, - unsigned char **output_ptr, - int unused) -{ - unsigned char *in_ptr = *input_ptr; - unsigned char *ptr = *output_ptr; - int n = no_bytes; - unsigned char val; - - while (n > 0) { - if (unused == 8) { - *ptr = *++in_ptr; - *++ptr = 0x00; - }else { - val = *++in_ptr; - *ptr = *ptr | val >> (8 - unused); - *++ptr = 0x00; - *ptr = val << unused; - } - n--; - } - *input_ptr = in_ptr; - *output_ptr = ptr; - return no_bytes; -} - - -int insert_octets_except_unused(int no_bytes, - unsigned char **input_ptr, - unsigned char **output_ptr, - int *unused, - int in_unused) -{ - unsigned char *in_ptr = *input_ptr; - unsigned char *ptr = *output_ptr; - int val, no_bits; - int ret = 0; - - if (in_unused == 0){ -/* printf("%d: insert_octets_except_unused: if\n\r",__LINE__); */ - if ((ret = insert_octets_unaligned(no_bytes,&in_ptr,&ptr, - *unused)) == ASN1_ERROR) - return ASN1_ERROR; - } - else { -/* printf("%d: insert_octets_except_unused: else\n\r",__LINE__); */ - if ((ret=insert_octets_unaligned(no_bytes - 1,&in_ptr,&ptr,*unused)) != ASN1_ERROR) { - val = (int) *(++in_ptr); - no_bits = 8 - in_unused; - /* no_bits is always less than *unused since the buffer is - octet aligned after insert:octets call, so the following - if clasuse is obsolete I think */ - if(no_bits < *unused){ - *ptr = *ptr | (val >> (8 - *unused)); - *unused = *unused - no_bits; - } else if (no_bits == *unused) { - *ptr = *ptr | (val >> (8 - *unused)); - *++ptr = 0x00; - ret++; - *unused = 8; - } else { - *ptr = *ptr | (val >> (8 - *unused)); - *++ptr = 0x00; - ret++; - *ptr = *ptr | (val << *unused); - *unused = 8 - (no_bits - *unused); - } - } else - return ASN1_ERROR; - } - *input_ptr = in_ptr; - *output_ptr = ptr; -/* printf("%d: insert_octets_except_unused: ret=%d\n\r",__LINE__,ret); */ - return ret; -} - - - -/* - * - * This section defines functionality for the partial decode of a - * BER encoded message - * - */ - -/* - * int decode(ErlDrvBinary **drv_binary,unsigned char *decode_buf, - * unsigned char *in_buf, int in_buf_len) - * drv_binary is a pointer to a pointer to an allocated driver binary. - * in_buf is a pointer into the buffer of incoming bytes. - * in_buf_len is the length of the incoming buffer. - * The function reads the bytes in the incoming buffer and structures - * it in a nested way as Erlang terms. The buffer contains data in the - * order tag - length - value. Tag, length and value has the following - * format: - * A tag is normally one byte but may be of any length, if the tag number - * is greater than 30. +----------+ - * |CL|C|NNNNN| - * +----------+ - * If NNNNN is 31 then will the 7 l.s.b of each of the following tag number - * bytes contain the tag number. Each tag number byte that is not the last one - * has the m.s.b. set to 1. - * The length can be short definite length (sdl), long definite length (ldl) - * or indefinite length (il). - * sdl: +---------+ the L bits is the length - * |0|LLLLLLL| - * +---------+ - * ldl: +---------+ +---------+ +---------+ +-----------+ - * |1|lllllll| |first len| | | |the Nth len| - * +---------+ +---------+ +---------+ ... +-----------+ - * The first byte tells how many len octets will follow, max 127 - * il: +---------+ +----------------------+ +--------+ +--------+ - * |1|0000000| |content octets (Value)| |00000000| |00000000| - * +---------+ +----------------------+ +--------+ +--------+ - * The value octets are preceded by one octet and followed by two - * exactly as above. The value must be some tag-length-value encoding. - * - * The function returns a value in Erlnag term format: - * {{TagNo,Value},Rest} - * TagNo is an integer ((CL bsl 16) + tag number) which limits the tag number - * to 65535. - * Value is a binary if the C bit in tag was unset, otherwise (if tag was - * constructed) Value is a list, List. - * List is like: [{TagNo,Value},{TagNo,Value},...] - * Rest is a binary, i.e. the undecoded part of the buffer. Most often Rest - * is the empty binary. - * If some error occured during the decoding of the in_buf an error is returned. - */ -int decode_begin(ErlDrvBinary **drv_binary,unsigned char *in_buf, int in_buf_len, unsigned int *err_pos) -{ - int maybe_ret; - char *decode_buf = (*drv_binary)->orig_bytes; - int ei_index = 0; - int ib_index = 0; - /* ei_index is the index used by the ei functions to encode an - Erlang term into the buffer decode_buf */ - /* ib_index is the index were to read the next byte from in_buf */ - - -#ifdef ASN1_DEBUG - printf("decode_begin1: ei_index=%d, ib_index=%d\n\r",ei_index,ib_index); -#endif - /* the first byte must be a "version magic" */ - if(ei_encode_version(decode_buf,&ei_index) == ASN1_ERROR) - return ASN1_ERROR; /* 1 byte */ -#ifdef ASN1_DEBUG - printf("decode_begin2: ei_index=%d, ib_index=%d\n\r",ei_index,ib_index); -#endif - if (ei_encode_tuple_header(decode_buf,&ei_index,2) == ASN1_ERROR) - return ASN1_ERROR; /* 2 bytes */ -#ifdef ASN1_DEBUG - printf("decode_begin3: ei_index=%d, ib_index=%d\n\r",ei_index,ib_index); -#endif - if((maybe_ret=decode(drv_binary,&ei_index,in_buf,&ib_index,in_buf_len)) <= ASN1_ERROR) - { - *err_pos = ib_index; -#ifdef ASN1_DEBUG - printf("err_pos=%d,ib_index=%d\r\n",*err_pos,ib_index); -#endif - return maybe_ret; - }; - - decode_buf = (*drv_binary)->orig_bytes; /* maybe a realloc during decode_value */ -#ifdef ASN1_DEBUG - printf("decode_begin4: in_buf_len=%d, ei_index=%d, ib_index=%d\n\r", - in_buf_len,ei_index,ib_index); -#endif - /* "{{TagNo,Value},Rest}" */ - if (ei_encode_binary(decode_buf,&ei_index,&(in_buf[ib_index]),in_buf_len-ib_index) - == ASN1_ERROR) /* at least 5 bytes */ - return ASN1_ERROR; -#ifdef ASN1_DEBUG - printf("decode_begin5: ei_index=%d, ib_index=%d\n\r",ei_index,ib_index); -#endif - return ei_index; -} - -int decode(ErlDrvBinary **drv_binary,int *ei_index,unsigned char *in_buf, - int *ib_index, int in_buf_len) -{ - int maybe_ret; - char *decode_buf = (*drv_binary)->orig_bytes; - int form; -#ifdef ASN1_DEBUG - printf("decode 1\n\r"); -#endif - if (((*drv_binary)->orig_size - *ei_index) < 19) {/* minimum amount of bytes */ - /* allocate more memory */ - if (realloc_decode_buf(drv_binary,(*drv_binary)->orig_size * 2) == - ASN1_ERROR) - return ASN1_ERROR; - decode_buf = (*drv_binary)->orig_bytes; - } -/* printf("decode 2\n\r"); */ - /* "{" */ - if (ei_encode_tuple_header(decode_buf,ei_index,2) == ASN1_ERROR) - return ASN1_ERROR; /* 2 bytes */ -#ifdef ASN1_DEBUG - printf("decode 3:orig_size=%ld, ei_index=%d, ib_index=%d\n\r",(*drv_binary)->orig_size,*ei_index,*ib_index); -#endif - - /*buffer must hold at least two bytes*/ - if ((*ib_index +2) > in_buf_len) - return ASN1_VALUE_ERROR; - /* "{{TagNo," */ - if ((form = decode_tag(decode_buf,ei_index,in_buf,in_buf_len,ib_index)) <= ASN1_ERROR) - return form; /* 5 bytes */ -#ifdef ASN1_DEBUG - printf("i_i=%d,in_buf_len=%d\r\n",*ei_index,in_buf_len); -#endif - if (*ib_index >= in_buf_len){ - return ASN1_TAG_ERROR; - } -#ifdef ASN1_DEBUG - printf("decode 5 ib_index=%d\n\r",*ib_index); -#endif - /* buffer must hold at least one byte (0 as length and nothing as - value) */ - /* "{{TagNo,Value}," */ - if ((maybe_ret=decode_value(ei_index,in_buf,ib_index,drv_binary,form, - in_buf_len)) <= ASN1_ERROR) - return maybe_ret; /* at least 5 bytes */ -#ifdef ASN1_DEBUG - printf("decode 7\n\r"); -#endif - return *ei_index; -} - -/* - * decode_tag decodes the BER encoded tag in in_buf and puts it in the - * decode_buf encoded by the Erlang extern format as an Erlang term. - */ -int decode_tag(char *decode_buf,int *db_index,unsigned char *in_buf, - int in_buf_len, int *ib_index) -{ - int tag_no, tmp_tag, form; - - - /* first get the class of tag and bit shift left 16*/ - tag_no = ((MASK(in_buf[*ib_index],ASN1_CLASS)) << 10); - - form = (MASK(in_buf[*ib_index],ASN1_FORM)); -#ifdef ASN1_DEBUG - printf("decode_tag0:ii=%d, tag_no=%d, form=%d.\r\n", - *ib_index,tag_no,form); -#endif - - /* then get the tag number */ - if((tmp_tag = (int) INVMASK(in_buf[*ib_index],ASN1_CLASSFORM)) < 31) { - ei_encode_ulong(decode_buf,db_index,tag_no+tmp_tag); /* usual case */ - (*ib_index)++; -#ifdef ASN1_DEBUG - printf("decode_tag1:ii=%d.\r\n",*ib_index); -#endif - } - else - { - int n = 0; /* n is used to check that the 64K limit is not - exceeded*/ -#ifdef ASN1_DEBUG - printf("decode_tag1:ii=%d, in_buf_len=%d.\r\n",*ib_index,in_buf_len); -#endif - - /* should check that at least three bytes are left in - in-buffer,at least two tag byte and at least one length byte */ - if ((*ib_index +3) > in_buf_len) - return ASN1_VALUE_ERROR; - (*ib_index)++; -#ifdef ASN1_DEBUG - printf("decode_tag2:ii=%d.\r\n",*ib_index); -#endif - /* The tag is in the following bytes in in_buf as - 1ttttttt 1ttttttt ... 0ttttttt, where the t-bits - is the tag number*/ - /* In practice is the tag size limited to 64K, i.e. 16 bits. If - the tag is greater then 64K return an error */ - while (((tmp_tag = (int)in_buf[*ib_index]) >= 128) && n < 2){ - /* m.s.b. = 1 */ - tag_no = tag_no + (MASK(tmp_tag,ASN1_LONG_TAG) << 7); - (*ib_index)++; -#ifdef ASN1_DEBUG - printf("decode_tag3:ii=%d.\r\n",*ib_index); -#endif - n++; - }; - if ((n==2) && in_buf[*ib_index] > 3) - return ASN1_TAG_ERROR; /* tag number > 64K */ - tag_no = tag_no + in_buf[*ib_index]; - (*ib_index)++; -#ifdef ASN1_DEBUG - printf("decode_tag4:ii=%d.\r\n",*ib_index); -#endif - ei_encode_ulong(decode_buf,db_index,tag_no); - } - return form; -} - - -/* - * decode_value decodes the BER encoded length and value fields in the - * in_buf and puts the value part in the decode_buf as an Erlang term - * encoded by the Erlang extern format - */ -int decode_value(int *ei_index,unsigned char *in_buf, - int *ib_index,ErlDrvBinary **drv_binary,int form, - int in_buf_len) -{ - int maybe_ret; - char *decode_buf = (*drv_binary)->orig_bytes; - unsigned int len = 0; - unsigned int lenoflen = 0; - int indef = 0; - -#ifdef ASN1_DEBUG - printf("decode_value1:ib_index=%d\n\r",*ib_index); -#endif - if (((in_buf[*ib_index]) & 0x80) == ASN1_SHORT_DEFINITE_LENGTH) { - len = in_buf[*ib_index]; - } - else if (in_buf[*ib_index] == ASN1_INDEFINITE_LENGTH) - indef = 1; - else /* long definite length */ { - lenoflen = (in_buf[*ib_index] & 0x7f); /*length of length */ -#ifdef ASN1_DEBUG - printf("decode_value,lenoflen:%d\r\n",lenoflen); -#endif - if (lenoflen > (in_buf_len - (*ib_index+1))) - return ASN1_LEN_ERROR; - len = 0; - while (lenoflen-- ) { - (*ib_index)++; -#ifdef ASN1_DEBUG - printf("decode_value1:*ib_index=%d, byte = %d.\r\n",*ib_index,in_buf[*ib_index]); -#endif - if (!(len < (1 << (sizeof(len)-1)*8))) - return ASN1_LEN_ERROR; /* length does not fit in 32 bits */ - len = (len << 8) + in_buf[*ib_index]; - } - } - if (len > (in_buf_len - (*ib_index + 1))) - return ASN1_VALUE_ERROR; - (*ib_index)++; -#ifdef ASN1_DEBUG - printf("decode_value2:ii=%d.\r\n",*ib_index); -#endif - if (indef == 1) - { /* in this case it is desireably to check that indefinite length - end bytes exist in inbuffer */ - while (!(in_buf[*ib_index]==0 && in_buf[*ib_index + 1]==0)) { -#ifdef ASN1_DEBUG - printf("decode_value while:ib_index=%d in_buf_len=%d\n\r", - *ib_index,in_buf_len); -#endif - if(*ib_index >= in_buf_len) - return ASN1_INDEF_LEN_ERROR; - ei_encode_list_header(decode_buf,ei_index,1); /* 5 bytes */ - if((maybe_ret=decode(drv_binary,ei_index,in_buf, - ib_index,in_buf_len)) <= ASN1_ERROR) - return maybe_ret; - decode_buf = (*drv_binary)->orig_bytes; - } - (*ib_index) += 2; /* skip the indefinite length end bytes */ -#ifdef ASN1_DEBUG - printf("decode_value3:ii=%d.\r\n",*ib_index); -#endif - ei_encode_empty_list(decode_buf,ei_index); /* 1 byte */ - } - else if (form == ASN1_CONSTRUCTED) - { - int end_index = *ib_index + len; - if(end_index > in_buf_len) - return ASN1_LEN_ERROR; - while (*ib_index < end_index) { - -#ifdef ASN1_DEBUG - printf("decode_value3:*ib_index=%d, end_index=%d\n\r",*ib_index,end_index); -#endif - ei_encode_list_header(decode_buf,ei_index,1); /* 5 bytes */ - if((maybe_ret=decode(drv_binary,ei_index,in_buf, - ib_index,in_buf_len))<=ASN1_ERROR) - return maybe_ret; - decode_buf = (*drv_binary)->orig_bytes; - } - ei_encode_empty_list(decode_buf,ei_index); /* 1 byte */ - } - else - { - if (((*drv_binary)->orig_size - *ei_index) < 10+len) { /* 5+len for the binary*/ - if (realloc_decode_buf(drv_binary,(*drv_binary)->orig_size * 2) == - ASN1_ERROR) - return ASN1_ERROR; - decode_buf = (*drv_binary)->orig_bytes; - } - if((*ib_index + len) > in_buf_len) - return ASN1_LEN_ERROR; - ei_encode_binary(decode_buf,ei_index,&in_buf[*ib_index],len); - *ib_index = *ib_index + len; -#ifdef ASN1_DEBUG - printf("decode_value4:ii=%d.\r\n",*ib_index); -#endif - } - return ASN1_OK; -} - -int realloc_decode_buf(ErlDrvBinary **drv_binary,int amount) { - ErlDrvBinary *tmp_bin; - - if ((tmp_bin=driver_realloc_binary(*drv_binary,amount)) == NULL) - return ASN1_ERROR; - *drv_binary = tmp_bin; - return ASN1_OK; -} - - - -/* - * int decode_partial(drv_binary,in_buf,in_buf_len) - */ -/* - * The in_buf contains two parts: first information about which value - * will be decoded, as a sequence of tags and tag codes, then the - * encoded BER value. First of all comes a length field that tells how - * many following bytes contains the sequence of tags. Then starts the - * BER encoded message. The tag sequence length field is a single - * byte. The sequence of tags/tag codes may be one of the codes - * ASN1_SKIPPED, ASN1_CHOOSEN and a tag or ASN1_OPTIONAL and a - * tag. ASN1_SKIPPED means that the following tag is mandatory and is - * skipped. ASN1_CHOOSEN means that the value of this tag shall, if - * this was the last tag in tag sequence, be returned or be searched - * in for the next tag. ASN1_OPTIONAL means that this tag shall be - * skipped but it may be missing. Each tag in the tag sequence - * correspond to a tag in the BER encoded message. If the decode - * arives to a position where there is no matching tag, an error is - * returned (if it wasn't the last tag and it was OPTIONAL). After the - * right value has been detected it is returned in the out_buf. - * - */ -int decode_partial(ErlDrvBinary **drv_binary,unsigned char *in_buf, int in_buf_len) -{ - char *out_buf = (*drv_binary)->orig_bytes; - int tag_index_val = 1; - int msg_index_val; - int *msg_index, *tag_index, tmp_index; - int tag_seq_length; - int wanted_tag, next_tag; - int buf_end_index = in_buf_len; - int ret = 0, length, old_index; - - tag_index = &tag_index_val; - tag_seq_length = in_buf[0]; - msg_index = &msg_index_val; - *msg_index = tag_seq_length + 1; - - -/* printf("decode_partial 1: in_buf_len=%d, tag_index=%d, msg_index=%d\r\n,tag_seq_length=%d\r\n",in_buf_len,*tag_index,*msg_index,tag_seq_length); */ - while(*tag_index < tag_seq_length) { - switch(in_buf[*tag_index]) { - case ASN1_SKIPPED: -/* printf("decode_partial ASN1_SKIPPED: in_buf[*msg_index]=%d\r\n",in_buf[*msg_index]); */ - (*tag_index)++; -/* printf("decode_partial ASN1_SKIPPED 2: *msg_index=%d\r\n",*msg_index); */ - skip_tag(in_buf,msg_index,buf_end_index); -/* printf("decode_partial ASN1_SKIPPED 3: *msg_index=%d\r\n",*msg_index); */ - skip_length_and_value(in_buf,msg_index,buf_end_index); -/* printf("decode_partial ASN1_SKIPPED 4: *msg_index=%d\r\n",*msg_index); */ - break; - case ASN1_OPTIONAL: - (*tag_index)++; -/* printf("decode_partial ASN1_OPTIONAL: in_buf[*tag_index]=%d\r\n",in_buf[*tag_index]); */ - wanted_tag = in_buf[*tag_index]; - (*tag_index)++; - tmp_index = *msg_index; - next_tag = get_tag(in_buf,msg_index,buf_end_index); - if (wanted_tag != next_tag) { - *msg_index = tmp_index; - } else - skip_length_and_value(in_buf,msg_index,buf_end_index); - break; - case ASN1_CHOOSEN: -/* printf("decode_partial ASN1_CHOOSEN: in_buf[*msg_index]=%d, *msg_index=%d\r\n",in_buf[*msg_index],*msg_index); */ - (*tag_index)++; - wanted_tag = in_buf[*tag_index]; - (*tag_index)++; - old_index = *msg_index; -/* printf("decode_partial ASN1_CHOOSEN 2: *msg_index=%d\r\n",*msg_index); */ - next_tag = get_tag(in_buf,msg_index,buf_end_index); -/* printf("decode_partial ASN1_CHOOSEN 3: *msg_index=%d\r\n,wanted_tag=%d, next_tag=%d\r\n",*msg_index,wanted_tag,next_tag); */ - if (wanted_tag != next_tag) - return ASN1_NOVALUE; /* an empty binary will be returned to Erlang */ - if (*tag_index == (tag_seq_length + 1)) { - /* get the value and return*/ - if((ret = get_value(out_buf,in_buf,msg_index,buf_end_index)) <= ASN1_ERROR) - return ASN1_ERROR; - return ret; - } - else { - /* calculate the length of the sub buffer and let *msg_index - be at the value part of this BER encoded type*/ - int indef; - indef = 0; - length = get_length(in_buf,msg_index,&indef,buf_end_index); -/* printf("decode_partial ASN1_CHOOSEN 4: length=%d, *msg_index=%d\r\n",length,*msg_index); */ - if ((length == 0) && (indef == 1)) { - /* indefinite length of value */ - old_index = *msg_index; - length = skip_length_and_value(in_buf,msg_index,buf_end_index); - *msg_index = old_index; - buf_end_index = *msg_index + length - 2; - /* remove two bytes due to indefinete length end zeros */ - } else - buf_end_index = (*msg_index + length); - } - break; - default: - return ASN1_ERROR; - } - } - return ASN1_ERROR; -} - - -/* - * int skip_tag(unsigned char *in_buf,int *index,int buf_len) - * steps past the BER encoded tag in in_buf and updates *index. - * Returns the number of skipped bytes. - */ -int skip_tag(unsigned char *in_buf,int *index,int buf_len) -{ - int start_index = *index; - if ((MASK(in_buf[*index],ASN1_TAG)) == 31){ - do { - (*index)++; - if (*index >= buf_len) - return ASN1_ERROR; - } - while(in_buf[*index] >=128); - } - (*index)++; - return (*index - start_index); -} - - -/* - * int skip_length_and_value(unsigned char *in_buf,int *index,int buf_len) - * steps past the BER encoded length and value in in_buf and updates *index. - * returns the length if the skipped "length value". - * Returns the number of skipped bytes. - */ -int skip_length_and_value(unsigned char *in_buf,int *index,int buf_len) -{ - long len; - int indef = 0, lenoflen; - int start_index = *index; - - if ((MASK(in_buf[*index],0x80)) == ASN1_SHORT_DEFINITE_LENGTH){ - len = in_buf[*index]; - if (len > (buf_len - (*index + 1))) - return ASN1_LEN_ERROR; - } else if (in_buf[*index] == ASN1_INDEFINITE_LENGTH) - indef = 1; - else /* long definite length */ { - lenoflen = (in_buf[*index] & 0x7f); /*length of length */ - len = 0; - while (lenoflen--) { - (*index)++; - len = (len << 8) + in_buf[*index]; - } - if (len > (buf_len - (*index + 1))) - return ASN1_LEN_ERROR; - } - (*index)++; - if (indef == 1) - { - while(!(in_buf[*index]==0 && in_buf[*index + 1]==0)) { - skip_tag(in_buf,index,buf_len); - skip_length_and_value(in_buf,index,buf_len); - } - (*index) += 2; - } - else - (*index) += len; - return (*index - start_index); -} - -/* int get_tag(unsigned char *in_buf,int *index) - * - * assumes next byte/bytes in in_buf is an encoded BER tag. A tag - * number has theoretically no upper limit in size. Here the tag - * number is assumed to be less than 64K. Returns an integer value - * on the format: - * xxxxxxxx xxxxxxcc tttttttt tttttttt - * the x-bits are 0 (insignificant) - * the c-bits are the class of the tag - * the t-bits are the tag number. This implies that the tag number - * is limited to 64K-1 - * - */ -int get_tag(unsigned char *in_buf,int *index,int buf_len) -{ - int tag_no = 0,tmp_tag = 0; - - tag_no = (MASK(in_buf[*index],ASN1_CLASSFORM)); - if ((MASK(in_buf[*index],ASN1_TAG)) == ASN1_TAG) { - /* long form of tag */ - do { - (*index)++; - if (*index >= buf_len) - return ASN1_TAG_ERROR; - tmp_tag = tmp_tag << 7; - tmp_tag += (MASK(in_buf[*index],ASN1_LONG_TAG)); - } while (in_buf[*index] >= 128); - (*index)++; - tag_no = tag_no + tmp_tag; - } else { - tag_no += (MASK(in_buf[*index],ASN1_TAG)); - (*index)++; - } - if (*index >= buf_len) - return ASN1_TAG_ERROR; - return tag_no; -} - - -/* - * int get_value(char *out_buf,unsigned char *in_buf, - * int *msg_index,int in_buf_len) - */ -/* assumes next byte/bytes in in_buf is an encoded BER value preceeded by a BER encoded length. Puts value in out_buf. - */ -int get_value(char *out_buf, - unsigned char *in_buf, - int *msg_index, - int in_buf_len) -{ - int len, lenoflen, indef=0, skip_len; - int ret=0; - int start_index; - -/* printf("get_value 1\n\r"); */ - if (in_buf[*msg_index] < 0x80){ /* short definite length */ - len = in_buf[*msg_index]; -/* printf("short definite length\r\n"); */ - } else if (in_buf[*msg_index] > 0x80) { /* long definite length */ - lenoflen = (in_buf[*msg_index] & 0x7f); /*length of length */ - len = 0; - while (lenoflen--) { - (*msg_index)++; - len = (len << 8) + in_buf[*msg_index]; - } - if (len > (in_buf_len - (*msg_index + 1))) - return ASN1_LEN_ERROR; - } else - indef = 1; - (*msg_index)++; -/* printf("get_value 2: len = %d, *msg_index = %d\r\n",len,*msg_index); */ - if (indef == 1) { - while(!(in_buf[*msg_index]==0 && in_buf[*msg_index + 1]==0)) { - start_index = *msg_index; - skip_len = skip_tag(in_buf,msg_index,in_buf_len); -/* printf("get_value 3: skip_len=%d,start_index=%d,*msg_index=%d\n\r", */ -/* skip_len,start_index,*msg_index); */ - memcpy(&out_buf[ret],&in_buf[start_index],skip_len); - ret += skip_len; - start_index = *msg_index; - skip_len = skip_length_and_value(in_buf,msg_index,in_buf_len); -/* printf("get_value 4: skip_len=%d,start_index=%d,*msg_index=%d\n\r", */ -/* skip_len,start_index,*msg_index); */ - memcpy(&out_buf[ret],&in_buf[start_index],skip_len); - ret += skip_len; - } - return ret; - } - else - memcpy(&out_buf[ret],&in_buf[*msg_index],len); - return len; -} - - -/* - * int get_length(unsigned char *in_buf,int *msg_index) - * assumes next byte/bytes contain a BER encoded length field, - * which is decoded. The value of the length is returned. If it - * is an indefinite length the *indef is set to one. - */ -int get_length(unsigned char *in_buf,int *msg_index, - int *indef,int in_buf_len) -{ - int len=0, lenoflen; - - if (in_buf[*msg_index] < 0x80) /* short definite length */ - len = in_buf[*msg_index]; - else if (in_buf[*msg_index] > 0x80) { /* long definite length */ - lenoflen = (in_buf[*msg_index] & 0x7f); /*length of length */ - len = 0; - while (lenoflen--) { - (*msg_index)++; - len = (len << 8) + in_buf[*msg_index]; - } - if (len > (in_buf_len - (*msg_index + 1))) - return ASN1_LEN_ERROR; - } else - *indef = 1; - (*msg_index)++; - return len; -} diff --git a/lib/asn1/c_src/asn1_erl_nif.c b/lib/asn1/c_src/asn1_erl_nif.c new file mode 100644 index 0000000000..9c9f83bc2a --- /dev/null +++ b/lib/asn1/c_src/asn1_erl_nif.c @@ -0,0 +1,1305 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-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% + * + */ +#include <stdlib.h> +#include <stdio.h> +#include <string.h> +#include "erl_nif.h" + +/* #define ASN1_DEBUG 1 */ + +#define ASN1_OK 0 +#define ASN1_ERROR -1 +#define ASN1_COMPL_ERROR 1 +#define ASN1_MEMORY_ERROR 0 +#define ASN1_DECODE_ERROR 2 +#define ASN1_TAG_ERROR -3 +#define ASN1_LEN_ERROR -4 +#define ASN1_INDEF_LEN_ERROR -5 +#define ASN1_VALUE_ERROR -6 + +#define ASN1_CLASS 0xc0 +#define ASN1_FORM 0x20 +#define ASN1_CLASSFORM (ASN1_CLASS | ASN1_FORM) +#define ASN1_TAG 0x1f +#define ASN1_LONG_TAG 0x7f + +#define ASN1_INDEFINITE_LENGTH 0x80 +#define ASN1_SHORT_DEFINITE_LENGTH 0 + +#define ASN1_PRIMITIVE 0 +#define ASN1_CONSTRUCTED 0x20 + +#define ASN1_NOVALUE 0 + +#define ASN1_SKIPPED 0 +#define ASN1_OPTIONAL 1 +#define ASN1_CHOOSEN 2 + +#define CEIL(X,Y) ((X-1) / Y + 1) + +#define INVMASK(X,M) (X & (M ^ 0xff)) +#define MASK(X,M) (X & M) + +/* PER COMPLETE */ +int per_complete(ErlNifBinary *, unsigned char *, int); + +int per_insert_octets(int, unsigned char **, unsigned char **, int *); + +int per_insert_octets_except_unused(int, unsigned char **, unsigned char **, + int *, int); + +int per_insert_octets_as_bits_exact_len(int, int, unsigned char **, + unsigned char **, int *); + +int per_insert_octets_as_bits(int, unsigned char **, unsigned char **, int *); + +int per_pad_bits(int, unsigned char **, int *); + +int per_insert_least_sign_bits(int, unsigned char, unsigned char **, int *); + +int per_insert_most_sign_bits(int, unsigned char, unsigned char **, int *); + +int per_insert_bits_as_bits(int, int, unsigned char **, unsigned char **, int *); + +int per_insert_octets_unaligned(int, unsigned char **, unsigned char **, int); + +int per_realloc_memory(ErlNifBinary *, int, unsigned char **); + +/* BER DECODE */ +int ber_decode_begin(ErlNifEnv *, ERL_NIF_TERM *, unsigned char *, int, + unsigned int *); + +int ber_decode(ErlNifEnv *, ERL_NIF_TERM *, unsigned char *, int *, int); + +int ber_decode_tag(ErlNifEnv *, ERL_NIF_TERM *, unsigned char *, int, int *); + +int ber_decode_value(ErlNifEnv*, ERL_NIF_TERM *, unsigned char *, int *, int, + int); + +/* BER ENCODE */ +typedef struct ber_encode_mem_chunk mem_chunk_t; + +int ber_encode(ErlNifEnv *, ERL_NIF_TERM , mem_chunk_t **, unsigned int *); + +void ber_free_chunks(mem_chunk_t *chunk); +mem_chunk_t *ber_new_chunk(unsigned int length); +int ber_check_memory(mem_chunk_t **curr, unsigned int needed); + +int ber_encode_tag(ErlNifEnv *, ERL_NIF_TERM , unsigned int , + mem_chunk_t **, unsigned int *); + +int ber_encode_length(size_t , mem_chunk_t **, unsigned int *); + +/* + * + * This section defines functionality for the complete encode of a + * PER encoded message + * + */ + +int per_complete(ErlNifBinary *out_binary, unsigned char *in_buf, + int in_buf_len) { + int counter = in_buf_len; + /* counter keeps track of number of bytes left in the + input buffer */ + + int buf_space = in_buf_len; + /* This is the amount of allocated space left of the out_binary. It + is possible when padding is applied that more space is needed than + was originally allocated. */ + + int buf_size = in_buf_len; + /* Size of the buffer. May become reallocated and thus other than + in_buf_len */ + + unsigned char *in_ptr, *ptr; + /* in_ptr points at the next byte in in_buf to be moved to + complete_buf. + ptr points into the new completed buffer, complete_buf, at the + position of the next byte that will be set */ + int unused = 8; + /* unused = [1,...,8] indicates how many of the rigthmost bits of + the byte that ptr points at that are unassigned */ + + int no_bits, no_bytes, in_unused, desired_len, ret, saved_mem, needed, + pad_bits; + + unsigned char val; + + in_ptr = in_buf; + ptr = out_binary->data; + *ptr = 0x00; + while (counter > 0) { + counter--; + switch (*in_ptr) { + case 0: + /* just one zero-bit should be added to the buffer */ + if (unused == 1) { + unused = 8; + *++ptr = 0x00; + buf_space--; + } else + unused--; + break; + + case 1: + /* one one-bit should be added to the buffer */ + if (unused == 1) { + *ptr = *ptr | 1; + unused = 8; + *++ptr = 0x00; + buf_space--; + } else { + *ptr = *ptr | (1 << (unused - 1)); + unused--; + } + break; + + case 2: + /* align buffer to end of byte */ + if (unused != 8) { + *++ptr = 0x00; + buf_space--; + unused = 8; + } + break; + + case 10: + /* next byte in in_buf tells how many bits in the second next + byte that will be used */ + /* The leftmost unused bits in the value byte are supposed to be + zero bits */ + no_bits = (int) *(++in_ptr); + val = *(++in_ptr); + counter -= 2; + if ((ret = per_insert_least_sign_bits(no_bits, val, &ptr, &unused)) + == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 20: + /* in this case the next value in_ptr points at holds the number + of following bytes that holds the value that will be inserted + in the completed buffer */ + no_bytes = (int) *(++in_ptr); + counter -= (no_bytes + 1); + if ((counter < 0) + || (ret = per_insert_octets(no_bytes, &in_ptr, &ptr, + &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 21: + /* in this case the next two bytes in_ptr points at holds the number + of following bytes that holds the value that will be inserted + in the completed buffer */ + no_bytes = (int) *(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int) *(++in_ptr); + counter -= (2 + no_bytes); + if ((counter < 0) + || (ret = per_insert_octets(no_bytes, &in_ptr, &ptr, + &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 30: + /* If we call the following bytes, in the buffer in_ptr points at, + By1,By2,Rest then Rest is the value that will be transfered to + the completed buffer. By1 tells how many of the rightmost bits in + Rest that should not be used. By2 is the length of Rest in bytes.*/ + in_unused = (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + counter -= (2 + no_bytes); + ret = -4711; + if ((counter < 0) + || (ret = per_insert_octets_except_unused(no_bytes, &in_ptr, + &ptr, &unused, in_unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 31: + /* If we call the following bytes, in the buffer in_ptr points at, + By1,By2,By3,Rest then Rest is the value that will be transfered to + the completed buffer. By1 tells how many of the rightmost bits in + Rest that should not be used. By2 and By3 is the length of + Rest in bytes.*/ + in_unused = (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int) *(++in_ptr); + counter -= (3 + no_bytes); + if ((counter < 0) + || (ret = per_insert_octets_except_unused(no_bytes, &in_ptr, + &ptr, &unused, in_unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 40: + /* This case implies that next byte,By1,(..,By1,By2,Bin,...) + is the desired length of the completed value, maybe needs + padding zero bits or removal of trailing zero bits from Bin. + By2 is the length of Bin and Bin is the value that will be + put into the completed buffer. Each byte in Bin has the value + 1 or 0.*/ + desired_len = (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + + /* This is the algorithm for need of memory reallocation: + Only when padding (cases 40 - 43,45 - 47) more memory may be + used than allocated. Therefore one has to keep track of how + much of the allocated memory that has been saved, i.e. the + difference between the number of parsed bytes of the input buffer + and the number of used bytes of the output buffer. + If saved memory is less than needed for the padding then we + need more memory. */ + saved_mem = buf_space - counter; + pad_bits = desired_len - no_bytes - unused; + needed = (pad_bits > 0) ? CEIL(pad_bits,8) : 0; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (per_realloc_memory(out_binary, buf_size, &ptr) == ASN1_ERROR + ) + return ASN1_ERROR; + } + + counter -= (2 + no_bytes); + if ((counter < 0) + || (ret = per_insert_octets_as_bits_exact_len(desired_len, + no_bytes, &in_ptr, &ptr, &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 41: + /* Same as case 40 apart from By2, the length of Bin, which is in + two bytes*/ + desired_len = (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int) *(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (per_realloc_memory(out_binary, buf_size, &ptr) == ASN1_ERROR + ) + return ASN1_ERROR; + } + + counter -= (3 + no_bytes); + if ((counter < 0) + || (ret = per_insert_octets_as_bits_exact_len(desired_len, + no_bytes, &in_ptr, &ptr, &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 42: + /* Same as case 40 apart from By1, the desired length, which is in + two bytes*/ + desired_len = (int) *(++in_ptr); + desired_len = desired_len << 8; + desired_len = desired_len | (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (per_realloc_memory(out_binary, buf_size, &ptr) == ASN1_ERROR + ) + return ASN1_ERROR; + } + + counter -= (3 + no_bytes); + if ((counter < 0) + || (ret = per_insert_octets_as_bits_exact_len(desired_len, + no_bytes, &in_ptr, &ptr, &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 43: + /* Same as case 40 apart from By1 and By2, the desired length and + the length of Bin, which are in two bytes each. */ + desired_len = (int) *(++in_ptr); + desired_len = desired_len << 8; + desired_len = desired_len | (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int) *(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (per_realloc_memory(out_binary, buf_size, &ptr) == ASN1_ERROR + ) + return ASN1_ERROR; + } + + counter -= (4 + no_bytes); + if ((counter < 0) + || (ret = per_insert_octets_as_bits_exact_len(desired_len, + no_bytes, &in_ptr, &ptr, &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 45: + /* This case assumes that the following bytes in the incoming buffer + (called By1,By2,Bin) is By1, which is the number of bits (n) that + will be inserted in the completed buffer. By2 is the number of + bytes in Bin. Each bit in the buffer Bin should be inserted from + the leftmost until the nth.*/ + desired_len = (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (per_realloc_memory(out_binary, buf_size, &ptr) == ASN1_ERROR + ) + return ASN1_ERROR; + } + + counter -= (2 + no_bytes); + + if ((counter < 0) + || (ret = per_insert_bits_as_bits(desired_len, no_bytes, + &in_ptr, &ptr, &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 46: + /* Same as case 45 apart from By1, the desired length, which is + in two bytes. */ + desired_len = (int) *(++in_ptr); + desired_len = desired_len << 8; + desired_len = desired_len | (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (per_realloc_memory(out_binary, buf_size, &ptr) == ASN1_ERROR + ) + return ASN1_ERROR; + } + + counter -= (3 + no_bytes); + if ((counter < 0) + || (ret = per_insert_bits_as_bits(desired_len, no_bytes, + &in_ptr, &ptr, &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 47: + /* Same as case 45 apart from By1 and By2, the desired length + and the length of Bin, which are in two bytes each. */ + desired_len = (int) *(++in_ptr); + desired_len = desired_len << 8; + desired_len = desired_len | (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int) *(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (per_realloc_memory(out_binary, buf_size, &ptr) == ASN1_ERROR + ) + return ASN1_ERROR; + } + + counter -= (4 + no_bytes); + if ((counter < 0) + || (ret = per_insert_bits_as_bits(desired_len, no_bytes, + &in_ptr, &ptr, &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + default: + return ASN1_ERROR; + } + in_ptr++; + } + /* The returned buffer must be at least one byte and + it must be octet aligned */ + if ((unused == 8) && (ptr != out_binary->data)) + return (ptr - out_binary->data); + else { + ptr++; /* octet align buffer */ + return (ptr - out_binary->data); + } +} + +int per_realloc_memory(ErlNifBinary *binary, int amount, unsigned char **ptr) { + + int i = *ptr - binary->data; + + if (!enif_realloc_binary(binary, amount)) { + /*error handling due to memory allocation failure */ + return ASN1_ERROR; + } else { + *ptr = binary->data + i; + } + return ASN1_OK; +} + +int per_insert_most_sign_bits(int no_bits, unsigned char val, + unsigned char **output_ptr, int *unused) { + unsigned char *ptr = *output_ptr; + + if (no_bits < *unused) { + *ptr = *ptr | (val >> (8 - *unused)); + *unused -= no_bits; + } else if (no_bits == *unused) { + *ptr = *ptr | (val >> (8 - *unused)); + *unused = 8; + *++ptr = 0x00; + } else { + *ptr = *ptr | (val >> (8 - *unused)); + *++ptr = 0x00; + *ptr = *ptr | (val << *unused); + *unused = 8 - (no_bits - *unused); + } + *output_ptr = ptr; + return ASN1_OK; +} + +int per_insert_least_sign_bits(int no_bits, unsigned char val, + unsigned char **output_ptr, int *unused) { + unsigned char *ptr = *output_ptr; + int ret = 0; + + if (no_bits < *unused) { + *ptr = *ptr | (val << (*unused - no_bits)); + *unused -= no_bits; + } else if (no_bits == *unused) { + *ptr = *ptr | val; + *unused = 8; + *++ptr = 0x00; + ret++; + } else { + /* first in the begun byte in the completed buffer insert + so many bits that fit, then insert the rest in next byte.*/ + *ptr = *ptr | (val >> (no_bits - *unused)); + *++ptr = 0x00; + ret++; + *ptr = *ptr | (val << (8 - (no_bits - *unused))); + *unused = 8 - (no_bits - *unused); + } + *output_ptr = ptr; + return ret; +} + +/* per_pad_bits adds no_bits bits in the buffer that output_ptr + points at. + */ +int per_pad_bits(int no_bits, unsigned char **output_ptr, int *unused) { + unsigned char *ptr = *output_ptr; + int ret = 0; + + while (no_bits > 0) { + if (*unused == 1) { + *unused = 8; + *++ptr = 0x00; + ret++; + } else + (*unused)--; + no_bits--; + } + *output_ptr = ptr; + return ret; +} + +/* insert_bits_as_bits removes no_bytes bytes from the buffer that in_ptr + points at and takes the desired_no leftmost bits from those removed + bytes and inserts them in the buffer(output buffer) that ptr points at. + The unused parameter tells how many bits that are not set in the + actual byte in the output buffer. If desired_no is more bits than the + input buffer has in no_bytes bytes, then zero bits is padded.*/ +int per_insert_bits_as_bits(int desired_no, int no_bytes, + unsigned char **input_ptr, unsigned char **output_ptr, int *unused) { + unsigned char *in_ptr = *input_ptr; + unsigned char val; + int no_bits, ret, ret2; + + if (desired_no == (no_bytes * 8)) { + if (per_insert_octets_unaligned(no_bytes, &in_ptr, output_ptr, *unused) + == ASN1_ERROR + ) + return ASN1_ERROR; + ret = no_bytes; + } else if (desired_no < (no_bytes * 8)) { + /* printf("per_insert_bits_as_bits 1\n\r"); */ + if (per_insert_octets_unaligned(desired_no / 8, &in_ptr, output_ptr, + *unused) == ASN1_ERROR + ) + return ASN1_ERROR; + /* printf("per_insert_bits_as_bits 2\n\r"); */ + val = *++in_ptr; + /* printf("val = %d\n\r",(int)val); */ + no_bits = desired_no % 8; + /* printf("no_bits = %d\n\r",no_bits); */ + per_insert_most_sign_bits(no_bits, val, output_ptr, unused); + ret = CEIL(desired_no,8); + } else { + if (per_insert_octets_unaligned(no_bytes, &in_ptr, output_ptr, *unused) + == ASN1_ERROR + ) + return ASN1_ERROR; + ret2 = per_pad_bits(desired_no - (no_bytes * 8), output_ptr, unused); + /* printf("ret2 = %d\n\r",ret2); */ + ret = CEIL(desired_no,8); + /* printf("ret = %d\n\r",ret); */ + } + /* printf("*unused = %d\n\r",*unused); */ + *input_ptr = in_ptr; + return ret; +} + +/* per_insert_octets_as_bits_exact_len */ +int per_insert_octets_as_bits_exact_len(int desired_len, int in_buff_len, + unsigned char **in_ptr, unsigned char **ptr, int *unused) { + int ret = 0; + int ret2 = 0; + + if (desired_len == in_buff_len) { + if ((ret = per_insert_octets_as_bits(in_buff_len, in_ptr, ptr, unused)) + == ASN1_ERROR + ) + return ASN1_ERROR; + } else if (desired_len > in_buff_len) { + if ((ret = per_insert_octets_as_bits(in_buff_len, in_ptr, ptr, unused)) + == ASN1_ERROR + ) + return ASN1_ERROR; + /* now pad with zero bits */ + /* printf("~npad_bits: called with %d bits padding~n~n~r",desired_len - in_buff_len); */ + if ((ret2 = per_pad_bits(desired_len - in_buff_len, ptr, unused)) + == ASN1_ERROR + ) + return ASN1_ERROR; + } else {/* desired_len < no_bits */ + if ((ret = per_insert_octets_as_bits(desired_len, in_ptr, ptr, unused)) + == ASN1_ERROR + ) + return ASN1_ERROR; + /* now remove no_bits - desired_len bytes from in buffer */ + *in_ptr += (in_buff_len - desired_len); + } + return (ret + ret2); +} + +/* insert_octets_as_bits takes no_bytes bytes from the buffer that input_ptr + points at and inserts the least significant bit of it in the buffer that + output_ptr points at. Each byte in the input buffer must be 1 or 0 + otherwise the function returns ASN1_ERROR. The output buffer is concatenated + without alignment. + */ +int per_insert_octets_as_bits(int no_bytes, unsigned char **input_ptr, + unsigned char **output_ptr, int *unused) { + unsigned char *in_ptr = *input_ptr; + unsigned char *ptr = *output_ptr; + int used_bits = 8 - *unused; + + while (no_bytes > 0) { + switch (*++in_ptr) { + case 0: + if (*unused == 1) { + *unused = 8; + *++ptr = 0x00; + } else + (*unused)--; + break; + case 1: + if (*unused == 1) { + *ptr = *ptr | 1; + *unused = 8; + *++ptr = 0x00; + } else { + *ptr = *ptr | (1 << (*unused - 1)); + (*unused)--; + } + break; + default: + return ASN1_ERROR; + } + no_bytes--; + } + *input_ptr = in_ptr; + *output_ptr = ptr; + return ((used_bits + no_bytes) / 8); /*return number of new bytes + in completed buffer */ +} + +/* insert_octets inserts bytes from the input buffer, *input_ptr, + into the output buffer, *output_ptr. Before the first byte is + inserted the input buffer is aligned. + */ +int per_insert_octets(int no_bytes, unsigned char **input_ptr, + unsigned char **output_ptr, int *unused) { + unsigned char *in_ptr = *input_ptr; + unsigned char *ptr = *output_ptr; + int ret = 0; + + if (*unused != 8) {/* must align before octets are added */ + *++ptr = 0x00; + ret++; + *unused = 8; + } + while (no_bytes > 0) { + *ptr = *(++in_ptr); + *++ptr = 0x00; + /* *unused = *unused - 1; */ + no_bytes--; + } + *input_ptr = in_ptr; + *output_ptr = ptr; + return (ret + no_bytes); +} + +/* per_insert_octets_unaligned inserts bytes from the input buffer, *input_ptr, + into the output buffer, *output_ptr.No alignment is done. + */ +int per_insert_octets_unaligned(int no_bytes, unsigned char **input_ptr, + unsigned char **output_ptr, int unused) { + unsigned char *in_ptr = *input_ptr; + unsigned char *ptr = *output_ptr; + int n = no_bytes; + unsigned char val; + + while (n > 0) { + if (unused == 8) { + *ptr = *++in_ptr; + *++ptr = 0x00; + } else { + val = *++in_ptr; + *ptr = *ptr | val >> (8 - unused); + *++ptr = 0x00; + *ptr = val << unused; + } + n--; + } + *input_ptr = in_ptr; + *output_ptr = ptr; + return no_bytes; +} + +int per_insert_octets_except_unused(int no_bytes, unsigned char **input_ptr, + unsigned char **output_ptr, int *unused, int in_unused) { + unsigned char *in_ptr = *input_ptr; + unsigned char *ptr = *output_ptr; + int val, no_bits; + int ret = 0; + + if (in_unused == 0) { + if ((ret = per_insert_octets_unaligned(no_bytes, &in_ptr, &ptr, *unused)) + == ASN1_ERROR + ) + return ASN1_ERROR; + } else { + if ((ret = per_insert_octets_unaligned(no_bytes - 1, &in_ptr, &ptr, *unused)) + != ASN1_ERROR) { + val = (int) *(++in_ptr); + no_bits = 8 - in_unused; + /* no_bits is always less than *unused since the buffer is + octet aligned after insert:octets call, so the following + if clasuse is obsolete I think */ + if (no_bits < *unused) { + *ptr = *ptr | (val >> (8 - *unused)); + *unused = *unused - no_bits; + } else if (no_bits == *unused) { + *ptr = *ptr | (val >> (8 - *unused)); + *++ptr = 0x00; + ret++; + *unused = 8; + } else { + *ptr = *ptr | (val >> (8 - *unused)); + *++ptr = 0x00; + ret++; + *ptr = *ptr | (val << *unused); + *unused = 8 - (no_bits - *unused); + } + } else + return ASN1_ERROR; + } + *input_ptr = in_ptr; + *output_ptr = ptr; + return ret; +} + +/* + * + * This section defines functionality for the partial decode of a + * BER encoded message + * + */ + +/* + * int decode(ErlNifEnv* env, ERL_NIF_TERM *term, unsigned char *in_buf, + int in_buf_len, unsigned int *err_pos) + * term is a pointer to the term which is to be returned to erlang + * in_buf is a pointer into the buffer of incoming bytes. + * in_buf_len is the length of the incoming buffer. + * The function reads the bytes in the incoming buffer and structures + * it in a nested way as Erlang terms. The buffer contains data in the + * order tag - length - value. Tag, length and value has the following + * format: + * A tag is normally one byte but may be of any length, if the tag number + * is greater than 30. +----------+ + * |CL|C|NNNNN| + * +----------+ + * If NNNNN is 31 then will the 7 l.s.b of each of the following tag number + * bytes contain the tag number. Each tag number byte that is not the last one + * has the m.s.b. set to 1. + * The length can be short definite length (sdl), long definite length (ldl) + * or indefinite length (il). + * sdl: +---------+ the L bits is the length + * |0|LLLLLLL| + * +---------+ + * ldl: +---------+ +---------+ +---------+ +-----------+ + * |1|lllllll| |first len| | | |the Nth len| + * +---------+ +---------+ +---------+ ... +-----------+ + * The first byte tells how many len octets will follow, max 127 + * il: +---------+ +----------------------+ +--------+ +--------+ + * |1|0000000| |content octets (Value)| |00000000| |00000000| + * +---------+ +----------------------+ +--------+ +--------+ + * The value octets are preceded by one octet and followed by two + * exactly as above. The value must be some tag-length-value encoding. + * + * The function returns a value in Erlang nif term format: + * {{TagNo,Value},Rest} + * TagNo is an integer ((CL bsl 16) + tag number) which limits the tag number + * to 65535. + * Value is a binary if the C bit in tag was unset, otherwise (if tag was + * constructed) Value is a list, List. + * List is like: [{TagNo,Value},{TagNo,Value},...] + * Rest is a binary, i.e. the undecoded part of the buffer. Most often Rest + * is the empty binary. + * If some error occured during the decoding of the in_buf an error is returned. + */ +int ber_decode_begin(ErlNifEnv* env, ERL_NIF_TERM *term, unsigned char *in_buf, + int in_buf_len, unsigned int *err_pos) { + int maybe_ret; + int ib_index = 0; + unsigned char *rest_data; + ERL_NIF_TERM decoded_term, rest; + + if ((maybe_ret = ber_decode(env, &decoded_term, in_buf, &ib_index, + in_buf_len)) <= ASN1_ERROR) + { + *err_pos = ib_index; + return maybe_ret; + }; + + // The remaining binary after one ASN1 segment has been decoded + if ((rest_data = enif_make_new_binary(env, in_buf_len - ib_index, &rest)) + == NULL) { + *term = enif_make_atom(env, "could_not_alloc_binary"); + return ASN1_ERROR; + } + + *term = enif_make_tuple2(env, decoded_term, rest); + return ASN1_OK; +} + +int ber_decode(ErlNifEnv* env, ERL_NIF_TERM *term, unsigned char *in_buf, + int *ib_index, int in_buf_len) { + int maybe_ret; + int form; + ERL_NIF_TERM tag, value; + + /*buffer must hold at least two bytes*/ + if ((*ib_index + 2) > in_buf_len) + return ASN1_VALUE_ERROR; + /* "{{TagNo," */ + if ((form = ber_decode_tag(env, &tag, in_buf, in_buf_len, ib_index)) + <= ASN1_ERROR + ) + return form; /* 5 bytes */ + if (*ib_index >= in_buf_len) { + return ASN1_TAG_ERROR; + } + /* buffer must hold at least one byte (0 as length and nothing as + value) */ + /* "{{TagNo,Value}," */ + if ((maybe_ret = ber_decode_value(env, &value, in_buf, ib_index, form, + in_buf_len)) <= ASN1_ERROR + ) + return maybe_ret; /* at least 5 bytes */ + *term = enif_make_tuple2(env, tag, value); + return ASN1_OK; +} + +/* + * decode_tag decodes the BER encoded tag in in_buf and creates an + * nif term tag + */ +int ber_decode_tag(ErlNifEnv* env, ERL_NIF_TERM *tag, unsigned char *in_buf, + int in_buf_len, int *ib_index) { + int tag_no, tmp_tag, form; + + /* first get the class of tag and bit shift left 16*/ + tag_no = ((MASK(in_buf[*ib_index],ASN1_CLASS)) << 10); + + form = (MASK(in_buf[*ib_index],ASN1_FORM)); + + /* then get the tag number */ + if ((tmp_tag = (int) INVMASK(in_buf[*ib_index],ASN1_CLASSFORM)) < 31) { + *tag = enif_make_uint(env, tag_no + tmp_tag); + (*ib_index)++; + } else { + int n = 0; /* n is used to check that the 64K limit is not + exceeded*/ + + /* should check that at least three bytes are left in + in-buffer,at least two tag byte and at least one length byte */ + if ((*ib_index + 3) > in_buf_len) + return ASN1_VALUE_ERROR; + (*ib_index)++; + /* The tag is in the following bytes in in_buf as + 1ttttttt 1ttttttt ... 0ttttttt, where the t-bits + is the tag number*/ + /* In practice is the tag size limited to 64K, i.e. 16 bits. If + the tag is greater then 64K return an error */ + while (((tmp_tag = (int) in_buf[*ib_index]) >= 128) && n < 2) { + /* m.s.b. = 1 */ + tag_no = tag_no + (MASK(tmp_tag,ASN1_LONG_TAG) << 7); + (*ib_index)++; + n++; + }; + if ((n == 2) && in_buf[*ib_index] > 3) + return ASN1_TAG_ERROR; /* tag number > 64K */ + tag_no = tag_no + in_buf[*ib_index]; + (*ib_index)++; + *tag = enif_make_uint(env, tag_no); + } + return form; +} + +/* + * ber_decode_value decodes the BER encoded length and value fields in the + * in_buf and puts the value part in the decode_buf as an Erlang + * nif term into value + */ +int ber_decode_value(ErlNifEnv* env, ERL_NIF_TERM *value, unsigned char *in_buf, + int *ib_index, int form, int in_buf_len) { + int maybe_ret; + unsigned int len = 0; + unsigned int lenoflen = 0; + int indef = 0; + unsigned char *tmp_out_buff; + ERL_NIF_TERM term = 0, curr_head = 0; + + if (((in_buf[*ib_index]) & 0x80) == ASN1_SHORT_DEFINITE_LENGTH) { + len = in_buf[*ib_index]; + } else if (in_buf[*ib_index] == ASN1_INDEFINITE_LENGTH + ) + indef = 1; + else /* long definite length */{ + lenoflen = (in_buf[*ib_index] & 0x7f); /*length of length */ + if (lenoflen > (in_buf_len - (*ib_index + 1))) + return ASN1_LEN_ERROR; + len = 0; + while (lenoflen--) { + (*ib_index)++; + if (!(len < (1 << (sizeof(len) - 1) * 8))) + return ASN1_LEN_ERROR; /* length does not fit in 32 bits */ + len = (len << 8) + in_buf[*ib_index]; + } + } + if (len > (in_buf_len - (*ib_index + 1))) + return ASN1_VALUE_ERROR; + (*ib_index)++; + if (indef == 1) { /* in this case it is desireably to check that indefinite length + end bytes exist in inbuffer */ + curr_head = enif_make_list(env, 0); + while (!(in_buf[*ib_index] == 0 && in_buf[*ib_index + 1] == 0)) { + if (*ib_index >= in_buf_len) + return ASN1_INDEF_LEN_ERROR; + + if ((maybe_ret = ber_decode(env, &term, in_buf, ib_index, in_buf_len)) + <= ASN1_ERROR + ) + return maybe_ret; + curr_head = enif_make_list_cell(env, term, curr_head); + } + enif_make_reverse_list(env, curr_head, value); + (*ib_index) += 2; /* skip the indefinite length end bytes */ + } else if (form == ASN1_CONSTRUCTED) + { + int end_index = *ib_index + len; + if (end_index > in_buf_len) + return ASN1_LEN_ERROR; + curr_head = enif_make_list(env, 0); + while (*ib_index < end_index) { + + if ((maybe_ret = ber_decode(env, &term, in_buf, ib_index, + in_buf_len)) <= ASN1_ERROR + ) + return maybe_ret; + curr_head = enif_make_list_cell(env, term, curr_head); + } + enif_make_reverse_list(env, curr_head, value); + } else { + if ((*ib_index + len) > in_buf_len) + return ASN1_LEN_ERROR; + tmp_out_buff = enif_make_new_binary(env, len, value); + memcpy(tmp_out_buff, in_buf + *ib_index, len); + *ib_index = *ib_index + len; + } + return ASN1_OK; +} + +struct ber_encode_mem_chunk { + mem_chunk_t *next; + int length; + char *top; + char *curr; +}; + +int ber_encode(ErlNifEnv *env, ERL_NIF_TERM term, mem_chunk_t **curr, unsigned int *count) { + + const ERL_NIF_TERM *tv; + unsigned int form; + int arity; + + if (!enif_get_tuple(env, term, &arity, &tv)) + return ASN1_ERROR; + + form = enif_is_list(env, tv[1]) ? ASN1_CONSTRUCTED : ASN1_PRIMITIVE; + + switch (form) { + case ASN1_PRIMITIVE: { + ErlNifBinary value; + if (!enif_inspect_binary(env, tv[1], &value)) + return ASN1_ERROR; + + if (ber_check_memory(curr, value.size)) + return ASN1_ERROR; + memcpy((*curr)->curr - value.size + 1, value.data, value.size); + (*curr)->curr -= value.size; + *count += value.size; + + if (ber_encode_length(value.size, curr, count)) + return ASN1_ERROR; + + break; + } + case ASN1_CONSTRUCTED: { + ERL_NIF_TERM head, tail; + unsigned int tmp_cnt; + + if(!enif_make_reverse_list(env, tv[1], &head)) + return ASN1_ERROR; + + if (!enif_get_list_cell(env, head, &head, &tail)) { + if (enif_is_empty_list(env, tv[1])) { + *((*curr)->curr) = 0; + (*curr)->curr -= 1; + (*count)++; + break; + } else + return ASN1_ERROR; + } + + do { + tmp_cnt = 0; + if (ber_encode(env, head, curr, &tmp_cnt)) { + return ASN1_ERROR; + } + *count += tmp_cnt; + } while (enif_get_list_cell(env, tail, &head, &tail)); + + if (ber_check_memory(curr, *count)) { + return ASN1_ERROR; + } + + if (ber_encode_length(*count, curr, count)) { + return ASN1_ERROR; + } + + break; + } + } + + // We need atleast 5 bytes to encode the next tlv + if (ber_check_memory(curr, 3)) + return ASN1_ERROR; + + if (ber_encode_tag(env, tv[0], form, curr, count)) + return ASN1_ERROR; + + return ASN1_OK; +} + +int ber_encode_tag(ErlNifEnv *env, ERL_NIF_TERM tag, unsigned int form, + mem_chunk_t **curr, unsigned int *count) { + unsigned int class_tag_no, head_tag; + if (!enif_get_uint(env, tag, &class_tag_no)) + return ASN1_ERROR; + + head_tag = form | ((class_tag_no & 0x30000) >> 10); + class_tag_no = class_tag_no & 0xFFFF; + + if (class_tag_no <= 30) { + *(*curr)->curr = head_tag | class_tag_no; + (*curr)->curr -= 1; + (*count)++; + return ASN1_OK; + } else { + *(*curr)->curr = class_tag_no & 127; + class_tag_no = class_tag_no >> 7; + (*curr)->curr -= 1; + (*count)++; + + while (class_tag_no > 0) { + *(*curr)->curr = (class_tag_no & 127) | 0x80; + class_tag_no >>= 7; + (*curr)->curr -= 1; + (*count)++; + } + + *(*curr)->curr = head_tag | 0x1F; + (*curr)->curr -= 1; + (*count)++; + + return ASN1_OK; + } +} + +int ber_encode_length(size_t size, mem_chunk_t **curr, unsigned int *count) { + if (size < 128) { + if (ber_check_memory(curr, 1u)) + return ASN1_ERROR; + *(*curr)->curr = size; + (*curr)->curr -= 1; + (*count)++; + } else { + int chunks = size / 256 + 1; + if (ber_check_memory(curr, chunks + 1)) + return ASN1_ERROR; + + while (size > 0) + { + *(*curr)->curr = size & 0xFF; + size >>= 8; + (*curr)->curr -= 1; + (*count)++; + } + + *(*curr)->curr = chunks | 0x80; + (*curr)->curr -= 1; + (*count)++; + } + return ASN1_OK; +} + +mem_chunk_t *ber_new_chunk(unsigned int length) { + mem_chunk_t *new = enif_alloc(sizeof(mem_chunk_t)); + if (new == NULL) + return NULL; + new->next = NULL; + new->top = enif_alloc(sizeof(char) * length); + if (new->top == NULL) { + free(new); + return NULL; + } + new->curr = new->top + length - 1; + new->length = length; + return new; +} + +void ber_free_chunks(mem_chunk_t *chunk) { + mem_chunk_t *curr, *next = chunk; + while (next != NULL) { + curr = next; + next = curr->next; + enif_free(curr->top); + enif_free(curr); + } +} + +int ber_check_memory(mem_chunk_t **curr, unsigned int needed) { + mem_chunk_t *new; + if ((*curr)->curr-needed >= (*curr)->top) + return ASN1_OK; + + if ((new = ber_new_chunk((*curr)->length > needed ? (*curr)->length * 2 : (*curr)->length + needed)) == NULL) + return ASN1_ERROR; + new->next = *curr; + *curr = new; + return ASN1_OK; +} + +static ERL_NIF_TERM encode_per_complete(ErlNifEnv* env, int argc, + const ERL_NIF_TERM argv[]) { + ERL_NIF_TERM err_code; + ErlNifBinary in_binary; + ErlNifBinary out_binary; + int complete_len; + if (!enif_inspect_iolist_as_binary(env, argv[0], &in_binary)) + return enif_make_atom(env, "badarg"); + + if (!enif_alloc_binary(in_binary.size, &out_binary)) + return enif_make_atom(env, "alloc_binary_failed"); + + if (in_binary.size == 0) + return enif_make_binary(env, &out_binary); + + if ((complete_len = per_complete(&out_binary, in_binary.data, + in_binary.size)) <= ASN1_ERROR) { + enif_release_binary(&out_binary); + if (complete_len == ASN1_ERROR + ) + err_code = enif_make_uint(env, '1'); + else + err_code = enif_make_uint(env, 0); + return enif_make_tuple2(env, enif_make_atom(env, "error"), err_code); + } + if (complete_len < out_binary.size) + enif_realloc_binary(&out_binary, complete_len); + + return enif_make_binary(env, &out_binary); +} + +static ERL_NIF_TERM decode_ber_tlv(ErlNifEnv* env, int argc, + const ERL_NIF_TERM argv[]) { + ErlNifBinary in_binary; + ERL_NIF_TERM return_term; + unsigned int err_pos = 0, return_code; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &in_binary)) + return enif_make_badarg(env); + + if ((return_code = ber_decode_begin(env, &return_term, in_binary.data, + in_binary.size, &err_pos)) != ASN1_OK + ) + return enif_make_tuple2(env, enif_make_atom(env,"error"), enif_make_tuple2(env, + enif_make_int(env, return_code),enif_make_int(env, err_pos))); + return return_term; +} + +static ERL_NIF_TERM encode_ber_tlv(ErlNifEnv* env, int argc, + const ERL_NIF_TERM argv[]) { + ErlNifBinary out_binary; + unsigned int length = 0, pos = 0; + int encode_err; + mem_chunk_t *curr, *top; + ERL_NIF_TERM err_code; + + curr = ber_new_chunk(40); + + if ((encode_err = ber_encode(env, argv[0], &curr, &length)) + <= ASN1_ERROR) { + ber_free_chunks(curr); + err_code = enif_make_int(env, encode_err); + return enif_make_tuple2(env, enif_make_atom(env, "error"), err_code); + } + + if (!enif_alloc_binary(length, &out_binary)) { + ber_free_chunks(curr); + return enif_make_tuple2(env, enif_make_atom(env, "error"), enif_make_atom(env,"oom")); + } + + top = curr; + + while (curr != NULL) { + length = curr->length - (curr->curr-curr->top) -1; + if (length > 0) + memcpy(out_binary.data + pos, curr->curr+1, length); + pos += length; + curr = curr->next; + } + + ber_free_chunks(top); + + return enif_make_binary(env, &out_binary); +} + +static int is_ok_load_info(ErlNifEnv* env, ERL_NIF_TERM load_info) { + int i; + return enif_get_int(env, load_info, &i) && i == 1; +} + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) { + if (!is_ok_load_info(env, load_info)) + return -1; + return 0; +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, + ERL_NIF_TERM load_info) { + if (!is_ok_load_info(env, load_info)) + return -1; + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) { + +} + +static ErlNifFunc nif_funcs[] = { { "encode_per_complete", 1, + encode_per_complete }, { "decode_ber_tlv", 1, decode_ber_tlv }, { + "encode_ber_tlv", 1, encode_ber_tlv } }; + +ERL_NIF_INIT(asn1rt_nif, nif_funcs, load, NULL, upgrade, unload) diff --git a/lib/asn1/doc/src/Makefile b/lib/asn1/doc/src/Makefile index d29225f6c9..566173837c 100644 --- a/lib/asn1/doc/src/Makefile +++ b/lib/asn1/doc/src/Makefile @@ -27,15 +27,6 @@ include ../../vsn.mk VSN=$(ASN1_VSN) APPLICATION=asn1 - -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -86,34 +77,10 @@ EXTRA_FILES = \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) \ - $(BOOK_FILES:%.xml=%.sgml) part.tex -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -126,8 +93,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -142,32 +107,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f $(GEN_XML) errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -179,8 +118,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -191,31 +128,4 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(HTML_APPHISTORY) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -endif -endif - -endif - release_spec: - - - diff --git a/lib/asn1/doc/src/asn1_spec.xmlsrc b/lib/asn1/doc/src/asn1_spec.xmlsrc index 8d61834da8..07cba17816 100644 --- a/lib/asn1/doc/src/asn1_spec.xmlsrc +++ b/lib/asn1/doc/src/asn1_spec.xmlsrc @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2009</year> + <year>2003</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -43,7 +43,7 @@ <p>So far this functionality is only provided when using the optimized BER_BIN version, that is when compiling with the options <c>ber_bin</c> and <c>optimize</c>. It does also work - using the <c>driver</c> option. We have no intent to make this + using the <c>nif</c> option. We have no intent to make this available on the default BER version, but maybe in the PER_BIN version (<c>per_bin</c>). </p> @@ -661,7 +661,9 @@ ValAction = {'Action',17,{'Button',4711,false}}. <p>The ASN.1 specs in the test are compiled with the options <c>ber_bin, optimize, driver</c> and <c>asn1config</c>. If the <c>driver</c> option had been omitted there should have been - higher values for <c>decode</c> and <c>decode_part</c>. + higher values for <c>decode</c> and <c>decode_part</c>. These tests have + not been re-run using nifs, but are expected to perform about 5% better + than the linked-in driver. </p> <p>The test program runs 10000 decodes on the value, resulting in a printout with the elapsed time in microseconds for the diff --git a/lib/asn1/doc/src/asn1_ug.xml b/lib/asn1/doc/src/asn1_ug.xml index 12d986308f..1b399fb641 100644 --- a/lib/asn1/doc/src/asn1_ug.xml +++ b/lib/asn1/doc/src/asn1_ug.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1997</year><year>2010</year> + <year>1997</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -347,7 +347,7 @@ erlc -o ../asnfiles -I ../asnfiles -I /usr/local/standards/asn1 Person.asn <p>This flag has effect only when used together with one of <c>per_bin</c> or <c>ber_bin</c> flags. It gives time optimized code in the generated modules and it uses another runtime module. - In the <c>per_bin</c> case a linked-in driver is used. The + In the <c>per_bin</c> case a nif is used. The result from an encode is a binary.</p> <p><em>When this flag is used you cannot use the old format</em><c>{TypeName,Value}</c> when you encode values. Since it is an unnecessary construct it has been removed in favor of @@ -362,9 +362,14 @@ erlc -o ../asnfiles -I ../asnfiles -I /usr/local/standards/asn1 Person.asn </item> <tag><c>+driver</c></tag> <item> - <p>Together with the flags <c>ber_bin</c> and <c>optimize</c> - you choose to use a linked in driver for considerable faster - decode.</p> + <p>As of R15B this means the same as the <c>nif</c> option. Kept for + backwards compatability reasons.</p> + </item> + <tag><c>+nif</c></tag> + <item> + <p>Together with the flags <c>ber_bin</c> + and <c>optimize</c> you choose to use a nif for considerable + faster encode and decode. </p> </item> <tag><c>+asn1config</c></tag> <item> @@ -492,7 +497,7 @@ asn1ct:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> </row> <row> <cell align="left" valign="middle">BER</cell> - <cell align="left" valign="middle"><em>[ber_bin, optimize, driver]</em></cell> + <cell align="left" valign="middle"><em>[ber_bin, optimize, nif]</em></cell> <cell align="left" valign="middle">EAVF</cell> <cell align="left" valign="middle">iolist</cell> <cell align="left" valign="middle">iolist / binary</cell> @@ -557,7 +562,7 @@ asn1ct:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> </row> <row> <cell align="left" valign="middle">DER</cell> - <cell align="left" valign="middle"><em>[ber_bin, optimize, driver, der]</em></cell> + <cell align="left" valign="middle"><em>[ber_bin, optimize, nif, der]</em></cell> <cell align="left" valign="middle">EAVF</cell> <cell align="left" valign="middle">iolist</cell> <cell align="left" valign="middle">binary</cell> @@ -626,23 +631,24 @@ asn1ct:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> </table> <p> - The sole compile options <c>ber</c>, <c>ber_bin</c> and <c>per</c> - are kept for backwards compatibility and should not be used in - new code. + The compile options <c>ber</c>, <c>per</c> and + <c>driver</c> are kept for backwards compatibility and should not be + used in new code. The nif implementation which replaces the linked-in + driver has been shown to be about 5-15% faster. </p> <p> You are strongly recommended to use the appropriate alternative of the bold typed options. The <c>optimize</c> and - <c>driver</c> options does not affect the encode or decode + <c>nif</c> options does not affect the encode or decode result, just the time spent in run-time. When <c>ber_bin</c> and - <c>driver</c> or <c>per_bin, optimize</c> and <c>driver</c> is - combined the C-code driver is used in chosen parts of encode / + <c>nif</c> or <c>per_bin</c> and <c>optimize</c> is + combined the C-code nif is used in chosen parts of encode / decode procedure. </p> <table> <row> <cell align="left" valign="middle"><em>Compile options, allowed combinations</em></cell> - <cell align="left" valign="middle"><em>use of linked-in driver</em></cell> + <cell align="left" valign="middle"><em>use of nif</em></cell> </row> <row> <cell align="left" valign="middle">[ber]</cell> @@ -657,7 +663,7 @@ asn1ct:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> <cell align="left" valign="middle">no</cell> </row> <row> - <cell align="left" valign="middle"><em>[ber_bin, optimize, driver]</em></cell> + <cell align="left" valign="middle"><em>[ber_bin, optimize, nif]</em></cell> <cell align="left" valign="middle">yes</cell> </row> <row> @@ -690,12 +696,12 @@ asn1ct:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> <cell align="left" valign="middle">no</cell> </row> <row> - <cell align="left" valign="middle"><em>[ber_bin, optimize, driver, der]</em></cell> + <cell align="left" valign="middle"><em>[ber_bin, optimize, nif, der]</em></cell> <cell align="left" valign="middle">yes</cell> </row> - <tcaption>When the ASN1 linked-in driver is used.</tcaption> + <tcaption>When the ASN1 nif is used.</tcaption> </table> </section> @@ -712,14 +718,14 @@ asn1rt:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> <pre> 'H323-MESSAGES':encode('SomeChoiceType',{call,"octetstring"}). 'H323-MESSAGES':decode('SomeChoiceType',Bytes). </pre> - <p>The asn1 linked-in driver is enabled in two occasions: encoding of + <p>The asn1 nif is enabled in two occasions: encoding of asn1 values when the asn1 spec is compiled with <c>per_bin</c> and <c>optimize</c> or decode of encoded asn1 values when the asn1 spec is - compiled with <c>ber_bin</c>, <c>optimize</c> and <c>driver</c>. In - those cases the driver will be loaded automatically at the first call + compiled with <c>ber_bin</c>, <c>optimize</c> and <c>nif</c>. In + those cases the nif will be loaded automatically at the first call to <c>encode</c>/<c>decode</c>. If one doesn't want the performance - overhead of the driver being loaded at the first call it is possible - to load the driver separately by <c>asn1rt:load_driver()</c>. </p> + overhead of the nif being loaded at the first call it is possible + to load the nif separately by loading the <c>asn1rt_nif</c> module.</p> <p>By invoking the function <c>info/0</c> in a generated module, one gets information about which compiler options were used.</p> </section> diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml index 29b5d4be75..0b9ec3df7f 100644 --- a/lib/asn1/doc/src/asn1ct.xml +++ b/lib/asn1/doc/src/asn1ct.xml @@ -52,7 +52,7 @@ <v>Options = [Option| OldOption]</v> <v>Option = ber_bin | per_bin | uper_bin | der | compact_bit_string | noobj | {n2n,EnumTypeName} |{outdir,Dir} | {i,IncludeDir} | optimize | - driver | asn1config | undec_rest | {inline,OutputName} | inline | + nif | asn1config | undec_rest | {inline,OutputName} | inline | {macro_name_prefix, Prefix} | {record_name_prefix, Prefix} | verbose | warnings_as_errors</v> <v>OldOption = ber | per</v> <v>Reason = term()</v> @@ -212,16 +212,21 @@ Binary = binary() <c>per_bin</c> or <c>ber_bin</c> option. It gives time optimized code generated and it uses another runtime module and - in the <c>per_bin</c> case a linked-in driver. The result + in the <c>per_bin</c> case a nif. The result in the <c>per_bin</c> case from an encode when compiled with this option will be a binary.</p> </item> <tag><c>driver</c></tag> <item> + <p>As of R15B this means the same as the <c>nif</c> option. Kept for + backwards compatability reasons.</p> + </item> + <tag><c>nif</c></tag> + <item> <p>Option valid together with <c>ber_bin</c> and <c>optimize</c> - options. It enables the use of a linked-in driver that gives - considerable faster decode. In <c>ber_bin</c> the driver is - enabled only by explicit use of the option <c>driver</c>.</p> + options. It enables the use of several nifs that gives faster + encode and decode. Nifs are only enabled by the explicit use of + the option <c>nif</c></p> </item> <tag><c>asn1config</c></tag> <item> @@ -264,7 +269,11 @@ Binary = binary() <c>.set.asn</c> are exported, unless a <c>{export,[atom()]}</c> or <c>{export_all,true}</c> option are provided. The list of atoms are names of chosen asn1 - specs from the <c>.set.asn</c> file.</p> + specs from the <c>.set.asn</c> file. </p> + <p>When used together with <c>nif</c> for <c>ber_bin</c>, the + asn1 nifs will be used if the <c>asn1rt_nif</c> module is + available. If it is not available, a slower erlang fallback + will be used.</p> </item> <tag><c>inline</c></tag> <item> @@ -347,18 +356,6 @@ Binary = binary() </desc> </func> <func> - <name>validate(Module,Type,Value) -> ok | {error,Reason}</name> - <fsummary>Validate an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = term()</v> - </type> - <desc> - <p>Validates that <c>Value</c> conforms to <c>Type</c> - from <c>Module</c>. <em>Not implemented in this version of the ASN.1 application.</em></p> - </desc> - </func> - <func> <name>value(Module ,Type) -> {ok,Value} | {error,Reason}</name> <fsummary>Create an ASN.1 value for test purposes.</fsummary> <type> diff --git a/lib/asn1/doc/src/asn1rt.xml b/lib/asn1/doc/src/asn1rt.xml index 1217a07e9b..0c3c257189 100644 --- a/lib/asn1/doc/src/asn1rt.xml +++ b/lib/asn1/doc/src/asn1rt.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2009</year> + <year>1997</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -42,36 +42,6 @@ <funcs> <func> - <name>start() -> ok |{error,Reason}</name> - <fsummary>Starts the asn1 server.</fsummary> - <type> - <v>Reason = term()</v> - </type> - <desc> - <p>Starts the asn1 server that loads the drivers.</p> - <p>The server schedules a driver that is not blocked by - another caller. The driver is used by the asn1 application if - specs are compiled with options <c>[per_bin, optimize]</c> or - <c>[ber_bin, optimize, driver]</c>. The server will be started - automatically at encode/decode if it isn't done explicitly. If - encode/decode with driver is used in test or industrial code - it is a performance gain to start it explicitly to avoid the - one time load in run-time.</p> - </desc> - </func> - - <func> - <name>stop() -> ok |{error,Reason}</name> - <fsummary>Stops the asn1 server.</fsummary> - <type> - <v>Reason = term()</v> - </type> - <desc> - <p>Stops the asn1 server and unloads the drivers.</p> - </desc> - </func> - - <func> <name>decode(Module,Type,Bytes) -> {ok,Value}|{error,Reason}</name> <fsummary>Decode from bytes into an ASN.1 value.</fsummary> <type> @@ -126,35 +96,23 @@ <func> <name>load_driver() -> ok | {error,Reason}</name> - <fsummary>Loads the linked-in driver.</fsummary> + <fsummary>Loads the linked-in driver. (deprecated)</fsummary> <type> <v>Reason = term()</v> </type> <desc> - <p>This function loads the linked-in driver before the first call - to encode. If this function is not called the driver will be loaded - automatically at the first call to encode. If one doesn't want the - performance cost of a driver load when the application is running, - this function makes it possible to load the driver in an - initialization.</p> - <p>The driver is only used when encoding/decoding ASN.1 files that - were compiled with the options <c>per_bin</c> and <c>optimize</c>.</p> + <p>This function is obsolete and will be removed in R16A</p> </desc> </func> <func> <name>unload_driver() -> ok | {error,Reason}</name> - <fsummary>Unloads the linked-in driver.</fsummary> + <fsummary>Unloads the linked-in driver. (deprecated)</fsummary> <type> <v>Reason = term()</v> </type> <desc> - <p>This function unloads the linked-in driver. - When the driver has been loaded it remains in the environment until - it is unloaded. Normally the driver should remain loaded, it is - crucial for the performance of ASN.1 encoding. </p> - <p>The driver is only used when ASN.1 modules have been compiled - with the flags <c>per_bin</c> and <c>optimize</c>.</p> + <p>This function is obsolete and will be removed in R16A</p> </desc> </func> @@ -188,19 +146,6 @@ value, to a UTF8 encoded binary.</p> </desc> </func> - - <func> - <name>validate(Module,Type,Value) -> ok | {error,Reason}</name> - <fsummary>Validate an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = term()</v> - </type> - <desc> - <p>Validates that <c>Value</c> conforms to <c>Type</c> - from <c>Module</c>. <em>Not implemented in this version of the ASN.1 application.</em></p> - </desc> - </func> </funcs> diff --git a/lib/asn1/doc/src/make.dep b/lib/asn1/doc/src/make.dep deleted file mode 100644 index eb2c0e9a98..0000000000 --- a/lib/asn1/doc/src/make.dep +++ /dev/null @@ -1,31 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/gandalf/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: asn1_spec.tex asn1_ug.tex asn1ct.tex asn1rt.tex \ - book.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -asn1_spec.tex: Seq.asn Seq.asn1config - -book.tex: part.xml ref_man.xml - -asn1_ug.tex: ../../../../system/doc/definitions/cite.defs - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: exclusive_Win_But.ps selective_TypeList.ps \ - selective_Window2.ps - diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile index 2733cde3f8..3a59773d93 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# Copyright Ericsson AB 1997-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 @@ -68,7 +68,7 @@ RT_MODULES= \ asn1rt_per_bin_rt2ct \ asn1rt_uper_bin \ asn1rt_check \ - asn1rt_driver_handler + asn1rt_nif # asn1_sup \ # asn1_app \ # asn1_server diff --git a/lib/asn1/src/asn1.app.src b/lib/asn1/src/asn1.app.src index abacb0a1e9..09144ba2f7 100644 --- a/lib/asn1/src/asn1.app.src +++ b/lib/asn1/src/asn1.app.src @@ -9,12 +9,11 @@ asn1rt_ber_bin, asn1rt_ber_bin_v2, asn1rt_check, - asn1rt_driver_handler + asn1rt_nif ]}, {registered, [ asn1_ns, - asn1db, - asn1_driver_owner + asn1db ]}, {env, []}, {applications, [kernel, stdlib]} diff --git a/lib/asn1/src/asn1_app.erl b/lib/asn1/src/asn1_app.erl index 2d3eed1743..9fff96e0bf 100644 --- a/lib/asn1/src/asn1_app.erl +++ b/lib/asn1/src/asn1_app.erl @@ -28,7 +28,7 @@ %% {error, Reason} %% start(_Type, _StartArgs) -> - asn1_sup:start_link(). + {ok, self()}. %% stop(State) %% diff --git a/lib/asn1/src/asn1_server.erl b/lib/asn1/src/asn1_server.erl deleted file mode 100644 index aeb59d8b0c..0000000000 --- a/lib/asn1/src/asn1_server.erl +++ /dev/null @@ -1,107 +0,0 @@ -%% ``The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved via the world wide web at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id$ -%% - -%% Purpose: Provide complete encode/and pre-decode of asn1. --module(asn1_server). - - - --behaviour(gen_server). - --export([start_link/0,client_port/0]). - -%% Internal exports, call-back functions. --export([init/1,handle_call/3,handle_cast/2,handle_info/2,code_change/3, - terminate/2]). - - -%% Macros --define(port_names, - { asn1_drv01, asn1_drv02, asn1_drv03, asn1_drv04, - asn1_drv05, asn1_drv06, asn1_drv07, asn1_drv08, - asn1_drv09, asn1_drv10, asn1_drv11, asn1_drv12, - asn1_drv13, asn1_drv14, asn1_drv15, asn1_drv16 }). -%%% -------------------------------------------------------- -%%% Interface Functions. -%%% -------------------------------------------------------- - -start_link() -> - gen_server:start_link({local, asn1_server}, asn1_server, [], []). - -init([]) -> - process_flag(trap_exit, true), - erl_ddll:start(), - PrivDir = code:priv_dir(asn1), - LibDir1 = filename:join([PrivDir, "lib"]), - case erl_ddll:load_driver(LibDir1, asn1_erl_drv) of - ok -> ok; - {error,_} -> - LibDir2 = - filename:join(LibDir1, - erlang:system_info(system_architecture)), - erl_ddll:load_driver(LibDir2, asn1_erl_drv) - end, - open_ports("asn1_erl_drv",size(?port_names)). - -open_ports(_,0) -> - {ok, []}; -open_ports(Cmd,N) -> - Port = open_port({spawn, Cmd}, []), - %% check that driver is loaded, linked and working - case catch port_control(Port, 0, []) of - {'EXIT', _} -> - {stop, nodriver}; - _ -> - register(element(N,?port_names), Port), - open_ports(Cmd,N-1) - end. - -client_port() -> - element(erlang:system_info(scheduler_id) rem size(?port_names) + 1, - ?port_names). - - -%%% -------------------------------------------------------- -%%% The call-back functions. -%%% -------------------------------------------------------- - -handle_call(_, _, State) -> - {noreply, State}. - -handle_cast(_, State) -> - {noreply, State}. - -handle_info({'EXIT', Pid, _Reason}, State) when is_pid(Pid) -> - {noreply, State}; - -handle_info({'EXIT', Port, Reason}, State) when is_port(Port) -> - {stop, {port_died, Reason}, State}; -handle_info(_, State) -> - {noreply, State}. - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -terminate(_Reason, _State) -> - close_ports(size(?port_names)). - -close_ports(0) -> - ok; -close_ports(N) -> - element(N,?port_names) ! {self(), close}, %% almost same as port_close(Name) - close_ports(N-1). diff --git a/lib/asn1/src/asn1_sup.erl b/lib/asn1/src/asn1_sup.erl deleted file mode 100644 index a241dec6f4..0000000000 --- a/lib/asn1/src/asn1_sup.erl +++ /dev/null @@ -1,37 +0,0 @@ -%% ``The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved via the world wide web at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id$ -%% - -%% Purpose: Main supervisor in asn1 application. - --module(asn1_sup). - --behaviour(supervisor). - --export([start_link/0, init/1]). - -start_link() -> - supervisor:start_link({local, asn1_sup}, asn1_sup, []). - - -%% init([]) -%% Returns: {ok, {SupFlags, [ChildSpec]}} -%% -init([]) -> - Child = {asn1_server, {asn1_server, start_link, []}, - permanent, 2000, worker, [asn1_server]}, - {ok, {{one_for_all, 10, 3600}, [Child]}}. diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index e26fadd160..85bb5b2f28 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -47,6 +47,10 @@ -import(asn1ct_gen_ber_bin_v2,[encode_tag_val/3,decode_class/1]). +-ifndef(vsn). +-define(vsn,"0.0.1"). +-endif. + -define(unique_names,0). -define(dupl_uniquedefs,1). -define(dupl_equaldefs,2). @@ -81,6 +85,12 @@ compile(File) -> compile(File,[]). compile(File,Options) when is_list(Options) -> + case lists:member(driver, Options) of %% remove me in R16A! + true -> + io:format("Warning: driver option is obsolete and will be removed in R16A, use nif instead!"); + false -> + ok + end, Options1 = optimize_ber_bin(Options), Options2 = includes(File,Options1), Includes=[I||{i,I}<-Options2], @@ -1085,7 +1095,7 @@ get_runtime_mod(Options) -> ber_bin_v2 -> ["asn1rt_ber_bin_v2.erl"]; uper_bin -> ["asn1rt_uper_bin.erl"] end, - RtMod1++["asn1rt_check.erl","asn1rt_driver_handler.erl","asn1rt.erl"]. + RtMod1++["asn1rt_check.erl","asn1rt.erl"]. erl_compile(OutFile,Options) -> diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index e3be914af4..243ff234a7 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -877,13 +877,13 @@ gen_dec_choice(Erules,TopType, _ChTag, CompList, Ext) -> emit([indent(9),"exit({error,{asn1,{invalid_choice_tag,", {curr,else},"}}})",nl]); _ -> - emit([indent(9),"{asn1_ExtAlt, ?RT_BER:encode(",{curr,else},")}",nl]) + emit([indent(9),"{asn1_ExtAlt, ?RT_BER:encode(",{curr,else}, + asn1ct_gen:nif_parameter(),")}",nl]) end, emit([indent(3),"end",nl]), asn1ct_name:new(tag), asn1ct_name:new(else). - gen_dec_choice_cases(_Erules,_TopType, []) -> ok; gen_dec_choice_cases(Erules,TopType, [H|T]) -> @@ -1227,7 +1227,7 @@ gen_dec_call({typefield,_},_,_,_Cname,Type,BytesVar,Tag,_,_,false,_) -> emit([nl,indent(6),"begin",nl]), % emit([indent(9),{curr,opendec}," = ?RT_BER:decode_open_type(", emit([indent(9),{curr,tmptlv}," = ?RT_BER:decode_open_type(", - BytesVar,",",{asis,Tag},"),",nl]), + BytesVar,",",{asis,Tag},asn1ct_gen:nif_parameter(),"),",nl]), % emit([indent(9),"{",{curr,tmptlv},",_} = ?RT_BER:decode(", % {curr,opendec},"),",nl]), @@ -1242,7 +1242,8 @@ gen_dec_call({typefield,_},_,_,_Cname,Type,BytesVar,Tag,_,_,false,_) -> emit([indent(9),"end",nl,indent(6),"end",nl]), []; gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandComp) -> - emit(["?RT_BER:decode_open_type(",BytesVar,",",{asis,Tag},")"]), + emit(["?RT_BER:decode_open_type(",BytesVar,",",{asis,Tag}, + asn1ct_gen:nif_parameter(),")"]), RefedFieldName = % asn1ct_gen:get_constraint(Type#type.constraint, % tableconstraint_info), @@ -1250,7 +1251,8 @@ gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandC [{Cname,RefedFieldName,asn1ct_gen:mk_var(asn1ct_name:curr(term)), asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; gen_dec_call({objectfield,PrimFieldName,PFNList},_,_,Cname,_,BytesVar,Tag,_,_,_,OptOrMandComp) -> - emit(["?RT_BER:decode_open_type(",BytesVar,",",{asis,Tag},")"]), + emit(["?RT_BER:decode_open_type(",BytesVar,",",{asis,Tag}, + asn1ct_gen:nif_parameter(),")"]), [{Cname,{PrimFieldName,PFNList},asn1ct_gen:mk_var(asn1ct_name:curr(term)), asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; gen_dec_call(InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,PrimOptOrMand, diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index c1b6aa5713..e07680f10b 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -73,16 +73,23 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> _ -> ok end, - case {Optionals = optionals(to_textual_order(CompList)),CompList} of - {[],EmptyCL} when EmptyCL == {[],[],[]};EmptyCL == {[],[]};EmptyCL == [] -> + case {Optionals = optionals(to_textual_order(CompList)),CompList, + is_optimized(Erule)} of + {[],EmptyCL,_} when EmptyCL == {[],[],[]};EmptyCL == {[],[]};EmptyCL == [] -> emit(["%%Variable setting just to eliminate ", "compiler warning for unused vars!",nl, "_Val = ",{curr,val},",",nl]); - {[],_} -> + {[],_,_} -> emit([{next,val}," = ?RT_PER:list_to_record("]), emit(["'",asn1ct_gen:list2rname(Typename),"'"]), emit([", ",{curr,val},"),",nl]); - _ -> + {_,_,true} -> + gen_fixoptionals(Optionals), + FixOpts = param_map(fun(Var) -> + {var,Var} + end,asn1ct_name:all(fixopt)), + emit({"{",{next,val},",Opt} = {",{curr,val},",[",FixOpts,"]},",nl}); + {_,_,false} -> Fixoptcall = ",Opt} = ?RT_PER:fixoptionals(", emit({"{",{next,val},Fixoptcall, {asis,Optionals},",",length(Optionals), @@ -439,9 +446,7 @@ gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) -> _-> "" end, - emit({nl,indent(3),"?RT_PER:encode_length(", - {asis,SizeConstraint}, - ",length(Val)),",nl}), + gen_encode_length(SizeConstraint, is_optimized(Erule)), emit({indent(3),"'enc_",asn1ct_gen:list2name(Typename), "_components'(Val",ObjFun,", [])"}), emit({nl,"].",nl}), @@ -453,6 +458,42 @@ gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) -> end, gen_encode_sof_components(Erule,Typename,SeqOrSetOf,NewComponentType). + +%% Logic copied from asn1_per_bin_rt2ct:encode_constrained_number +gen_encode_length({Lb,Ub},true) when Ub =< 65535, Lb >= 0 -> + Range = Ub - Lb + 1, + V2 = ["(length(Val) - ",Lb,")"], + Encode = if + Range == 1 -> + "[]"; + Range == 2 -> + {"[",V2,"]"}; + Range =< 4 -> + {"[10,2,",V2,"]"}; + Range =< 8 -> + {"[10,3,",V2,"]"}; + Range =< 16 -> + {"[10,4,",V2,"]"}; + Range =< 32 -> + {"[10,5,",V2,"]"}; + Range =< 64 -> + {"[10,6,",V2,"]"}; + Range =< 128 -> + {"[10,7,",V2,"]"}; + Range =< 255 -> + {"[10,8,",V2,"]"}; + Range =< 256 -> + {"[20,1,",V2,"]"}; + Range =< 65536 -> + {"[20,2,<<",V2,":16>>]"}; + true -> + {"?RT_PER:encode_length(",{asis,{Lb,Ub}},",length(Val))"} + end, + emit({nl,Encode,",",nl}); +gen_encode_length(SizeConstraint,_) -> + emit({nl,indent(3),"?RT_PER:encode_length(", + {asis,SizeConstraint},",length(Val)),",nl}). + gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) -> asn1ct_name:start(), {_SeqOrSetOf,ComponentType} = D#type.def, @@ -469,7 +510,8 @@ gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) -> _ -> "" end, - emit({nl,"{Num,Bytes1} = ?RT_PER:decode_length(Bytes,",{asis,SizeConstraint},"),",nl}), + gen_decode_length(SizeConstraint, + is_optimized(Erules)), emit({"'dec_",asn1ct_gen:list2name(Typename), "_components'(Num, Bytes1, telltype",ObjFun,", []).",nl}), NewComponentType = @@ -480,6 +522,41 @@ gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) -> end, gen_decode_sof_components(Erules,Typename,SeqOrSetOf,NewComponentType). +%% Logic copied from asn1_per_bin_rt2ct:decode_constrained_number +gen_decode_length({Lb,Ub},true) when Ub =< 65535, Lb >= 0 -> + Range = Ub - Lb + 1, + Call = if + Range == 1 -> + "{0,Bytes}"; + Range == 2 -> + "?RT_PER:getbits(Bytes,1)"; + Range =< 4 -> + "?RT_PER:getbits(Bytes,2)"; + Range =< 8 -> + "?RT_PER:getbits(Bytes,3)"; + Range =< 16 -> + "?RT_PER:getbits(Bytes,4)"; + Range =< 32 -> + "?RT_PER:getbits(Bytes,5)"; + Range =< 64 -> + "?RT_PER:getbits(Bytes,6)"; + Range =< 128 -> + "?RT_PER:getbits(Bytes,7)"; + Range =< 255 -> + "?RT_PER:getbits(Bytes,8)"; + Range =< 256 -> + "?RT_PER:getoctets(Bytes,1)"; + Range =< 65536 -> + "?RT_PER:getoctets(Bytes,2)"; + true -> + ["exit({not_supported,{integer_range,",Range,"}}"] + end, + emit({nl,"{Val,Remain} = ",Call,",",nl}), + emit({nl,"{Num,Bytes1} = {Val+",Lb,",Remain},",nl}); +gen_decode_length(SizeConstraint,_) -> + emit({nl,"{Num,Bytes1} = ?RT_PER:decode_length(Bytes,", + {asis,SizeConstraint},"),",nl}). + gen_encode_sof_components(Erule,Typename,SeqOrSetOf,Cont) -> {ObjFun,ObjFun_Var} = case Cont#type.tablecinf of @@ -636,6 +713,27 @@ gen_dec_extension_value(_) -> emit({"{Ext,",{next,bytes},"} = ?RT_PER:getext(",{curr,bytes},")"}), asn1ct_name:new(bytes). +gen_fixoptionals([{Pos,Def}|R]) -> + asn1ct_name:new(fixopt), + emit({{curr,fixopt}," = case element(",{asis,Pos},",",{curr,val},") of",nl, + "asn1_DEFAULT -> 0;",nl, + {asis,Def}," -> 0;",nl, + "_ -> 1",nl, + "end,",nl}), + gen_fixoptionals(R); +gen_fixoptionals([Pos|R]) -> + gen_fixoptionals([{Pos,asn1_NOVALUE}|R]); +gen_fixoptionals([]) -> + ok. + + +param_map(Fun, [H]) -> + [Fun(H)]; +param_map(Fun, [H|T]) -> + [Fun(H),","|param_map(Fun,T)]. + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Produce a list with positions (in the Value record) where %% there are optional components, start with 2 because first element @@ -922,7 +1020,7 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> end, case Ext of {ext,_Ep2,_} -> - emit(["))"]); + emit("))"); _ -> true end. gen_dec_components_call(Erule,TopType,{Root1,ExtList,Root2},MaybeComma,DecInfObj,Ext,NumberOfOptionals) -> diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index e49829d82f..0f8833f716 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -47,6 +47,7 @@ un_hyphen_var/1]). -export([gen_encode_constructed/4, gen_decode_constructed/4]). +-export([nif_parameter/0]). %% pgen(Outfile, Erules, Module, TypeOrVal, Options) %% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module @@ -938,13 +939,13 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> NoFinalPadding = lists:member(no_final_padding,get(encoding_options)), Call = case Erules of per -> "?RT_PER:complete(encode_disp(Type,Data))"; - per_bin -> "?RT_PER:complete(encode_disp(Type,Data))"; + per_bin -> ["?RT_PER:complete(encode_disp(Type,Data))"]; ber -> "encode_disp(Type,Data)"; ber_bin -> "encode_disp(Type,Data)"; ber_bin_v2 -> "encode_disp(Type,Data)"; uper_bin when NoFinalPadding == true -> "?RT_PER:complete_NFP(encode_disp(Type,Data))"; - uper_bin -> "?RT_PER:complete(encode_disp(Type,Data))" + uper_bin -> ["?RT_PER:complete(encode_disp(Type,Data))"] end, EncWrap = case Erules of ber -> "wrap_encode(Bytes)"; @@ -974,7 +975,7 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> % case Erules of % ber_bin_v2 -> % emit(["decode(Type,Data0) ->",nl]), -% emit(["{Data,_RestBin} = ?RT_BER:decode(Data0",driver_parameter(),"),",nl]); +% emit(["{Data,_RestBin} = ?RT_BER:decode(Data0",nif_parameter(),"),",nl]); % _ -> % emit(["decode(Type,Data) ->",nl]) % end, @@ -991,10 +992,10 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> {ber_bin_v2,false} -> io_lib:format("~s~s~s~n", ["element(1,?RT_BER:decode(Data", - driver_parameter(),"))"]); + nif_parameter(),"))"]); {ber_bin_v2,true} -> emit(["{Data,Rest} = ?RT_BER:decode(Data0", - driver_parameter(),"),",nl]), + nif_parameter(),"),",nl]), "Data"; _ -> "Data" @@ -1130,13 +1131,8 @@ gen_decode_partial_incomplete(Erule) when Erule == ber;Erule==ber_bin; "Data) of",nl]), EmitCaseClauses(), emit(["decode_part(Type,Data0) ->",nl]), - Driver = - case lists:member(driver,get(encoding_options)) of - true -> - ",driver"; - _ -> "" - end, - emit([" case catch decode_inc_disp(Type,element(1,?RT_BER:decode(Data0",Driver,"))) of",nl]), + emit([" case catch decode_inc_disp(Type,element(1," + "?RT_BER:decode(Data0",nif_parameter(),"))) of",nl]), % " {Data,_RestBin} = ?RT_BER:decode(Data0),",nl, % " case catch decode_inc_disp(Type,Data) of",nl]), EmitCaseClauses(); @@ -1179,12 +1175,12 @@ gen_partial_inc_dispatcher([],_) -> emit(["decode_partial_inc_disp(Type,_Data) ->",nl, " exit({error,{asn1,{undefined_type,Type}}}).",nl]). -driver_parameter() -> +nif_parameter() -> Options = get(encoding_options), - case lists:member(driver,Options) of - true -> - ",driver"; - _ -> "" + case {lists:member(driver,Options),lists:member(nif,Options)} of + {true,_} -> ",nif"; + {_,true} -> ",nif"; + _ -> "" end. gen_wrapper() -> @@ -1525,8 +1521,9 @@ gen_head(Erules,Mod,Hrl) -> emit({"-module('",Mod,"').",nl}), put(currmod,Mod), %emit({"-compile(export_all).",nl}), - case Hrl of - 0 -> true; + case {Hrl,lists:member(inline,get(encoding_options))} of + {0,_} -> true; + {_,true} -> true; _ -> emit({"-include(\"",Mod,".hrl\").",nl}) end, diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index 9ec458e351..781271bae7 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -416,7 +416,7 @@ gen_decode_selected(Erules,Type,FuncName) -> end, emit([" case ?RT_BER:decode_selective(",{asis,Pattern},",Bin) of",nl, " {ok,Bin2} when is_binary(Bin2) ->",nl, - " {Tlv,_} = ?RT_BER:decode(Bin2),",nl]), + " {Tlv,_} = ?RT_BER:decode(Bin2",asn1ct_gen:nif_parameter(),"),",nl]), emit("{ok,"), gen_decode_selected_type(Erules,Type), emit(["};",nl," Err -> exit({error,{selctive_decode,Err}})",nl, @@ -708,7 +708,7 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) -> 'ASN1_OPEN_TYPE' -> emit(["?RT_BER:decode_open_type_as_binary(", BytesVar,","]), - add_func({decode_open_type_as_binary,2}); + add_func({decode_open_type_as_binary,3}); #'ObjectClassFieldType'{} -> case asn1ct_gen:get_inner(Att#type.def) of {fixedtypevaluefield,_,InnerType} -> @@ -716,7 +716,7 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) -> 'ASN1_OPEN_TYPE' -> emit(["?RT_BER:decode_open_type_as_binary(", BytesVar,","]), - add_func({decode_open_type_as_binary,2}); + add_func({decode_open_type_as_binary,3}); Other -> exit({'can not decode' ,Other}) end; @@ -728,13 +728,13 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) -> {_,#'ObjectClassFieldType'{}} -> case asn1ct_gen:get_inner(Att#type.def) of 'ASN1_OPEN_TYPE' -> - emit([{asis,DoTag},")"]); + emit([{asis,DoTag},asn1ct_gen:nif_parameter(),")"]); _ -> ok end; {{string,TagStr},'ASN1_OPEN_TYPE'} -> - emit([TagStr,")"]); + emit([TagStr,asn1ct_gen:nif_parameter(),")"]); {_,'ASN1_OPEN_TYPE'} -> - emit([{asis,DoTag},")"]); + emit([{asis,DoTag},asn1ct_gen:nif_parameter(),")"]); {{string,TagStr},_} -> emit([TagStr,")"]); _ when is_list(DoTag) -> @@ -1064,7 +1064,7 @@ emit_tlv_format_function() -> end. emit_tlv_format_function1() -> emit(["tlv_format(Bytes) when is_binary(Bytes) ->",nl, - " {Tlv,_}=?RT_BER:decode(Bytes),",nl, + " {Tlv,_}=?RT_BER:decode(Bytes",asn1ct_gen:nif_parameter(),"),",nl, " Tlv;",nl, "tlv_format(Bytes) ->",nl, " Bytes.",nl]). @@ -1502,13 +1502,14 @@ gen_objset_dec(Erules,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, _ClFields,_NthObj) -> emit(["'getdec_",ObjSetName,"'(_, _) ->",nl]), emit([indent(2),"fun(_,Bytes, _RestPrimFieldName) ->",nl]), + case Erules of ber_bin_v2 -> emit([indent(4),"case Bytes of",nl, indent(6),"Bin when is_binary(Bin) -> ",nl, indent(8),"Bin;",nl, indent(6),"_ ->",nl, - indent(8),"?RT_BER:encode(Bytes)",nl, + indent(8),"?RT_BER:encode(Bytes",driver_parameter(),")",nl, indent(4),"end",nl]); _ -> emit([indent(6),"Len = case Bytes of",nl,indent(9), @@ -1521,6 +1522,14 @@ gen_objset_dec(Erules,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, gen_objset_dec(_,_,_,[],_,_,_) -> ok. +driver_parameter() -> + Options = get(encoding_options), + case {lists:member(driver,Options),lists:member(nif,Options)} of + {true,_} -> ",nif"; + {_,true} -> ",nif"; + _ -> ",erlang" + end. + emit_default_getdec(ObjSetName,UniqueName) -> emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), emit([indent(2), "fun(C,V,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]). diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 8313cf1b60..b90a0adf81 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -238,7 +238,8 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); [#type{def=#'Externaltypereference'{type=Tname}}] -> io_lib:format( - "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); + "?RT_PER:complete(enc_~s(~s))", + [Tname,Value]); _ -> Value end, emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl index 4f4fcfafc3..1a0a0e211d 100644 --- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl +++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% Copyright Ericsson AB 2002-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 @@ -230,7 +230,8 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); [#type{def=#'Externaltypereference'{type=Tname}}] -> io_lib:format( - "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); + "?RT_PER:complete(enc_~s(~s))", + [Tname,Value]); _ -> Value end, emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", diff --git a/lib/asn1/src/asn1rt.erl b/lib/asn1/src/asn1rt.erl index 9ef68efab5..d18f81346a 100644 --- a/lib/asn1/src/asn1rt.erl +++ b/lib/asn1/src/asn1rt.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -21,12 +21,12 @@ %% Runtime functions for ASN.1 (i.e encode, decode) --include("asn1_records.hrl"). - -export([encode/2,encode/3,decode/3,load_driver/0,unload_driver/0,info/1]). -export([utf8_binary_to_list/1,utf8_list_to_binary/1]). +-deprecated([load_driver/0,unload_driver/0]). + encode(Module,{Type,Term}) -> encode(Module,Type,Term). @@ -46,38 +46,12 @@ decode(Module,Type,Bytes) -> Result end. -%% asn1-1.6.8.1 -%% load_driver() -> -%% asn1rt_driver_handler:load_driver(), -%% receive -%% driver_ready -> -%% ok; -%% Err={error,_Reason} -> -%% Err; -%% Error -> -%% {error,Error} -%% end. - -%% asn1-1.6.9 - load_driver() -> - case catch asn1rt_driver_handler:load_driver() of - ok -> - ok; - {error,{already_started,asn1}} -> - ok; - Err -> - {error,Err} - end. - +%% Remove in R16A +load_driver() -> + ok. unload_driver() -> - case catch asn1rt_driver_handler:unload_driver() of - ok -> - ok; - Error -> - {error,Error} - end. - + ok. info(Module) -> case catch apply(Module,info,[]) of diff --git a/lib/asn1/src/asn1rt_ber_bin_v2.erl b/lib/asn1/src/asn1rt_ber_bin_v2.erl index a3bb570282..17e66f77c9 100644 --- a/lib/asn1/src/asn1rt_ber_bin_v2.erl +++ b/lib/asn1/src/asn1rt_ber_bin_v2.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-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 @@ -21,7 +21,7 @@ %% encoding / decoding of BER --export([decode/1, decode/2, match_tags/2, encode/1]). +-export([decode/1, decode/2, match_tags/2, encode/1, encode/2]). -export([fixoptionals/2, cindex/3, list_to_record/2, encode_tag_val/1, @@ -49,11 +49,13 @@ decode_tag_and_length/1]). -export([encode_open_type/1,encode_open_type/2, - decode_open_type/2,decode_open_type_as_binary/2]). + decode_open_type/2,decode_open_type/3, + decode_open_type_as_binary/2, + decode_open_type_as_binary/3]). -export([decode_primitive_incomplete/2,decode_selective/2]). - --include("asn1_records.hrl"). + +-export([is_nif_loadable/0]). % the encoding of class of tag bits 8 and 7 -define(UNIVERSAL, 0). @@ -125,15 +127,28 @@ % encode(Tlv) -> % encode_constructed(Tlv). -encode([Tlv]) -> - encode(Tlv); -encode({TlvTag,TlvVal}) when is_list(TlvVal) -> +encode(Tlv) -> + encode(Tlv,erlang). + +encode(Tlv,_) when is_binary(Tlv) -> + Tlv; +encode([Tlv],Method) -> + encode(Tlv,Method); +encode(Tlv, nif) -> + case is_nif_loadable() of + true -> + asn1rt_nif:encode_ber_tlv(Tlv); + false -> + encode_erl(Tlv) + end; +encode(Tlv, _) -> + encode_erl(Tlv). + +encode_erl({TlvTag,TlvVal}) when is_list(TlvVal) -> %% constructed form of value encode_tlv(TlvTag,TlvVal,?CONSTRUCTED); -encode({TlvTag,TlvVal}) -> - encode_tlv(TlvTag,TlvVal,?PRIMITIVE); -encode(Bin) when is_binary(Bin) -> - Bin. +encode_erl({TlvTag,TlvVal}) -> + encode_tlv(TlvTag,TlvVal,?PRIMITIVE). encode_tlv(TlvTag,TlvVal,Form) -> Tag = encode_tlv_tag(TlvTag,Form), @@ -152,70 +167,61 @@ encode_tlv_val(Bin) -> {Bin,size(Bin)}. encode_tlv_list([Tlv|Tlvs],Acc) -> - EncTlv = encode(Tlv), + EncTlv = encode_erl(Tlv), encode_tlv_list(Tlvs,[EncTlv|Acc]); encode_tlv_list([],Acc) -> Bin=list_to_binary(lists:reverse(Acc)), {Bin,size(Bin)}. -%% asn1-1.6.8.1 -%% decode(B,driver) -> -%% case catch port_control(asn1_driver_port,2,B) of -%% Bin when is_binary(Bin) -> -%% binary_to_term(Bin); -%% List when is_list(List) -> handle_error(List,B); -%% {'EXIT',{badarg,Reason}} -> -%% asn1rt_driver_handler:load_driver(), -%% receive -%% driver_ready -> -%% case catch port_control(asn1_driver_port,2,B) of -%% Bin2 when is_binary(Bin2) -> binary_to_term(Bin2); -%% List when is_list(List) -> handle_error(List,B); -%% Error -> exit(Error) -%% end; -%% {error,Error} -> % error when loading driver -%% %% the driver could not be loaded -%% exit(Error); -%% Error={port_error,Reason} -> -%% exit(Error) -%% end; -%% {'EXIT',Reason} -> -%% exit(Reason) -%% end. - -%% asn1-1.6.9 -decode(B,driver) -> - case catch control(?TLV_DECODE,B) of - Bin when is_binary(Bin) -> - binary_to_term(Bin); - List when is_list(List) -> handle_error(List,B); - {'EXIT',{badarg,_Reason}} -> - case asn1rt:load_driver() of - ok -> - case control(?TLV_DECODE,B) of - Bin when is_binary(Bin) -> binary_to_term(Bin); - List when is_list(List) -> handle_error(List,B) - end; - Err -> - Err - end - end. +decode(B) -> + decode(B, erlang). +%% asn1-1.7 +decode(B, nif) -> + case is_nif_loadable() of + true -> + case asn1rt_nif:decode_ber_tlv(B) of + {error, Reason} -> handle_error(Reason, B); + Else -> Else + end; + false -> + decode(B) + end; +decode(B,erlang) when is_binary(B) -> + decode_primitive(B); +decode(Tlv,erlang) -> + {Tlv,<<>>}. + +%% Have to check this since asn1 is not guaranteed to be available +is_nif_loadable() -> + case application:get_env(asn1, nif_loadable) of + {ok,R} -> + R; + undefined -> + case catch code:load_file(asn1rt_nif) of + {module, asn1rt_nif} -> + application:set_env(asn1, nif_loadable, true), + true; + _Else -> + application:set_env(asn1, nif_loadable, false), + false + end + end. handle_error([],_)-> exit({error,{asn1,{"memory allocation problem"}}}); -handle_error([$1|_],L) -> % error in driver +handle_error({$1,_},L) -> % error in nif exit({error,{asn1,L}}); -handle_error([$2|T],L) -> % error in driver due to wrong tag +handle_error({$2,T},L) -> % error in nif due to wrong tag exit({error,{asn1,{"bad tag after byte:",error_pos(T),L}}}); -handle_error([$3|T],L) -> % error in driver due to length error +handle_error({$3,T},L) -> % error in driver due to length error exit({error,{asn1,{"bad length field after byte:", error_pos(T),L}}}); -handle_error([$4|T],L) -> % error in driver due to indefinite length error +handle_error({$4,T},L) -> % error in driver due to indefinite length error exit({error,{asn1, {"indefinite length without end bytes after byte:", error_pos(T),L}}}); -handle_error([$5|T],L) -> % error in driver due to indefinite length error +handle_error({$5,T},L) -> % error in driver due to indefinite length error exit({error,{asn1,{"bad encoded value after byte:", error_pos(T),L}}}); handle_error(ErrL,L) -> @@ -228,16 +234,6 @@ error_pos([B])-> error_pos([B|Bs]) -> BS = 8 * length(Bs), B bsl BS + error_pos(Bs). -%% asn1-1.6.9 -control(Cmd, Data) -> - Port = asn1rt_driver_handler:client_port(), - erlang:port_control(Port, Cmd, Data). - -decode(Bin) when is_binary(Bin) -> - decode_primitive(Bin); -decode(Tlv) -> % assume it is a tlv - {Tlv,<<>>}. - decode_primitive(Bin) -> {Form,TagNo,V,Rest} = decode_tag_and_length(Bin), @@ -796,20 +792,24 @@ encode_open_type(Val,Tag) -> %% Value = binary with decoded data (which must be decoded again as some type) %% decode_open_type(Tlv, TagIn) -> + decode_open_type(Tlv, TagIn, erlang). +decode_open_type(Tlv, TagIn, Method) -> case match_tags(Tlv,TagIn) of Bin when is_binary(Bin) -> - {InnerTlv,_} = decode(Bin), + {InnerTlv,_} = decode(Bin,Method), InnerTlv; TlvBytes -> TlvBytes end. -decode_open_type_as_binary(Tlv,TagIn)-> +decode_open_type_as_binary(Tlv, TagIn) -> + decode_open_type_as_binary(Tlv, TagIn, erlang). +decode_open_type_as_binary(Tlv,TagIn, Method)-> case match_tags(Tlv,TagIn) of V when is_binary(V) -> V; - [Tlv2] -> encode(Tlv2); - Tlv2 -> encode(Tlv2) + [Tlv2] -> encode(Tlv2, Method); + Tlv2 -> encode(Tlv2, Method) end. %%=============================================================================== @@ -1056,7 +1056,7 @@ encode_real(C,Val, TagIn) when is_tuple(Val); is_list(Val) -> encode_real(C,Val) -> - ?RT_COMMON:encode_real(C,Val). + asn1rt_ber_bin:encode_real(C,Val). %%============================================================================ @@ -1081,7 +1081,7 @@ decode_real_notag(Buffer) -> {_T,_V} -> exit({error,{asn1,{real_not_in_primitive_form,Buffer}}}) end, - {Val,_Rest,Len} = ?RT_COMMON:decode_real(Buffer,Len), + {Val,_Rest,Len} = asn1rt_ber_bin:decode_real(Buffer,Len), Val. %% exit({error,{asn1, {unimplemented,real}}}). %% decode_real2(Buffer, Form, size(Buffer)). @@ -1577,14 +1577,12 @@ e_object_identifier(V) when is_tuple(V) -> e_object_identifier([E1, E2 | Tail]) -> Head = 40*E1 + E2, % wow! {H,Lh} = mk_object_val(Head), - {R,Lr} = enc_obj_id_tail(Tail, [], 0), + {R,Lr} = lists:mapfoldl(fun enc_obj_id_tail/2,0,Tail), {[H|R], Lh+Lr}. -enc_obj_id_tail([], Ack, Len) -> - {lists:reverse(Ack), Len}; -enc_obj_id_tail([H|T], Ack, Len) -> +enc_obj_id_tail(H, Len) -> {B, L} = mk_object_val(H), - enc_obj_id_tail(T, [B|Ack], Len+L). + {B,Len+L}. %%%%%%%%%%% diff --git a/lib/asn1/src/asn1rt_check.erl b/lib/asn1/src/asn1rt_check.erl index 24a2a3802d..d9856901b8 100644 --- a/lib/asn1/src/asn1rt_check.erl +++ b/lib/asn1/src/asn1rt_check.erl @@ -19,8 +19,6 @@ %% -module(asn1rt_check). --include("asn1_records.hrl"). - -export([check_bool/2, check_int/3, check_bitstring/3, diff --git a/lib/asn1/src/asn1rt_driver_handler.erl b/lib/asn1/src/asn1rt_driver_handler.erl deleted file mode 100644 index 146d0043f9..0000000000 --- a/lib/asn1/src/asn1rt_driver_handler.erl +++ /dev/null @@ -1,144 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-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% -%% -%% - --module(asn1rt_driver_handler). - --include("asn1_records.hrl"). - --export([load_driver/0,unload_driver/0,client_port/0]). - -%% Internal exports --export([init/2]). - -%% Macros --define(port_names, - { asn1_drv01, asn1_drv02, asn1_drv03, asn1_drv04, - asn1_drv05, asn1_drv06, asn1_drv07, asn1_drv08, - asn1_drv09, asn1_drv10, asn1_drv11, asn1_drv12, - asn1_drv13, asn1_drv14, asn1_drv15, asn1_drv16 }). - -%%% -------------------------------------------------------- -%%% Interface Functions. -%%% -------------------------------------------------------- -load_driver() -> - load_driver(noreason). - -load_driver(Reason) -> - Ref = make_ref(), - case whereis(asn1_driver_owner) of % to prevent unnecessary spawn - Pid when is_pid(Pid) -> - asn1_driver_owner ! {self(),Ref,are_you_ready}, - receive - {Ref,driver_ready} -> - ok - after 10000 -> - {error,{timeout,waiting_for_drivers}} - end; - _ -> - {_,Mref} = spawn_monitor(asn1rt_driver_handler, init, [self(),Ref]), - receive - {'DOWN', Mref, _, _, NewReason} -> - case NewReason of - Reason -> {error,Reason}; - _ -> load_driver(NewReason) - end; - {Ref,driver_ready} -> - erlang:demonitor(Mref), - ok; - {Ref,Error = {error,_Reason}} -> - erlang:demonitor(Mref), - Error - after 10000 -> %% 10 seconds - {error,{timeout,waiting_for_drivers}} - end - end. - -init(FromPid,FromRef) -> - case catch register(asn1_driver_owner,self()) of - true -> true; - _Other -> exit(normal) - end, - Dir = filename:join([code:priv_dir(asn1),"lib"]), - case catch erl_ddll:load_driver(Dir,asn1_erl_drv) of - ok -> - Result = open_named_ports(), - catch (FromPid ! {FromRef,Result}), - loop(Result); - {error,Err} -> % if erl_ddll:load_driver fails - ForErr = erl_ddll:format_error(Err), - OSDir = filename:join(Dir,erlang:system_info(system_architecture)), - case catch erl_ddll:load_driver(OSDir,asn1_erl_drv) of - ok -> - Result = open_named_ports(), - catch (FromPid ! {FromRef,Result}), - loop(Result); - {error,Err2} -> -% catch (FromPid ! {FromRef,Error}) - ForErr2 = erl_ddll:format_error(Err2), - catch (FromPid ! {FromRef,{error,{{Dir,ForErr},{OSDir,ForErr2}}}}) - end - end. - - -open_named_ports() -> - open_named_ports(size(?port_names)). - -open_named_ports(0) -> - driver_ready; -open_named_ports(N) -> - case catch open_port({spawn,"asn1_erl_drv"},[]) of - {'EXIT',Reason} -> - {error,{port_error,Reason}}; - Port -> - register(element(N,?port_names),Port), - open_named_ports(N-1) - end. - -loop(Result) -> - receive - {_FromPid,_FromRef,unload} -> - close_ports(size(?port_names)), - erl_ddll:unload_driver(asn1_erl_drv), - ok; - {FromPid,FromRef,are_you_ready} -> - catch (FromPid ! {FromRef,driver_ready}), - loop(Result); - _ -> - loop(Result) - end. - -unload_driver() -> - case whereis(asn1_driver_owner) of - Pid when is_pid(Pid) -> - Pid ! {self(),make_ref(),unload}, - ok; - _ -> - ok - end. - -close_ports(0) -> - ok; -close_ports(N) -> - element(N,?port_names) ! {self(), close}, %% almost same as port_close(Name) - close_ports(N-1). - -client_port() -> - element(erlang:system_info(scheduler_id) rem size(?port_names) + 1, - ?port_names). diff --git a/lib/asn1/src/asn1rt_nif.erl b/lib/asn1/src/asn1rt_nif.erl new file mode 100644 index 0000000000..de1fb94816 --- /dev/null +++ b/lib/asn1/src/asn1rt_nif.erl @@ -0,0 +1,87 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-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% +%% +%% +-module(asn1rt_nif). + +%% Nif interface for asn1 + +-export([encode_per_complete/1, + decode_ber_tlv/1, + encode_ber_tlv/1]). + +-on_load(load_nif/0). + +-define(ASN1_NIF_VSN,1). + +load_nif() -> + LibBaseName = "asn1_erl_nif", + PrivDir = code:priv_dir(asn1), + LibName = case erlang:system_info(build_type) of + opt -> + LibBaseName; + Type -> + LibTypeName = LibBaseName ++ "." ++ atom_to_list(Type), + case (filelib:wildcard( + filename:join( + [PrivDir, + "lib", + LibTypeName ++ "*"])) /= []) orelse + (filelib:wildcard( + filename:join( + [PrivDir, + "lib", + erlang:system_info(system_architecture), + LibTypeName ++ "*"])) /= []) of + true -> LibTypeName; + false -> LibBaseName + end + end, + Lib = filename:join([PrivDir, "lib", LibName]), + Status = case erlang:load_nif(Lib, ?ASN1_NIF_VSN) of + ok -> ok; + {error, {load_failed, _}}=Error1 -> + ArchLibDir = + filename:join([PrivDir, "lib", + erlang:system_info(system_architecture)]), + Candidate = + filelib:wildcard(filename:join([ArchLibDir,LibName ++ "*" ])), + case Candidate of + [] -> Error1; + _ -> + ArchLib = filename:join([ArchLibDir, LibName]), + erlang:load_nif(ArchLib, ?ASN1_NIF_VSN) + end; + Error1 -> Error1 + end, + case Status of + ok -> ok; + {error, {E, Str}} -> + error_logger:error_msg("Unable to load asn1 nif library. " + "Failed with error:~n\"~p, ~s\"~n",[E,Str]), + Status + end. + +encode_per_complete(_TagValueList) -> + erlang:nif_error({nif_not_loaded,module,?MODULE,line,?LINE}). + +decode_ber_tlv(_Binary) -> + erlang:nif_error({nif_not_loaded,module,?MODULE,line,?LINE}). + +encode_ber_tlv(_TagValueList) -> + erlang:nif_error({nif_not_loaded,module,?MODULE,line,?LINE}). diff --git a/lib/asn1/src/asn1rt_per_bin.erl b/lib/asn1/src/asn1rt_per_bin.erl index 6bbca26209..a124c7553d 100644 --- a/lib/asn1/src/asn1rt_per_bin.erl +++ b/lib/asn1/src/asn1rt_per_bin.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-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 @@ -57,7 +57,7 @@ encode_NumericString/2, decode_NumericString/2, encode_ObjectDescriptor/2, decode_ObjectDescriptor/1 ]). --export([complete_bytes/1]). +-export([complete_bytes/1, getbits/2, getoctets/2]). -define('16K',16384). -define('32K',32768). diff --git a/lib/asn1/src/asn1rt_per_bin_rt2ct.erl b/lib/asn1/src/asn1rt_per_bin_rt2ct.erl index f4aecf9322..c7ead680ce 100644 --- a/lib/asn1/src/asn1rt_per_bin_rt2ct.erl +++ b/lib/asn1/src/asn1rt_per_bin_rt2ct.erl @@ -1734,143 +1734,24 @@ get_constraint(C,Key) -> -ifdef(nodriver). complete(L) -> - case complete1(L) of - {[],[]} -> - <<0>>; - {Acc,[]} -> - Acc; - {Acc,Bacc} -> - [Acc|complete_bytes(Bacc)] - end. - - -% this function builds the ugly form of lists [E1|E2] to avoid having to reverse it at the end. -% this is done because it is efficient and that the result always will be sent on a port or -% converted by means of list_to_binary/1 - complete1(InList) when is_list(InList) -> - complete1(InList,[],[]); - complete1(InList) -> - complete1([InList],[],[]). - - complete1([],Acc,Bacc) -> - {Acc,Bacc}; - complete1([H|T],Acc,Bacc) when is_list(H) -> - {NewH,NewBacc} = complete1(H,Acc,Bacc), - complete1(T,NewH,NewBacc); - - complete1([{octets,Bin}|T],Acc,[]) -> - complete1(T,[Acc|Bin],[]); - - complete1([{octets,Bin}|T],Acc,Bacc) -> - complete1(T,[Acc|[complete_bytes(Bacc),Bin]],[]); - - complete1([{debug,_}|T], Acc,Bacc) -> - complete1(T,Acc,Bacc); - - complete1([{bits,N,Val}|T],Acc,Bacc) -> - complete1(T,Acc,complete_update_byte(Bacc,Val,N)); - - complete1([{bit,Val}|T],Acc,Bacc) -> - complete1(T,Acc,complete_update_byte(Bacc,Val,1)); - - complete1([align|T],Acc,[]) -> - complete1(T,Acc,[]); - complete1([align|T],Acc,Bacc) -> - complete1(T,[Acc|complete_bytes(Bacc)],[]); - complete1([{0,Bin}|T],Acc,[]) when is_binary(Bin) -> - complete1(T,[Acc|Bin],[]); - complete1([{Unused,Bin}|T],Acc,[]) when is_integer(Unused),is_binary(Bin) -> - Size = size(Bin)-1, - <<Bs:Size/binary,B>> = Bin, - NumBits = 8-Unused, - complete1(T,[Acc|Bs],[[B bsr Unused]|NumBits]); - complete1([{Unused,Bin}|T],Acc,Bacc) when is_integer(Unused),is_binary(Bin) -> - Size = size(Bin)-1, - <<Bs:Size/binary,B>> = Bin, - NumBits = 8 - Unused, - Bf = complete_bytes(Bacc), - complete1(T,[Acc|[Bf,Bs]],[[B bsr Unused]|NumBits]). - - - complete_update_byte([],Val,Len) -> - complete_update_byte([[0]|0],Val,Len); - complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) when NumBits + Len == 8 -> - [[0,((Byte bsl Len) + Val) band 255|Bacc]|0]; - complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) when NumBits + Len > 8 -> - Rem = 8 - NumBits, - Rest = Len - Rem, - complete_update_byte([[0,((Byte bsl Rem) + (Val bsr Rest)) band 255 |Bacc]|0],Val,Rest); - complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) -> - [[((Byte bsl Len) + Val) band 255|Bacc]|NumBits+Len]. - - - complete_bytes([[Byte|Bacc]|0]) -> - lists:reverse(Bacc); - complete_bytes([[Byte|Bacc]|NumBytes]) -> - lists:reverse([(Byte bsl (8-NumBytes)) band 255|Bacc]); - complete_bytes([]) -> - []. + erlang_complete(L). -else. -%% asn1-1.6.8.1_dev -%% complete(L) -> -%% case catch port_control(asn1_driver_port,1,L) of -%% Bin when is_binary(Bin) -> -%% Bin; -%% List when is_list(List) -> handle_error(List,L); -%% {'EXIT',{badarg,Reason}} -> -%% asn1rt_driver_handler:load_driver(), -%% receive -%% driver_ready -> -%% case catch port_control(asn1_driver_port,1,L) of -%% Bin2 when is_binary(Bin2) -> Bin2; -%% List when is_list(List) -> handle_error(List,L); -%% {'EXIT',Reason2={badarg,_R}} -> -%% exit({"failed to call driver probably due to bad asn1 value",Reason2}); -%% Reason2 -> exit(Reason2) -%% end; -%% {error,Error} -> % error when loading driver -%% %% the driver could not be loaded -%% exit(Error); -%% Error={port_error,Reason} -> -%% exit(Error) -%% end; -%% {'EXIT',Reason} -> -%% exit(Reason) -%% end. - -%% asn1-1.6.9 +%% asn1-1.7 complete(L) -> - case catch control(?COMPLETE_ENCODE,L) of - Bin when is_binary(Bin) -> - Bin; - List when is_list(List) -> handle_error(List,L); - {'EXIT',{badarg,_Reason}} -> - case asn1rt:load_driver() of - ok -> - case control(?COMPLETE_ENCODE,L) of - Bin when is_binary(Bin) ->Bin; - List when is_list(List) -> handle_error(List,L) - end; - Err -> - Err - end + case asn1rt_nif:encode_per_complete(L) of + {error, Reason} -> handle_error(Reason, L); + Else when is_binary(Else) -> Else end. - handle_error([],_)-> exit({error,{asn1,{"memory allocation problem in driver"}}}); -handle_error("1",L) -> % error in complete in driver +handle_error($1,L) -> % error in complete in driver exit({error,{asn1,L}}); handle_error(ErrL,L) -> exit({error,{asn1,ErrL,L}}). -%% asn1-1.6.9 -control(Cmd, Data) -> - Port = asn1rt_driver_handler:client_port(), - erlang:port_control(Port, Cmd, Data). - -endif. diff --git a/lib/asn1/test/asn1.cover b/lib/asn1/test/asn1.cover index 589a8b7e3d..ad3a0f3db9 100644 --- a/lib/asn1/test/asn1.cover +++ b/lib/asn1/test/asn1.cover @@ -1,2 +1,3 @@ {incl_app,asn1,details}. +{excl_mods, asn1, [asn1rt_nif]}.
\ No newline at end of file diff --git a/lib/asn1/test/asn1_SUITE.erl.src b/lib/asn1/test/asn1_SUITE.erl.src index e7f93a4053..124ee2d2bb 100644 --- a/lib/asn1/test/asn1_SUITE.erl.src +++ b/lib/asn1/test/asn1_SUITE.erl.src @@ -2036,11 +2036,7 @@ rtUI(Config) -> ?line {ok,_} = asn1rt:info('Prim'), ?line ok = asn1ct:compile(filename:join(DataDir,"Prim"),[?PER]), - ?line {ok,_} = asn1rt:info('Prim'), - - ?line ok = asn1rt:load_driver(), - ?line ok = asn1rt:load_driver(), - ?line ok = asn1rt:unload_driver(). + ?line {ok,_} = asn1rt:info('Prim'). testROSE(suite) -> []; testROSE(Config) -> diff --git a/lib/asn1/test/asn1_SUITE_data/DirectoryAbstractService.asn b/lib/asn1/test/asn1_SUITE_data/DirectoryAbstractService.asn index 5a5d310729..5a5d310729 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/DirectoryAbstractService.asn +++ b/lib/asn1/test/asn1_SUITE_data/DirectoryAbstractService.asn diff --git a/lib/asn1/test/asn1_SUITE_data/InformationFramework.asn b/lib/asn1/test/asn1_SUITE_data/InformationFramework.asn index ef236e98a9..ef236e98a9 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/InformationFramework.asn +++ b/lib/asn1/test/asn1_SUITE_data/InformationFramework.asn diff --git a/lib/asn1/test/asn1_SUITE_data/LDAP.asn1 b/lib/asn1/test/asn1_SUITE_data/LDAP.asn1 index 4d845942e1..4d845942e1 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/LDAP.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/LDAP.asn1 diff --git a/lib/asn1/test/asn1_SUITE_data/Nortel.asn b/lib/asn1/test/asn1_SUITE_data/Nortel.asn index a27c78a0b5..a27c78a0b5 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/Nortel.asn +++ b/lib/asn1/test/asn1_SUITE_data/Nortel.asn diff --git a/lib/asn1/test/asn1_SUITE_data/UpperBounds.asn b/lib/asn1/test/asn1_SUITE_data/UpperBounds.asn index 247260495b..247260495b 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/UpperBounds.asn +++ b/lib/asn1/test/asn1_SUITE_data/UpperBounds.asn diff --git a/lib/asn1/test/asn1_SUITE_data/UsefulDefinitions.asn b/lib/asn1/test/asn1_SUITE_data/UsefulDefinitions.asn index d9601bb7d0..d9601bb7d0 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/UsefulDefinitions.asn +++ b/lib/asn1/test/asn1_SUITE_data/UsefulDefinitions.asn diff --git a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-CommonDataTypes.asn b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-CommonDataTypes.asn index e3f6e83d6b..e3f6e83d6b 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-CommonDataTypes.asn +++ b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-CommonDataTypes.asn diff --git a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Constants.asn b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Constants.asn index 1411d455b7..1411d455b7 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Constants.asn +++ b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Constants.asn diff --git a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Containers.asn b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Containers.asn index fb08451103..fb08451103 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Containers.asn +++ b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Containers.asn diff --git a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-IEs.asn b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-IEs.asn index 848d8f6099..848d8f6099 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-IEs.asn +++ b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-IEs.asn diff --git a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Contents.asn b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Contents.asn index 9ecfa688a2..9ecfa688a2 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Contents.asn +++ b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Contents.asn diff --git a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Discriptions.asn b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Discriptions.asn index b9be9934e4..b9be9934e4 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Discriptions.asn +++ b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Discriptions.asn diff --git a/lib/asn1/test/asn1_bin_v2_particular_SUITE.erl.src b/lib/asn1/test/asn1_bin_v2_particular_SUITE.erl.src index abd21b0d78..4c3c8c7808 100644 --- a/lib/asn1/test/asn1_bin_v2_particular_SUITE.erl.src +++ b/lib/asn1/test/asn1_bin_v2_particular_SUITE.erl.src @@ -11,37 +11,219 @@ smp(Config) -> ?line Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, ?line ok = testNBAPsystem:compile(Config,per_bin,[optimize]), - - Parent = self(), - ?line ok = asn1rt:load_driver(), - - smp2(Parent,NumOfProcs,Msg,2), + enc_dec(NumOfProcs,Msg,2), N = 10000, - ?line {Time1,ok} = timer:tc(?MODULE,smp2,[Parent,NumOfProcs,Msg, N]), - ?line {Time1S,ok} = timer:tc(?MODULE,sequential,[NumOfProcs * N,Msg]), + ?line {Time1,ok} = timer:tc(?MODULE,enc_dec,[NumOfProcs,Msg, N]), + ?line {Time1S,ok} = timer:tc(?MODULE,enc_dec,[1, Msg, NumOfProcs * N]), - ?line ok = testNBAPsystem:compile(Config,ber_bin,[optimize,driver]), - ?line {Time2,ok} = timer:tc(?MODULE,smp2,[Parent,NumOfProcs,Msg, N]), + ?line ok = testNBAPsystem:compile(Config,ber_bin,[optimize,nif]), + ?line {Time3,ok} = timer:tc(?MODULE,enc_dec,[NumOfProcs,Msg, N]), - ?line {Time2S,ok} = timer:tc(?MODULE,sequential,[NumOfProcs * N,Msg]), + ?line {Time3S,ok} = timer:tc(?MODULE,enc_dec,[1, Msg, NumOfProcs * N]), - {comment,lists:flatten(io_lib:format("Encode/decode time parallell with ~p cores: ~p [microsecs]~nEncode/decode time sequential: ~p [microsecs]",[NumOfProcs,Time1+Time2,Time1S+Time2S]))}; + {comment,lists:flatten( + io_lib:format( + "Encode/decode time parallell with ~p cores: ~p [microsecs]~n" + "Encode/decode time sequential: ~p [microsecs]", + [NumOfProcs,Time1+Time3,Time1S+Time3S]))}; false -> {skipped,"No smp support"} end. -smp2(Parent,NumOfProcs,Msg, N) -> - Pids = [spawn_link(fun() -> worker(Msg,Parent, N) end) - || _ <- lists:seq(1,NumOfProcs)], - ?line ok = wait_pids(Pids). +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), + + ?line Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, + ?line ok = testNBAPsystem:compile([{priv_dir,NifDir}|Config],per_bin, + [optimize]), + ?line ok = testNBAPsystem:compile([{priv_dir,ErlDir}|Config],per_bin, + []), + + 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) -> + + ?line Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, + ?line ok = testNBAPsystem:compile(Config,ber_bin,[optimize,nif]), + + + 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 cert_pem/0,N,S}). + +dsa_pem_performance(Config) when is_list(Config) -> + cert_pem_performance({100000, 32}); +dsa_pem_performance({N,S}) -> + nif_vs_erlang_performance({fun 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]). -worker(Msg, Parent, N) -> - %% io:format("smp worker ~p with ~p worker loops.~n",[self(), N]), - worker_loop(N, Msg), - Parent ! self(). +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) -> + pforeach(fun(_) -> + worker_loop(N, Msg) + end, [I || I <- lists:seq(1,NumOfProcs)]). worker_loop(0, _Msg) -> ok; @@ -50,28 +232,24 @@ worker_loop(N, Msg) -> 'NBAP-PDU', Msg), ?line {ok,_Msg}=asn1_wrapper:decode('NBAP-PDU-Discriptions', - 'NBAP-PDU', - B), + 'NBAP-PDU', + B), worker_loop(N - 1, Msg). -wait_pids([]) -> - ok; -wait_pids(Pids) -> +pforeach(Fun, List) -> + pforeach(Fun, List, []). +pforeach(Fun, [], [{Pid,Ref}|Pids]) -> receive - Pid when is_pid(Pid) -> - ?line true = lists:member(Pid,Pids), - Others = lists:delete(Pid,Pids), - io:format("wait_pid got ~p, still waiting for ~p\n",[Pid,Others]), - wait_pids(Others); - Err -> - io:format("Err: ~p~n",[Err]), - ?line exit(Err) - end. - -sequential(N,Msg) -> - %%io:format("sequential encode/decode with N = ~p~n",[N]), - worker_loop(N,Msg). + {'DOWN', Ref, process, Pid, normal} -> + pforeach(Fun, [], Pids) + end; +pforeach(Fun, [H|T], Pids) -> + Pid = spawn(fun() -> Fun(H) end), + Ref = erlang:monitor(process, Pid), + pforeach(Fun, T, [{Pid, Ref}|Pids]); +pforeach(_Fun,[],[]) -> + ok. -record('InitiatingMessage',{procedureCode,criticality,value}). -record('Iu-ReleaseCommand',{first,second}). @@ -93,3 +271,21 @@ ticket7904(Config) -> ?line {ok,_} = 'RANAPextract1':encode('InitiatingMessage', Val1), asn1rt:unload_driver(), ?line {ok,_} = 'RANAPextract1':encode('InitiatingMessage', Val1). + +cert_pem() -> + 'OTP-PUB-KEY':decode('Certificate',<<48,130,3,184,48,130,3,33,160,3,2,1,2,2,1,1,48,13,6,9,42,134,72,134,247,13,1,1,5,5,0,48,129,131,49,14,48,12,6,3,85,4,3,19,5,111,116,112,67,65,49,19,48,17,6,3,85,4,11,19,10,69,114,108,97,110,103,32,79,84,80,49,20,48,18,6,3,85,4,10,19,11,69,114,105,99,115,115,111,110,32,65,66,49,11,48,9,6,3,85,4,6,19,2,83,69,49,18,48,16,6,3,85,4,7,19,9,83,116,111,99,107,104,111,108,109,49,37,48,35,6,9,42,134,72,134,247,13,1,9,1,22,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,48,30,23,13,48,56,48,49,48,57,48,56,50,57,51,48,90,23,13,49,55,49,49,49,55,48,56,50,57,51,48,90,48,129,132,49,15,48,13,6,3,85,4,3,19,6,99,108,105,101,110,116,49,19,48,17,6,3,85,4,11,19,10,69,114,108,97,110,103,32,79,84,80,49,20,48,18,6,3,85,4,10,19,11,69,114,105,99,115,115,111,110,32,65,66,49,11,48,9,6,3,85,4,6,19,2,83,69,49,18,48,16,6,3,85,4,7,19,9,83,116,111,99,107,104,111,108,109,49,37,48,35,6,9,42,134,72,134,247,13,1,9,1,22,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,48,129,159,48,13,6,9,42,134,72,134,247,13,1,1,1,5,0,3,129,141,0,48,129,137,2,129,129,0,245,56,68,254,220,239,193,190,63,221,182,60,67,77,121,163,214,136,137,183,139,8,166,30,100,27,45,17,126,58,15,173,151,218,75,224,148,14,22,164,10,100,186,183,104,175,197,97,96,182,146,150,106,129,140,100,194,106,90,62,133,233,155,46,155,33,101,220,83,193,182,232,240,99,253,249,114,8,159,172,143,77,179,132,229,205,29,110,185,233,224,52,25,149,249,100,80,229,199,125,23,106,146,233,159,26,13,8,161,206,221,43,240,149,42,45,194,190,85,6,235,152,220,219,160,32,144,67,2,3,1,0,1,163,130,1,55,48,130,1,51,48,9,6,3,85,29,19,4,2,48,0,48,11,6,3,85,29,15,4,4,3,2,5,224,48,29,6,3,85,29,14,4,22,4,20,26,59,44,5,72,211,158,214,23,34,30,241,125,27,123,115,93,163,231,120,48,129,179,6,3,85,29,35,4,129,171,48,129,168,128,20,6,171,128,52,58,164,184,118,178,189,157,46,40,229,109,145,222,125,1,155,161,129,140,164,129,137,48,129,134,49,17,48,15,6,3,85,4,3,19,8,101,114,108,97,110,103,67,65,49,19,48,17,6,3,85,4,11,19,10,69,114,108,97,110,103,32,79,84,80,49,20,48,18,6,3,85,4,10,19,11,69,114,105,99,115,115,111,110,32,65,66,49,18,48,16,6,3,85,4,7,19,9,83,116,111,99,107,104,111,108,109,49,11,48,9,6,3,85,4,6,19,2,83,69,49,37,48,35,6,9,42,134,72,134,247,13,1,9,1,22,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,130,1,1,48,33,6,3,85,29,17,4,26,48,24,129,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,48,33,6,3,85,29,18,4,26,48,24,129,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,48,13,6,9,42,134,72,134,247,13,1,1,5,5,0,3,129,129,0,93,11,112,227,121,15,121,179,247,135,110,216,17,197,84,18,149,166,147,142,190,178,0,209,190,0,142,233,144,100,194,205,220,182,73,204,108,42,95,23,48,63,4,120,239,42,194,25,184,35,117,107,96,229,18,45,76,122,125,40,171,210,132,50,146,178,160,55,17,35,255,208,114,30,47,55,185,154,155,165,204,180,14,143,20,234,6,234,201,225,72,235,5,87,61,255,250,23,217,1,144,246,98,221,223,102,49,168,177,13,70,241,26,27,254,251,217,14,244,18,242,197,151,50,186,214,15,42>>). + +dsa_pem() -> + 'OTP-PUB-KEY':decode('DSAPrivateKey',<<48,130,1,187,2,1,0,2,129,129,0,183,179,230,217,37,99,144,157,21,228,204,162,207,61,246,144,58,139,139,184,184,43,108,206,0,115,173,208,100,233,201,121,21,90,179,119,53,140,25,52,34,202,121,211,164,107,43,56,68,162,159,51,244,232,138,126,164,109,121,89,237,142,57,28,32,188,44,67,253,111,121,104,40,141,211,255,140,118,37,234,150,201,155,160,16,17,51,59,26,249,41,129,16,211,119,128,95,254,182,235,132,0,92,206,93,77,106,217,201,132,203,4,75,201,246,204,216,162,1,84,79,211,10,21,152,195,103,145,2,21,0,213,30,184,86,247,16,247,69,192,241,35,138,84,57,140,3,71,65,206,233,2,129,129,0,148,179,24,63,74,91,128,25,96,29,5,78,223,246,175,0,121,86,54,178,42,231,98,241,147,180,157,60,149,160,50,243,227,76,175,89,234,203,252,242,76,108,9,204,157,182,59,206,227,127,99,215,42,156,194,78,116,25,7,62,243,169,45,5,101,179,247,127,199,144,135,103,23,42,154,125,231,248,154,101,175,155,101,42,232,41,80,41,47,128,208,11,31,106,63,12,202,207,135,80,200,136,250,171,31,118,52,91,200,138,112,111,179,23,214,123,21,118,194,179,0,185,217,52,197,182,236,13,2,129,128,124,66,0,111,121,139,142,209,95,136,95,237,177,150,248,252,49,135,117,100,155,232,138,244,132,89,40,5,70,125,202,96,78,239,76,37,125,149,82,64,107,54,227,73,25,180,227,41,0,234,73,47,80,242,242,129,250,61,68,62,39,38,156,193,146,40,241,247,106,215,223,202,194,110,130,62,186,90,18,28,196,174,99,47,193,61,130,100,150,25,248,115,164,231,153,99,46,69,66,139,33,187,51,49,35,219,234,29,44,172,166,247,42,16,177,187,9,162,81,243,33,26,100,46,78,57,203,135,2,20,89,128,159,14,187,249,182,172,15,88,162,110,211,71,179,209,29,125,217,38>>), + 'OTP-PUB-KEY':decode('SubjectPublicKeyInfo',<<48,130,1,183,48,130,1,44,6,7,42,134,72,206,56,4,1,48,130,1,31,2,129,129,0,183,179,230,217,37,99,144,157,21,228,204,162,207,61,246,144,58,139,139,184,184,43,108,206,0,115,173,208,100,233,201,121,21,90,179,119,53,140,25,52,34,202,121,211,164,107,43,56,68,162,159,51,244,232,138,126,164,109,121,89,237,142,57,28,32,188,44,67,253,111,121,104,40,141,211,255,140,118,37,234,150,201,155,160,16,17,51,59,26,249,41,129,16,211,119,128,95,254,182,235,132,0,92,206,93,77,106,217,201,132,203,4,75,201,246,204,216,162,1,84,79,211,10,21,152,195,103,145,2,21,0,213,30,184,86,247,16,247,69,192,241,35,138,84,57,140,3,71,65,206,233,2,129,129,0,148,179,24,63,74,91,128,25,96,29,5,78,223,246,175,0,121,86,54,178,42,231,98,241,147,180,157,60,149,160,50,243,227,76,175,89,234,203,252,242,76,108,9,204,157,182,59,206,227,127,99,215,42,156,194,78,116,25,7,62,243,169,45,5,101,179,247,127,199,144,135,103,23,42,154,125,231,248,154,101,175,155,101,42,232,41,80,41,47,128,208,11,31,106,63,12,202,207,135,80,200,136,250,171,31,118,52,91,200,138,112,111,179,23,214,123,21,118,194,179,0,185,217,52,197,182,236,13,3,129,132,0,2,129,128,124,66,0,111,121,139,142,209,95,136,95,237,177,150,248,252,49,135,117,100,155,232,138,244,132,89,40,5,70,125,202,96,78,239,76,37,125,149,82,64,107,54,227,73,25,180,227,41,0,234,73,47,80,242,242,129,250,61,68,62,39,38,156,193,146,40,241,247,106,215,223,202,194,110,130,62,186,90,18,28,196,174,99,47,193,61,130,100,150,25,248,115,164,231,153,99,46,69,66,139,33,187,51,49,35,219,234,29,44,172,166,247,42,16,177,187,9,162,81,243,33,26,100,46,78,57,203,135>>), + 'OTP-PUB-KEY':decode('DSAParams',<<48,130,1,31,2,129,129,0,183,179,230,217,37,99,144,157,21,228,204,162,207,61,246,144,58,139,139,184,184,43,108,206,0,115,173,208,100,233,201,121,21,90,179,119,53,140,25,52,34,202,121,211,164,107,43,56,68,162,159,51,244,232,138,126,164,109,121,89,237,142,57,28,32,188,44,67,253,111,121,104,40,141,211,255,140,118,37,234,150,201,155,160,16,17,51,59,26,249,41,129,16,211,119,128,95,254,182,235,132,0,92,206,93,77,106,217,201,132,203,4,75,201,246,204,216,162,1,84,79,211,10,21,152,195,103,145,2,21,0,213,30,184,86,247,16,247,69,192,241,35,138,84,57,140,3,71,65,206,233,2,129,129,0,148,179,24,63,74,91,128,25,96,29,5,78,223,246,175,0,121,86,54,178,42,231,98,241,147,180,157,60,149,160,50,243,227,76,175,89,234,203,252,242,76,108,9,204,157,182,59,206,227,127,99,215,42,156,194,78,116,25,7,62,243,169,45,5,101,179,247,127,199,144,135,103,23,42,154,125,231,248,154,101,175,155,101,42,232,41,80,41,47,128,208,11,31,106,63,12,202,207,135,80,200,136,250,171,31,118,52,91,200,138,112,111,179,23,214,123,21,118,194,179,0,185,217,52,197,182,236,13>>), + 'OTP-PUB-KEY':decode('DSAPublicKey',<<2,129,128,124,66,0,111,121,139,142,209,95,136,95,237,177,150,248,252,49,135,117,100,155,232,138,244,132,89,40,5,70,125,202,96,78,239,76,37,125,149,82,64,107,54,227,73,25,180,227,41,0,234,73,47,80,242,242,129,250,61,68,62,39,38,156,193,146,40,241,247,106,215,223,202,194,110,130,62,186,90,18,28,196,174,99,47,193,61,130,100,150,25,248,115,164,231,153,99,46,69,66,139,33,187,51,49,35,219,234,29,44,172,166,247,42,16,177,187,9,162,81,243,33,26,100,46,78,57,203,135>>), + 'OTP-PUB-KEY':encode('DSAParams',{params,{'Dss-Parms',129000451850199666185842362389296595317127259539517666765336291347244303954511451744518587442120964433734460998523119938005801396466878889993179871123036311260456172022864663021425348874648247531097042575063545128239655736096045972718934778583429973433661785691086624069991876932064334822608460064613803976593,1216700114794736143432235288305776850295620488937,104420402274523493329542694749036577763086597934731674202966304958550599470165597750883637440049774107540742087494301536297571301945349213110548764383811017178451900599240379681904765817950545426764751538502808499880604633364255316249231153053427235538288687666086821781456733226598288985591031656134573747213}}), + 'OTP-PUB-KEY':encode( + 'SubjectPublicKeyInfo', + {'SubjectPublicKeyInfo', + {'AlgorithmIdentifier', + {1,2,840,10040,4,1}, + <<48,130,1,31,2,129,129,0,183,179,230,217,37,99,144,157,21,228,204,162,207,61,246,144,58,139,139,184,184,43,108,206,0,115,173,208,100,233,201,121,21,90,179,119,53,140,25,52,34,202,121,211,164,107,43,56,68,162,159,51,244,232,138,126,164,109,121,89,237,142,57,28,32,188,44,67,253,111,121,104,40,141,211,255,140,118,37,234,150,201,155,160,16,17,51,59,26,249,41,129,16,211,119,128,95,254,182,235,132,0,92,206,93,77,106,217,201,132,203,4,75,201,246,204,216,162,1,84,79,211,10,21,152,195,103,145,2,21,0,213,30,184,86,247,16,247,69,192,241,35,138,84,57,140,3,71,65,206,233,2,129,129,0,148,179,24,63,74,91,128,25,96,29,5,78,223,246,175,0,121,86,54,178,42,231,98,241,147,180,157,60,149,160,50,243,227,76,175,89,234,203,252,242,76,108,9,204,157,182,59,206,227,127,99,215,42,156,194,78,116,25,7,62,243,169,45,5,101,179,247,127,199,144,135,103,23,42,154,125,231,248,154,101,175,155,101,42,232,41,80,41,47,128,208,11,31,106,63,12,202,207,135,80,200,136,250,171,31,118,52,91,200,138,112,111,179,23,214,123,21,118,194,179,0,185,217,52,197,182,236,13>>}, + {0, + <<2,129,128,124,66,0,111,121,139,142,209,95,136,95,237,177,150,248,252,49,135,117,100,155,232,138,244,132,89,40,5,70,125,202,96,78,239,76,37,125,149,82,64,107,54,227,73,25,180,227,41,0,234,73,47,80,242,242,129,250,61,68,62,39,38,156,193,146,40,241,247,106,215,223,202,194,110,130,62,186,90,18,28,196,174,99,47,193,61,130,100,150,25,248,115,164,231,153,99,46,69,66,139,33,187,51,49,35,219,234,29,44,172,166,247,42,16,177,187,9,162,81,243,33,26,100,46,78,57,203,135>>}}). diff --git a/lib/asn1/test/ber_decode_error.erl b/lib/asn1/test/ber_decode_error.erl index 96d6545636..a566e0b07f 100644 --- a/lib/asn1/test/ber_decode_error.erl +++ b/lib/asn1/test/ber_decode_error.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% Copyright Ericsson AB 1999-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 @@ -45,6 +45,10 @@ run([]) -> run([driver]) -> %% test of OTP-4797, bad indata to driver does not cause an EXIT ?line {error,_Reason} = asn1rt:decode('Constructed','S3',[3,5]), + ok; +run([nif]) -> + %% test of OTP-4797, bad indata to driver does not cause an EXIT + ?line {error,_Reason} = asn1rt:decode('Constructed','S3',[3,5]), ok. diff --git a/lib/asn1/test/testPrim.erl b/lib/asn1/test/testPrim.erl index 97f99e7b1c..39c1e4d1d8 100644 --- a/lib/asn1/test/testPrim.erl +++ b/lib/asn1/test/testPrim.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -37,21 +37,10 @@ compile(Config,Rules,Opt) -> ?line DataDir = ?config(data_dir,Config), ?line OutDir = ?config(priv_dir,Config), ?line true = code:add_patha(?config(priv_dir,Config)), - case Opt of - [optimize] -> - ?line ok = asn1ct:compile(DataDir ++ "Prim", - [Rules,optimize,{outdir,OutDir}]), - ?line ok = asn1ct:compile(DataDir ++ "Real", - [Rules,optimize,{outdir,OutDir}]); - __ -> - ?line ok = asn1ct:compile(DataDir ++ "Prim", - [Rules,{outdir,OutDir}]), - ?line ok = asn1ct:compile(DataDir ++ "Real", - [Rules,{outdir,OutDir}]) - end. - - - + ?line ok = asn1ct:compile(DataDir ++ "Prim", + [Rules,{outdir,OutDir}] ++ Opt), + ?line ok = asn1ct:compile(DataDir ++ "Real", + [Rules,{outdir,OutDir}] ++ Opt). bool(Rules) -> diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile index 3ea6ae65d5..964f7c76c1 100644 --- a/lib/common_test/doc/src/Makefile +++ b/lib/common_test/doc/src/Makefile @@ -138,12 +138,6 @@ man: $(MAN6_FILES) $(MAN3_FILES) $(MAN1_FILES) debug opt: -# -# checkout make.dep before generating new dependecies -# -#make_doc_depend: xml -# docdepend > make.dep - clean clean_docs: rm -f $(CT_XML_FILES) rm -rf $(HTMLDIR)/* @@ -176,12 +170,3 @@ release_docs_spec: docs release_spec: release_tests_spec: - -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -include make.dep -# DO NOT DELETE - - diff --git a/lib/common_test/doc/src/ct_hooks_chapter.xml b/lib/common_test/doc/src/ct_hooks_chapter.xml index dbb4310040..3b9620d0f2 100644 --- a/lib/common_test/doc/src/ct_hooks_chapter.xml +++ b/lib/common_test/doc/src/ct_hooks_chapter.xml @@ -405,6 +405,38 @@ terminate(State) -> ok.</code> </section> + <marker id="builtin_cths"/> + <section> + <title>Built-in CTHs</title> + <p>Common Test is delivered with a couple of general purpose CTHs that + can be enabled by the user to provide some generic testing functionality. + Some of these are enabled by default when starting running common_test, + they can be disabled by setting <c>enable_builtin_hooks</c> to + <c>false</c> on the command line or in the test specification. In the + table below there is a list of all current CTHs which are delivered with + Common Test.</p> + + <table> + <row> + <cell><em>CTH Name</em></cell> + <cell><em>Is Built-in</em></cell> + <cell><em>Description</em></cell> + </row> + <row> + <cell>cth_log_redirect</cell> + <cell>yes</cell> + <cell>Captures all error_logger and SASL logging events and prints them + to the current test case log. If an event can not be associated with a + testcase it will be printed in the common test framework log. This will + happen for testcases which are run in parallel and events which occur + inbetween testcases. You can configure the level of + <seealso marker="sasl:sasl_app">SASL</seealso> events report + using the normal SASL mechanisms. </cell> + </row> + </table> + + </section> + </chapter> diff --git a/lib/common_test/doc/src/filestruct.gif b/lib/common_test/doc/src/filestruct.gif Binary files differindex 2b06833d0b..2b06833d0b 100755..100644 --- a/lib/common_test/doc/src/filestruct.gif +++ b/lib/common_test/doc/src/filestruct.gif diff --git a/lib/common_test/doc/src/make.dep b/lib/common_test/doc/src/make.dep deleted file mode 100644 index e34075888d..0000000000 --- a/lib/common_test/doc/src/make.dep +++ /dev/null @@ -1,27 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: basics_chapter.tex book.tex common_test_app.tex \ - config_file_chapter.tex cover_chapter.tex \ - ct.tex ct_cover.tex ct_ftp.tex ct_master.tex \ - ct_master_chapter.tex ct_rpc.tex ct_snmp.tex \ - ct_ssh.tex ct_telnet.tex dependencies_chapter.tex \ - event_handler_chapter.tex example_chapter.tex \ - install_chapter.tex part.tex ref_man.tex run_test.tex \ - run_test_chapter.tex test_structure_chapter.tex \ - unix_telnet.tex why_test_chapter.tex write_test_chapter.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/common_test/doc/src/run_test_chapter.xml b/lib/common_test/doc/src/run_test_chapter.xml index d3c6847d85..57059f0ba2 100644 --- a/lib/common_test/doc/src/run_test_chapter.xml +++ b/lib/common_test/doc/src/run_test_chapter.xml @@ -159,6 +159,8 @@ <seealso marker="event_handler_chapter#event_handling">event handlers</seealso> including start arguments.</item> <item><c><![CDATA[-ct_hooks <ct_hooks>]]></c>, to install <seealso marker="ct_hooks_chapter#installing">Common Test Hooks</seealso> including start arguments.</item> + <item><c><![CDATA[-enable_builtin_hooks <bool>]]></c>, to enable/disable + <seealso marker="ct_hooks_chapter#builtin_cths">Built-in Common Test Hooks</seealso>. Default is <c>true</c>.</item> <item><c><![CDATA[-include]]></c>, specifies include directories (see above).</item> <item><c><![CDATA[-no_auto_compile]]></c>, disables the automatic test suite compilation feature (see above).</item> <item><c><![CDATA[-multiply_timetraps <n>]]></c>, extends <seealso marker="write_test_chapter#timetraps">timetrap @@ -462,6 +464,8 @@ {ct_hooks, CTHModules}. {ct_hooks, NodeRefs, CTHModules}. + + {enable_builtin_hooks, Bool}. </pre> <p>Test terms:</p> <pre> @@ -643,7 +647,11 @@ <p>The minor log file contain full details of every single test case, each one in a separate file. This way the files should be easy to compare with previous test runs, even if the set of - test cases change.</p> + test cases change. If SASL is running those logs will also be + printed there by the + <seealso marker="common_test:ct_hooks_chapter#builtin_cths"> + cth_log_redirect built-in hook</seealso>. + </p> <p>Which information goes where is user configurable via the test server controller. Three threshold values determine what diff --git a/lib/common_test/include/ct.hrl b/lib/common_test/include/ct.hrl index aa1cc832cf..5a77108e1a 100644 --- a/lib/common_test/include/ct.hrl +++ b/lib/common_test/include/ct.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2010. All Rights Reserved. +%% Copyright Ericsson AB 2003-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 @@ -18,5 +18,4 @@ %% -include_lib("test_server/include/test_server.hrl"). --compile({parse_transform,ct_line}). diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 84b122b5e4..125aa828fb 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -40,7 +40,6 @@ RELSYSDIR = $(RELEASE_PATH)/lib/common_test-$(VSN) # ---------------------------------------------------- MODULES= \ - ct_line \ ct \ ct_logs \ ct_framework \ @@ -69,9 +68,11 @@ MODULES= \ ct_config_xml \ ct_slave \ ct_hooks\ - ct_hooks_lock + ct_hooks_lock\ + cth_log_redirect TARGET_MODULES= $(MODULES:%=$(EBIN)/%) +BEAM_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) ERL_FILES= $(MODULES:=.erl) HRL_FILES = \ @@ -97,7 +98,7 @@ ERL_COMPILE_FLAGS += -pa ../ebin -I../include -I $(ERL_TOP)/lib/snmp/include/ \ # ---------------------------------------------------- TARGET_FILES = \ $(GEN_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \ - $(MODULES:%=$(EBIN)/%.$(EMULATOR)) \ + $(BEAM_FILES) \ $(APP_TARGET) $(APPUP_TARGET) APP_FILE= common_test.app diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index b42173f412..57606c01db 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -25,7 +25,6 @@ ct_framework, ct_ftp, ct_gen_conn, - ct_line, ct_logs, ct_make, ct_master, diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index f3c2029734..69e15fa246 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -148,8 +148,8 @@ run(TestDirs) -> %%% {auto_compile,Bool} | {multiply_timetraps,M} | {scale_timetraps,Bool} | %%% {repeat,N} | {duration,DurTime} | {until,StopTime} | %%% {force_stop,Bool} | {decrypt,DecryptKeyOrFile} | -%%% {refresh_logs,LogDir} | {logopts,LogOpts} | {basic_html,Bool} | -%%% {ct_hooks, CTHs} +%%% {refresh_logs,LogDir} | {logopts,LogOpts} | {basic_html,Bool} | +%%% {ct_hooks, CTHs} | {enable_builtin_hooks,Bool} %%% TestDirs = [string()] | string() %%% Suites = [string()] | [atom()] | string() | atom() %%% Cases = [atom()] | atom() diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index f243b87f54..ffafc582cf 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -34,6 +34,12 @@ %% If you change this, remember to update ct_util:look -> stop clause as well. -define(config_name, ct_hooks). +%% All of the hooks which are to be started by default. Remove by issuing +%% -enable_builtin_hooks false to when starting common test. +-define(BUILTIN_HOOKS,[#ct_hook_config{ module = cth_log_redirect, + opts = [], + prio = ctfirst }]). + -record(ct_hook_config, {id, module, prio, scope, opts = [], state = []}). %% ------------------------------------------------------------------------- @@ -44,7 +50,8 @@ -spec init(State :: term()) -> ok | {error, Reason :: term()}. init(Opts) -> - call(get_new_hooks(Opts, undefined), ok, init, []). + call(get_new_hooks(Opts, undefined) ++ get_builtin_hooks(Opts), + ok, init, []). %% @doc Called after all suites are done. @@ -283,6 +290,14 @@ get_new_hooks(Config) when is_list(Config) -> get_new_hooks(_Config) -> []. +get_builtin_hooks(Opts) -> + case proplists:get_value(enable_builtin_hooks,Opts) of + false -> + []; + _Else -> + [{HookConf, call_id, undefined} || HookConf <- ?BUILTIN_HOOKS] + end. + save_suite_data_async(Hooks) -> ct_util:save_suite_data_async(?config_name, Hooks). @@ -290,7 +305,7 @@ get_hooks() -> lists:keysort(#ct_hook_config.prio,ct_util:read_suite_data(?config_name)). %% Sort all calls in this order: -%% call_id < call_init < Hook Priority 1 < .. < Hook Priority N +%% call_id < call_init < ctfirst < Priority 1 < .. < Priority N < ctlast %% If Hook Priority is equal, check when it has been installed and %% sort on that instead. resort(Calls, Hooks) -> @@ -311,6 +326,14 @@ resort(Calls, Hooks) -> %% If priorities are equal, we check the position in the %% hooks list pos(Id1,Hooks) < pos(Id2,Hooks); + P1 == ctfirst -> + true; + P2 == ctfirst -> + false; + P1 == ctlast -> + false; + P2 == ctlast -> + true; true -> P1 < P2 end @@ -331,7 +354,7 @@ catch_apply(M,F,A, Default) -> catch error:Reason -> case erlang:get_stacktrace() of %% Return the default if it was the CTH module which did not have the function. - [{M,F,A}|_] when Reason == undef -> + [{M,F,A,_}|_] when Reason == undef -> Default; Trace -> ct_logs:log("Suite Hook","Call to CTH failed: ~p:~p", diff --git a/lib/common_test/src/ct_line.erl b/lib/common_test/src/ct_line.erl deleted file mode 100644 index 4af9da5463..0000000000 --- a/lib/common_test/src/ct_line.erl +++ /dev/null @@ -1,266 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%%% @doc Parse transform for inserting line numbers - --module(ct_line). - --record(vars, {module, % atom() Module name - vsn, % atom() - - init_info=[], % [{M,F,A,C,L}] - - function, % atom() - arity, % int() - clause, % int() - lines, % [int()] - depth, % int() - is_guard=false % boolean - }). - --export([parse_transform/2, - line/1]). - -line(LOC={{Mod,Func},_Line}) -> - Lines = case get(test_server_loc) of - [{{Mod,Func},_}|Ls] -> - Ls; - Ls when is_list(Ls) -> - case length(Ls) of - 10 -> - [_|T]=lists:reverse(Ls), - lists:reverse(T); - _ -> - Ls - end; - _ -> - [] - end, - put(test_server_loc,[LOC|Lines]). - -parse_transform(Forms, _Options) -> - transform(Forms, _Options). - -%% forms(Fs) -> lists:map(fun (F) -> form(F) end, Fs). - -transform(Forms, _Options)-> - Vars0 = #vars{}, - {ok, MungedForms, _Vars} = transform(Forms, [], Vars0), - MungedForms. - - -transform([Form|Forms], MungedForms, Vars) -> - case munge(Form, Vars) of - ignore -> - transform(Forms, MungedForms, Vars); - {MungedForm, Vars2} -> - transform(Forms, [MungedForm|MungedForms], Vars2) - end; -transform([], MungedForms, Vars) -> - {ok, lists:reverse(MungedForms), Vars}. - -%% This code traverses the abstract code, stored as the abstract_code -%% chunk in the BEAM file, as described in absform(3) for Erlang/OTP R8B -%% (Vsn=abstract_v2). -%% The abstract format after preprocessing differs slightly from the abstract -%% format given eg using epp:parse_form, this has been noted in comments. -munge(Form={attribute,_,module,Module}, Vars) -> - Vars2 = Vars#vars{module=Module}, - {Form, Vars2}; - -munge({function,0,module_info,_Arity,_Clauses}, _Vars) -> - ignore; % module_info will be added again when the forms are recompiled -munge({function,Line,Function,Arity,Clauses}, Vars) -> - Vars2 = Vars#vars{function=Function, - arity=Arity, - clause=1, - lines=[], - depth=1}, - {MungedClauses, Vars3} = munge_clauses(Clauses, Vars2, []), - {{function,Line,Function,Arity,MungedClauses}, Vars3}; -munge(Form, Vars) -> % attributes - {Form, Vars}. - -munge_clauses([{clause,Line,Pattern,Guards,Body}|Clauses], Vars, MClauses) -> - {MungedGuards, _Vars} = munge_exprs(Guards, Vars#vars{is_guard=true},[]), - - case Vars#vars.depth of - 1 -> % function clause - {MungedBody, Vars2} = munge_body(Body, Vars#vars{depth=2}, []), - ClauseInfo = {Vars2#vars.module, - Vars2#vars.function, - Vars2#vars.arity, - Vars2#vars.clause, - length(Vars2#vars.lines)}, - InitInfo = [ClauseInfo | Vars2#vars.init_info], - Vars3 = Vars2#vars{init_info=InitInfo, - clause=(Vars2#vars.clause)+1, - lines=[], - depth=1}, - munge_clauses(Clauses, Vars3, - [{clause,Line,Pattern,MungedGuards,MungedBody}| - MClauses]); - - 2 -> % receive-, case- or if clause - {MungedBody, Vars2} = munge_body(Body, Vars, []), - munge_clauses(Clauses, Vars2, - [{clause,Line,Pattern,MungedGuards,MungedBody}| - MClauses]) - end; -munge_clauses([], Vars, MungedClauses) -> - {lists:reverse(MungedClauses), Vars}. - -munge_body([Expr|Body], Vars, MungedBody) -> - %% Here is the place to add a call to cover:bump/6! - Line = element(2, Expr), - Lines = Vars#vars.lines, - case lists:member(Line,Lines) of - true -> % already a bump at this line! - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_body(Body, Vars2, [MungedExpr|MungedBody]); - false -> - Bump = {call, 0, {remote,0,{atom,0,?MODULE},{atom,0,line}}, - [{tuple,0,[{tuple,0,[{atom,0,Vars#vars.module}, - {atom, 0, Vars#vars.function}]}, - {integer, 0, Line}]}]}, - Lines2 = [Line|Lines], - - {MungedExpr, Vars2} = munge_expr(Expr, Vars#vars{lines=Lines2}), - munge_body(Body, Vars2, [MungedExpr,Bump|MungedBody]) - end; -munge_body([], Vars, MungedBody) -> - {lists:reverse(MungedBody), Vars}. - -munge_expr({match,Line,ExprL,ExprR}, Vars) -> - {MungedExprL, Vars2} = munge_expr(ExprL, Vars), - {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), - {{match,Line,MungedExprL,MungedExprR}, Vars3}; -munge_expr({tuple,Line,Exprs}, Vars) -> - {MungedExprs, Vars2} = munge_exprs(Exprs, Vars, []), - {{tuple,Line,MungedExprs}, Vars2}; -munge_expr({record,Line,Expr,Exprs}, Vars) -> - %% Only for Vsn=raw_abstract_v1 - {MungedExprName, Vars2} = munge_expr(Expr, Vars), - {MungedExprFields, Vars3} = munge_exprs(Exprs, Vars2, []), - {{record,Line,MungedExprName,MungedExprFields}, Vars3}; -munge_expr({record_field,Line,ExprL,ExprR}, Vars) -> - %% Only for Vsn=raw_abstract_v1 - {MungedExprL, Vars2} = munge_expr(ExprL, Vars), - {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), - {{record_field,Line,MungedExprL,MungedExprR}, Vars3}; -munge_expr({cons,Line,ExprH,ExprT}, Vars) -> - {MungedExprH, Vars2} = munge_expr(ExprH, Vars), - {MungedExprT, Vars3} = munge_expr(ExprT, Vars2), - {{cons,Line,MungedExprH,MungedExprT}, Vars3}; -munge_expr({op,Line,Op,ExprL,ExprR}, Vars) -> - {MungedExprL, Vars2} = munge_expr(ExprL, Vars), - {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), - {{op,Line,Op,MungedExprL,MungedExprR}, Vars3}; -munge_expr({op,Line,Op,Expr}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {{op,Line,Op,MungedExpr}, Vars2}; -munge_expr({'catch',Line,Expr}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {{'catch',Line,MungedExpr}, Vars2}; -munge_expr({call,Line1,{remote,Line2,ExprM,ExprF},Exprs}, - Vars) when Vars#vars.is_guard==false-> - {MungedExprM, Vars2} = munge_expr(ExprM, Vars), - {MungedExprF, Vars3} = munge_expr(ExprF, Vars2), - {MungedExprs, Vars4} = munge_exprs(Exprs, Vars3, []), - {{call,Line1,{remote,Line2,MungedExprM,MungedExprF},MungedExprs}, Vars4}; -munge_expr({call,Line1,{remote,_Line2,_ExprM,ExprF},Exprs}, - Vars) when Vars#vars.is_guard==true -> - %% Difference in abstract format after preprocessing: BIF calls in guards - %% are translated to {remote,...} (which is not allowed as source form) - %% NOT NECESSARY FOR Vsn=raw_abstract_v1 - munge_expr({call,Line1,ExprF,Exprs}, Vars); -munge_expr({call,Line,Expr,Exprs}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {MungedExprs, Vars3} = munge_exprs(Exprs, Vars2, []), - {{call,Line,MungedExpr,MungedExprs}, Vars3}; -munge_expr({lc,Line,Expr,LC}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {MungedLC, Vars3} = munge_lc(LC, Vars2, []), - {{lc,Line,MungedExpr,MungedLC}, Vars3}; -munge_expr({block,Line,Body}, Vars) -> - {MungedBody, Vars2} = munge_body(Body, Vars, []), - {{block,Line,MungedBody}, Vars2}; -munge_expr({'if',Line,Clauses}, Vars) -> - {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), - {{'if',Line,MungedClauses}, Vars2}; -munge_expr({'case',Line,Expr,Clauses}, Vars) -> - {MungedExpr,Vars2} = munge_expr(Expr,Vars), - {MungedClauses,Vars3} = munge_clauses(Clauses, Vars2, []), - {{'case',Line,MungedExpr,MungedClauses}, Vars3}; -munge_expr({'receive',Line,Clauses}, Vars) -> - {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), - {{'receive',Line,MungedClauses}, Vars2}; -munge_expr({'receive',Line,Clauses,Expr,Body}, Vars) -> - {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), - {MungedExpr, Vars3} = munge_expr(Expr, Vars2), - {MungedBody, Vars4} = munge_body(Body, Vars3, []), - {{'receive',Line,MungedClauses,MungedExpr,MungedBody}, Vars4}; -munge_expr({'try',Line,Exprs,Clauses,CatchClauses}, Vars) -> - {MungedExprs, Vars1} = munge_exprs(Exprs, Vars, []), - {MungedClauses, Vars2} = munge_clauses(Clauses, Vars1, []), - {MungedCatchClauses, Vars3} = munge_clauses(CatchClauses, Vars2, []), - {{'try',Line,MungedExprs,MungedClauses,MungedCatchClauses}, Vars3}; -%% Difference in abstract format after preprocessing: Funs get an extra -%% element Extra. -%% NOT NECESSARY FOR Vsn=raw_abstract_v1 -munge_expr({'fun',Line,{function,Name,Arity},_Extra}, Vars) -> - {{'fun',Line,{function,Name,Arity}}, Vars}; -munge_expr({'fun',Line,{clauses,Clauses},_Extra}, Vars) -> - {MungedClauses,Vars2}=munge_clauses(Clauses, Vars, []), - {{'fun',Line,{clauses,MungedClauses}}, Vars2}; -munge_expr({'fun',Line,{clauses,Clauses}}, Vars) -> - %% Only for Vsn=raw_abstract_v1 - {MungedClauses,Vars2}=munge_clauses(Clauses, Vars, []), - {{'fun',Line,{clauses,MungedClauses}}, Vars2}; -munge_expr(Form, Vars) -> % var|char|integer|float|string|atom|nil|bin|eof - {Form, Vars}. - -munge_exprs([Expr|Exprs], Vars, MungedExprs) when Vars#vars.is_guard==true, - is_list(Expr) -> - {MungedExpr, _Vars} = munge_exprs(Expr, Vars, []), - munge_exprs(Exprs, Vars, [MungedExpr|MungedExprs]); -munge_exprs([Expr|Exprs], Vars, MungedExprs) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_exprs(Exprs, Vars2, [MungedExpr|MungedExprs]); -munge_exprs([], Vars, MungedExprs) -> - {lists:reverse(MungedExprs), Vars}. - -munge_lc([{generate,Line,Pattern,Expr}|LC], Vars, MungedLC) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_lc(LC, Vars2, [{generate,Line,Pattern,MungedExpr}|MungedLC]); -munge_lc([Expr|LC], Vars, MungedLC) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_lc(LC, Vars2, [MungedExpr|MungedLC]); -munge_lc([], Vars, MungedLC) -> - {lists:reverse(MungedLC), Vars}. - - - - - - - - - - diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index faec461775..c1523509a5 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -36,7 +36,7 @@ -export([make_all_suites_index/1,make_all_runs_index/1]). %% Logging stuff directly from testcase --export([tc_log/3,tc_print/3,tc_pal/3, +-export([tc_log/3,tc_print/3,tc_pal/3,ct_log/3, basic_html/0]). %% Simulate logger process for use without ct environment running @@ -374,6 +374,23 @@ tc_pal(Category,Format,Args) -> ok. +%%%----------------------------------------------------------------- +%%% @spec tc_pal(Category,Format,Args) -> ok +%%% Category = atom() +%%% Format = string() +%%% Args = list() +%%% +%%% @doc Print and log to the ct framework log +%%% +%%% <p>This function is called by internal ct functions to +%%% force logging to the ct framework log</p> +ct_log(Category,Format,Args) -> + cast({ct_log,[{div_header(Category),[]}, + {Format,Args}, + {div_footer(),[]}]}), + ok. + + %%%================================================================= %%% Internal functions int_header() -> @@ -535,7 +552,12 @@ logger_loop(State) -> {clear_stylesheet,_} when State#logger_state.stylesheet == undefined -> logger_loop(State); {clear_stylesheet,_} -> - logger_loop(State#logger_state{stylesheet=undefined}); + logger_loop(State#logger_state{stylesheet=undefined}); + {ct_log, List} -> + Fd = State#logger_state.ct_log_fd, + [begin io:format(Fd,Str,Args),io:nl(Fd) end || + {Str,Args} <- List], + logger_loop(State); stop -> io:format(State#logger_state.ct_log_fd, int_header()++int_footer(), diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 26ca4f3cb4..0a9bb5af67 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -57,6 +57,7 @@ config = [], event_handlers = [], ct_hooks = [], + enable_builtin_hooks = true, include = [], silent_connections, stylesheet, @@ -179,6 +180,10 @@ script_start1(Parent, Args) -> end, false, Args), EvHandlers = event_handler_args2opts(Args), CTHooks = ct_hooks_args2opts(Args), + EnableBuiltinHooks = get_start_opt(enable_builtin_hooks, + fun([CT]) -> list_to_atom(CT); + ([]) -> true + end, true, Args), %% check flags and set corresponding application env variables @@ -245,6 +250,7 @@ script_start1(Parent, Args) -> logdir = LogDir, logopts = LogOpts, event_handlers = EvHandlers, ct_hooks = CTHooks, + enable_builtin_hooks = EnableBuiltinHooks, include = IncludeDirs, silent_connections = SilentConns, stylesheet = Stylesheet, @@ -325,6 +331,11 @@ script_start2(StartOpts = #opts{vts = undefined, AllCTHooks = merge_vals( [StartOpts#opts.ct_hooks, SpecStartOpts#opts.ct_hooks]), + + EnableBuiltinHooks = + choose_val( + StartOpts#opts.enable_builtin_hooks, + SpecStartOpts#opts.enable_builtin_hooks), AllInclude = merge_vals([StartOpts#opts.include, SpecStartOpts#opts.include]), @@ -339,6 +350,8 @@ script_start2(StartOpts = #opts{vts = undefined, config = SpecStartOpts#opts.config, event_handlers = AllEvHs, ct_hooks = AllCTHooks, + enable_builtin_hooks = + EnableBuiltinHooks, include = AllInclude, multiply_timetraps = MultTT, scale_timetraps = ScaleTT}} @@ -355,9 +368,7 @@ script_start2(StartOpts = #opts{vts = undefined, {[],_} -> {error,no_testspec_specified}; {undefined,_} -> % no testspec used - case check_and_install_configfiles(InitConfig, TheLogDir, - Opts#opts.event_handlers, - Opts#opts.ct_hooks) of + case check_and_install_configfiles(InitConfig, TheLogDir, Opts) of ok -> % go on read tests from start flags script_start3(Opts#opts{config=InitConfig, logdir=TheLogDir}, Args); @@ -367,9 +378,7 @@ script_start2(StartOpts = #opts{vts = undefined, {_,_} -> % testspec used %% merge config from start flags with config from testspec AllConfig = merge_vals([InitConfig, Opts#opts.config]), - case check_and_install_configfiles(AllConfig, TheLogDir, - Opts#opts.event_handlers, - Opts#opts.ct_hooks) of + case check_and_install_configfiles(AllConfig, TheLogDir, Opts) of ok -> % read tests from spec {Run,Skip} = ct_testspec:prepare_tests(Terms, node()), do_run(Run, Skip, Opts#opts{config=AllConfig, @@ -383,9 +392,7 @@ script_start2(StartOpts, Args) -> %% read config/userconfig from start flags InitConfig = ct_config:prepare_config_list(Args), LogDir = which(logdir, StartOpts#opts.logdir), - case check_and_install_configfiles(InitConfig, LogDir, - StartOpts#opts.event_handlers, - StartOpts#opts.ct_hooks) of + case check_and_install_configfiles(InitConfig, LogDir, StartOpts) of ok -> % go on read tests from start flags script_start3(StartOpts#opts{config=InitConfig, logdir=LogDir}, Args); @@ -393,12 +400,17 @@ script_start2(StartOpts, Args) -> Error end. -check_and_install_configfiles(Configs, LogDir, EvHandlers, CTHooks) -> +check_and_install_configfiles( + Configs, LogDir, #opts{ + event_handlers = EvHandlers, + ct_hooks = CTHooks, + enable_builtin_hooks = EnableBuiltinHooks} ) -> case ct_config:check_config_files(Configs) of false -> install([{config,Configs}, {event_handler,EvHandlers}, - {ct_hooks,CTHooks}], LogDir); + {ct_hooks,CTHooks}, + {enable_builtin_hooks,EnableBuiltinHooks}], LogDir); {value,{error,{nofile,File}}} -> {error,{cant_read_config_file,File}}; {value,{error,{wrong_config,Message}}}-> @@ -490,23 +502,23 @@ script_start4(#opts{label = Label, profile = Profile, shell = true, config = Config, event_handlers = EvHandlers, ct_hooks = CTHooks, - logdir = LogDir, logopts = LogOpts, - testspecs = Specs}, _Args) -> + enable_builtin_hooks = EnableBuiltinHooks, + logdir = LogDir, testspecs = Specs}, _Args) -> %% label - used by ct_logs application:set_env(common_test, test_label, Label), %% profile - used in ct_util application:set_env(common_test, profile, Profile), - InstallOpts = [{config,Config},{event_handler,EvHandlers}, - {ct_hooks, CTHooks}], if Config == [] -> ok; true -> io:format("\nInstalling: ~p\n\n", [Config]) end, - case install(InstallOpts) of + case install([{config,Config},{event_handler,EvHandlers}, + {ct_hooks, CTHooks}, + {enable_builtin_hooks,EnableBuiltinHooks}]) of ok -> ct_util:start(interactive, LogDir), ct_util:set_testdata({logopts, LogOpts}), @@ -747,6 +759,11 @@ run_test2(StartOpts) -> %% CT Hooks CTHooks = get_start_opt(ct_hooks, value, [], StartOpts), + EnableBuiltinHooks = get_start_opt(enable_builtin_hooks, + fun(EBH) when EBH == true; + EBH == false -> + EBH + end, true, StartOpts), %% silent connections SilentConns = get_start_opt(silent_connections, @@ -820,6 +837,7 @@ run_test2(StartOpts) -> logopts = LogOpts, config = CfgFiles, event_handlers = EvHandlers, ct_hooks = CTHooks, + enable_builtin_hooks = EnableBuiltinHooks, include = Include, silent_connections = SilentConns, stylesheet = Stylesheet, @@ -878,26 +896,29 @@ run_spec_file(Relaxed, AllCTHooks = merge_vals([Opts#opts.ct_hooks, SpecOpts#opts.ct_hooks]), + EnableBuiltinHooks = choose_val(Opts#opts.enable_builtin_hooks, + SpecOpts#opts.enable_builtin_hooks), application:set_env(common_test, include, AllInclude), - case check_and_install_configfiles(AllConfig, - which(logdir,LogDir), - AllEvHs, - AllCTHooks) of + Opts1 = Opts#opts{label = Label, + profile = Profile, + cover = Cover, + logdir = which(logdir, LogDir), + logopts = AllLogOpts, + config = AllConfig, + event_handlers = AllEvHs, + include = AllInclude, + testspecs = AbsSpecs, + multiply_timetraps = MultTT, + scale_timetraps = ScaleTT, + ct_hooks = AllCTHooks, + enable_builtin_hooks = EnableBuiltinHooks + }, + + case check_and_install_configfiles(AllConfig,Opts1#opts.logdir, + Opts1) of ok -> - Opts1 = Opts#opts{label = Label, - profile = Profile, - cover = Cover, - logdir = which(logdir, LogDir), - logopts = AllLogOpts, - config = AllConfig, - event_handlers = AllEvHs, - include = AllInclude, - testspecs = AbsSpecs, - multiply_timetraps = MultTT, - scale_timetraps = ScaleTT, - ct_hooks = AllCTHooks}, {Run,Skip} = ct_testspec:prepare_tests(TS, node()), reformat_result(catch do_run(Run, Skip, Opts1, StartOpts)); {error,GCFReason} -> @@ -906,13 +927,10 @@ run_spec_file(Relaxed, end. run_prepared(Run, Skip, Opts = #opts{logdir = LogDir, - config = CfgFiles, - event_handlers = EvHandlers, - ct_hooks = CTHooks}, + config = CfgFiles }, StartOpts) -> LogDir1 = which(logdir, LogDir), - case check_and_install_configfiles(CfgFiles, LogDir1, - EvHandlers, CTHooks) of + case check_and_install_configfiles(CfgFiles, LogDir1, Opts) of ok -> reformat_result(catch do_run(Run, Skip, Opts#opts{logdir = LogDir1}, StartOpts)); @@ -944,7 +962,8 @@ check_config_file(Callback, File)-> run_dir(Opts = #opts{logdir = LogDir, config = CfgFiles, event_handlers = EvHandlers, - ct_hooks = CTHook }, StartOpts) -> + ct_hooks = CTHook, + enable_builtin_hooks = EnableBuiltinHooks }, StartOpts) -> LogDir1 = which(logdir, LogDir), Opts1 = Opts#opts{logdir = LogDir1}, AbsCfgFiles = @@ -967,7 +986,8 @@ run_dir(Opts = #opts{logdir = LogDir, end, CfgFiles), case install([{config,AbsCfgFiles}, {event_handler,EvHandlers}, - {ct_hooks, CTHook}], LogDir1) of + {ct_hooks, CTHook}, + {enable_builtin_hooks,EnableBuiltinHooks}], LogDir1) of ok -> ok; {error,IReason} -> exit(IReason) end, @@ -1125,9 +1145,8 @@ run_testspec2(TestSpec) -> end, application:set_env(common_test, include, AllInclude), LogDir1 = which(logdir,Opts#opts.logdir), - case check_and_install_configfiles(Opts#opts.config, LogDir1, - Opts#opts.event_handlers, - Opts#opts.ct_hooks) of + case check_and_install_configfiles( + Opts#opts.config, LogDir1, Opts) of ok -> Opts1 = Opts#opts{testspecs = [], logdir = LogDir1, @@ -1148,6 +1167,7 @@ get_data_for_node(#testspec{label = Labels, userconfig = UsrCfgs, event_handler = EvHs, ct_hooks = CTHooks, + enable_builtin_hooks = EnableBuiltinHooks, include = Incl, multiply_timetraps = MTs, scale_timetraps = STs}, Node) -> @@ -1177,6 +1197,7 @@ get_data_for_node(#testspec{label = Labels, config = ConfigFiles, event_handlers = EvHandlers, ct_hooks = FiltCTHooks, + enable_builtin_hooks = EnableBuiltinHooks, include = Include, multiply_timetraps = MT, scale_timetraps = ST}. @@ -2254,8 +2275,11 @@ try_get_start_opt(Key, IfExists, IfNotExists, Args) -> end. ct_hooks_args2opts(Args) -> - ct_hooks_args2opts( - proplists:get_value(ct_hooks, Args, []),[]). + lists:foldl(fun({ct_hooks,Hooks}, Acc) -> + ct_hooks_args2opts(Hooks,Acc); + (_,Acc) -> + Acc + end,[],Args). ct_hooks_args2opts([CTH,Arg,Prio,"and"| Rest],Acc) -> ct_hooks_args2opts(Rest,[{list_to_atom(CTH), diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index 2cba1d8410..317910d5c8 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -670,6 +670,10 @@ add_tests([{ct_hooks, _Node, []}|Ts], Spec) -> add_tests([{ct_hooks, Hooks}|Ts], Spec) -> add_tests([{ct_hooks, all_nodes, Hooks}|Ts], Spec); +%% -- enable_builtin_hooks -- +add_tests([{enable_builtin_hooks,Bool}|Ts],Spec) -> + add_tests(Ts, Spec#testspec{ enable_builtin_hooks = Bool }); + %% --- include --- add_tests([{include,all_nodes,InclDirs}|Ts],Spec) -> Tests = lists:map(fun(N) -> {include,N,InclDirs} end, list_nodes(Spec)), @@ -1130,6 +1134,7 @@ valid_terms() -> {event_handler,4}, {ct_hooks,2}, {ct_hooks,3}, + {enable_builtin_hooks,1}, {multiply_timetraps,2}, {multiply_timetraps,3}, {scale_timetraps,2}, diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index 73898fe371..bde832811a 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -39,6 +39,7 @@ userconfig=[], event_handler=[], ct_hooks=[], + enable_builtin_hooks=true, include=[], multiply_timetraps=[], scale_timetraps=[], diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl new file mode 100644 index 0000000000..14663b7738 --- /dev/null +++ b/lib/common_test/src/cth_log_redirect.erl @@ -0,0 +1,111 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% +%% +-module(cth_log_redirect). + +%%% @doc Common Test Framework functions handling test specifications. +%%% +%%% <p>This module redirects sasl and error logger info to common test log.</p> +%%% @end + + +%% CTH Callbacks +-export([id/1, init/2, post_init_per_group/4, pre_end_per_group/3, + post_end_per_testcase/4]). + +%% Event handler Callbacks +-export([init/1, + handle_event/2, handle_call/2, handle_info/2, + terminate/2]). + +id(_Opts) -> + ?MODULE. + +init(?MODULE, _Opts) -> + error_logger:add_report_handler(?MODULE), + tc_log. + +post_init_per_group(Group, Config, Result, tc_log) -> + case lists:member(parallel,proplists:get_value( + tc_group_properties,Config,[])) of + true -> + {Result, {set_log_func(ct_log),Group}}; + false -> + {Result, tc_log} + end; +post_init_per_group(_Group, _Config, Result, State) -> + {Result, State}. + +post_end_per_testcase(_TC, _Config, Result, State) -> + %% Make sure that the event queue is flushed + %% before ending this test case. + gen_event:call(error_logger, ?MODULE, flush), + {Result, State}. + +pre_end_per_group(Group, Config, {ct_log, Group}) -> + {Config, set_log_func(tc_log)}; +pre_end_per_group(_Group, Config, State) -> + {Config, State}. + + +%% Copied and modified from sasl_report_tty_h.erl +init(_Type) -> + {ok, tc_log}. + +handle_event({_Type, GL, _Msg}, State) when node(GL) /= node() -> + {ok, State}; +handle_event(Event, LogFunc) -> + case lists:keyfind(sasl, 1, application:which_applications()) of + false -> + sasl_not_started; + _Else -> + {ok, ErrLogType} = application:get_env(sasl, errlog_type), + SReport = sasl_report:format_report(group_leader(), ErrLogType, + tag_event(Event)), + if is_list(SReport) -> + ct_logs:LogFunc(sasl, SReport, []); + true -> %% Report is an atom if no logging is to be done + ignore + end + end, + EReport = error_logger_tty_h:write_event( + tag_event(Event),io_lib), + if is_list(EReport) -> + ct_logs:LogFunc(error_logger, EReport, []); + true -> %% Report is an atom if no logging is to be done + ignore + end, + {ok, LogFunc}. + + +handle_info(_,State) -> {ok, State}. + +handle_call(flush,State) -> + {ok, ok, State}; +handle_call({set_logfunc,NewLogFunc},_) -> + {ok, NewLogFunc, NewLogFunc}; +handle_call(_Query, _State) -> {error, bad_query}. + +terminate(_Reason, _Type) -> + []. + +tag_event(Event) -> + {calendar:local_time(), Event}. + +set_log_func(Func) -> + gen_event:call(error_logger, ?MODULE, {set_logfunc, Func}). diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl index d6ee8eed10..c1a455c6d8 100644 --- a/lib/common_test/test/ct_error_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE.erl @@ -303,41 +303,21 @@ test_events(cfg_error) -> {?eh,tc_start,{cfg_error_2_SUITE,init_per_suite}}, {?eh,tc_done, {cfg_error_2_SUITE,init_per_suite, - {failed,{error,{{badmatch,[1,2]}, - [{cfg_error_2_SUITE,init_per_suite,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,9}]}}}}}, + {failed,{error,{{badmatch,[1,2]},'_'}}}}}, {?eh,tc_auto_skip, {cfg_error_2_SUITE,tc1, {failed,{cfg_error_2_SUITE,init_per_suite, - {'EXIT',{{badmatch,[1,2]}, - [{cfg_error_2_SUITE,init_per_suite,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,9}]}}}}}}, + {'EXIT',{{badmatch,[1,2]},'_'}}}}}}, {?eh,test_stats,{0,0,{0,3}}}, {?eh,tc_auto_skip, {cfg_error_2_SUITE,tc2, {failed,{cfg_error_2_SUITE,init_per_suite, - {'EXIT',{{badmatch,[1,2]}, - [{cfg_error_2_SUITE,init_per_suite,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,9}]}}}}}}, + {'EXIT',{{badmatch,[1,2]},'_'}}}}}}, {?eh,test_stats,{0,0,{0,4}}}, {?eh,tc_auto_skip, {cfg_error_2_SUITE,end_per_suite, {failed,{cfg_error_2_SUITE,init_per_suite, - {'EXIT',{{badmatch,[1,2]}, - [{cfg_error_2_SUITE,init_per_suite,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,9}]}}}}}}, + {'EXIT',{{badmatch,[1,2]},'_'}}}}}}, {?eh,tc_start,{cfg_error_3_SUITE,init_per_suite}}, {?eh,tc_done, @@ -396,12 +376,7 @@ test_events(cfg_error) -> {?eh,tc_done,{cfg_error_6_SUITE,{end_per_group,g1,[]},ok}}], {?eh,tc_start,{cfg_error_6_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_6_SUITE,end_per_suite, - {failed,{error,{{badmatch,[1,2]}, - [{cfg_error_6_SUITE,end_per_suite,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,9}]}}}}}, + {failed,{error,{{badmatch,[1,2]},'_'}}}}}, {?eh,tc_start,{cfg_error_7_SUITE,init_per_suite}}, {?eh,tc_done,{cfg_error_7_SUITE,init_per_suite,ok}}, @@ -450,31 +425,16 @@ test_events(cfg_error) -> [{?eh,tc_start,{cfg_error_8_SUITE,{init_per_group,g3,[]}}}, {?eh,tc_done, {cfg_error_8_SUITE,{init_per_group,g3,[]}, - {failed,{error,{{badmatch,42}, - [{cfg_error_8_SUITE,init_per_group,2}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,9}]}}}}}, + {failed,{error,{{badmatch,42},'_'}}}}}, {?eh,tc_auto_skip, {cfg_error_8_SUITE,tc1, {failed,{cfg_error_8_SUITE,init_per_group, - {'EXIT',{{badmatch,42}, - [{cfg_error_8_SUITE,init_per_group,2}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,9}]}}}}}}, + {'EXIT',{{badmatch,42},'_'}}}}}}, {?eh,test_stats,{4,0,{0,13}}}, {?eh,tc_auto_skip, {cfg_error_8_SUITE,end_per_group, {failed,{cfg_error_8_SUITE,init_per_group, - {'EXIT',{{badmatch,42}, - [{cfg_error_8_SUITE,init_per_group,2}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,9}]}}}}}}], + {'EXIT',{{badmatch,42},'_'}}}}}}], [{?eh,tc_start,{cfg_error_8_SUITE,{init_per_group,g4,[]}}}, {?eh,tc_done,{cfg_error_8_SUITE,{init_per_group,g4,[]},ok}}, @@ -543,12 +503,7 @@ test_events(cfg_error) -> {?eh,tc_start,{cfg_error_9_SUITE,tc3}}, {?eh,tc_done,{cfg_error_9_SUITE,tc3, {skipped,{failed,{cfg_error_9_SUITE,init_per_testcase, - {{badmatch,undefined}, - [{cfg_error_9_SUITE,init_per_testcase,2}, - {test_server,my_apply,3}, - {test_server,init_per_testcase,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,9}]}}}}}}, + {{badmatch,undefined},'_'}}}}}}, {?eh,test_stats,{9,0,{0,17}}}, {?eh,tc_start,{cfg_error_9_SUITE,tc4}}, {?eh,tc_done, @@ -668,13 +623,7 @@ test_events(lib_error) -> {?eh,tc_done, {lib_error_1_SUITE,lines_error,{failed, {error, - {{badmatch,[1,2]}, - [{lib_lines,do_error,0}, - {lib_error_1_SUITE,lines_error,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,9}]}}}}}, + {{badmatch,[1,2]},'_'}}}}}, {?eh,test_stats,{0,1,{0,0}}}, {?eh,tc_start,{lib_error_1_SUITE,lines_exit}}, {?eh,tc_done, @@ -693,13 +642,7 @@ test_events(lib_error) -> {?eh,tc_done, {lib_error_1_SUITE,no_lines_error,{failed, {error, - {{badmatch,[1,2]}, - [{lib_no_lines,do_error,0}, - {lib_error_1_SUITE,no_lines_error,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,9}]}}}}}, + {{badmatch,[1,2]},'_'}}}}}, {?eh,test_stats,{0,5,{0,0}}}, {?eh,tc_start,{lib_error_1_SUITE,no_lines_exit}}, {?eh,tc_done, diff --git a/lib/common_test/test/ct_repeat_1_SUITE.erl b/lib/common_test/test/ct_repeat_1_SUITE.erl index 99e3b83ea9..090002d0c2 100644 --- a/lib/common_test/test/ct_repeat_1_SUITE.erl +++ b/lib/common_test/test/ct_repeat_1_SUITE.erl @@ -560,12 +560,7 @@ test_events(repeat_cs_until_any_fail) -> {repeat_1_SUITE,tc_fail_1, {failed, {error, - {{badmatch,2}, - [{repeat_1_SUITE,tc_fail_1,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,9}]}}}}}, + {{badmatch,2},'_'}}}}}, {?eh,test_stats,{5,2,{0,0}}}, {?eh,tc_start,{repeat_1_SUITE,tc_fail_2}}, {?eh,tc_done, diff --git a/lib/common_test/test/ct_skip_SUITE.erl b/lib/common_test/test/ct_skip_SUITE.erl index 6a8c57a6bd..b8be55f43a 100644 --- a/lib/common_test/test/ct_skip_SUITE.erl +++ b/lib/common_test/test/ct_skip_SUITE.erl @@ -197,7 +197,7 @@ test_events(auto_skip) -> {?eh,tc_done, {auto_skip_3_SUITE,tc1, {skipped,{failed,{auto_skip_3_SUITE,init_per_testcase, - {init_per_testcase,tc1,failed}}}}}}, + {{init_per_testcase,tc1,failed},'_'}}}}}}, {?eh,test_stats,{0,0,{0,4}}}, {?eh,tc_start,{auto_skip_3_SUITE,tc2}}, {?eh,tc_done,{auto_skip_3_SUITE,tc2,ok}}, @@ -364,12 +364,7 @@ test_events(auto_skip) -> {?eh,tc_done, {auto_skip_9_SUITE,tc8, {skipped,{failed,{auto_skip_9_SUITE,init_per_testcase, - {{badmatch,undefined}, - [{auto_skip_9_SUITE,init_per_testcase,2}, - {test_server,my_apply,3}, - {test_server,init_per_testcase,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,9}]}}}}}}, + {{badmatch,undefined},'_'}}}}}}, {?eh,tc_start, {auto_skip_9_SUITE,{end_per_group,g5,[parallel]}}}, {?eh,tc_done, diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index 830c89ae84..522c1dc411 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -395,6 +395,14 @@ module.beam: module.erl \ <code>-compile({no_auto_import,[error/1]}).</code> </item> + <tag><c>no_line_info</c></tag> + + <item> + <p>Omit line number information in order to produce a slightly + smaller output file. + </p> + </item> + </taglist> <p>If warnings are turned on (the <c>report_warnings</c> option diff --git a/lib/compiler/doc/src/make.dep b/lib/compiler/doc/src/make.dep deleted file mode 100644 index f5c097afad..0000000000 --- a/lib/compiler/doc/src/make.dep +++ /dev/null @@ -1,19 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex compile.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 89d64834cf..4a9c12dfea 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -23,7 +23,7 @@ -export([module/4]). -export([encode/2]). --import(lists, [map/2,member/2,keymember/3,duplicate/2]). +-import(lists, [map/2,member/2,keymember/3,duplicate/2,splitwith/2]). -include("beam_opcodes.hrl"). module(Code, Abst, SourceFile, Opts) -> @@ -31,22 +31,20 @@ module(Code, Abst, SourceFile, Opts) -> assemble({Mod,Exp,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) -> {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()), + {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0), NumFuncs = length(Asm0), {Asm,Attr} = on_load(Asm0, Attr0), - {Code,Dict1} = assemble_1(Asm, Exp, Dict0, []), - build_file(Code, Attr, Dict1, NumLabels, NumFuncs, Abst, SourceFile, Opts). + {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []), + build_file(Code, Attr, Dict2, NumLabels, NumFuncs, Abst, SourceFile, Opts). on_load(Fs0, Attr0) -> case proplists:get_value(on_load, Attr0) of undefined -> {Fs0,Attr0}; [{Name,0}] -> - Fs = map(fun({function,N,0,Entry,Asm0}) when N =:= Name -> - [{label,_}=L, - {func_info,_,_,_}=Fi, - {label,_}=E|Asm1] = Asm0, - Asm = [L,Fi,E,on_load|Asm1], - {function,N,0,Entry,Asm}; + Fs = map(fun({function,N,0,Entry,Is0}) when N =:= Name -> + Is = insert_on_load_instruction(Is0, Entry), + {function,N,0,Entry,Is}; (F) -> F end, Fs0), @@ -54,6 +52,13 @@ on_load(Fs0, Attr0) -> {Fs,Attr} end. +insert_on_load_instruction(Is0, Entry) -> + {Bef,[{label,Entry}=El|Is]} = + splitwith(fun({label,L}) when L =:= Entry -> false; + (_) -> true + end, Is0), + Bef ++ [El,on_load|Is]. + assemble_1([{function,Name,Arity,Entry,Asm}|T], Exp, Dict0, Acc) -> Dict1 = case member({Name,Arity}, Exp) of true -> @@ -132,14 +137,19 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> LitTab = iolist_to_binary(zlib:compress(LitTab2)), chunk(<<"LitT">>, <<(byte_size(LitTab2)):32>>, LitTab) end, + + %% Create the line chunk. + LineChunk = chunk(<<"Line">>, build_line_table(Dict)), %% Create the attributes and compile info chunks. Essentials0 = [AtomChunk,CodeChunk,StringChunk,ImportChunk, ExpChunk,LambdaChunk,LiteralChunk], - Essentials = [iolist_to_binary(C) || C <- Essentials0], - {Attributes,Compile} = build_attributes(Opts, SourceFile, Attr, Essentials), + Essentials1 = [iolist_to_binary(C) || C <- Essentials0], + MD5 = module_md5(Essentials1), + Essentials = finalize_fun_table(Essentials1, MD5), + {Attributes,Compile} = build_attributes(Opts, SourceFile, Attr, MD5), AttrChunk = chunk(<<"Attr">>, Attributes), CompileChunk = chunk(<<"CInf">>, Compile), @@ -150,11 +160,32 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> %% Create IFF chunk. Chunks = case member(slim, Opts) of - true -> [Essentials,AttrChunk,AbstChunk]; - false -> [Essentials,LocChunk,AttrChunk,CompileChunk,AbstChunk] + true -> + [Essentials,AttrChunk,AbstChunk]; + false -> + [Essentials,LocChunk,AttrChunk, + CompileChunk,AbstChunk,LineChunk] end, build_form(<<"BEAM">>, Chunks). +%% finalize_fun_table(Essentials, MD5) -> FinalizedEssentials +%% Update the 'old_uniq' field in the entry for each fun in the +%% 'FunT' chunk. We'll use part of the MD5 for the module as a +%% unique value. + +finalize_fun_table(Essentials, MD5) -> + [finalize_fun_table_1(E, MD5) || E <- Essentials]. + +finalize_fun_table_1(<<"FunT",Keep:8/binary,Table0/binary>>, MD5) -> + <<Uniq:27,_:101/bits>> = MD5, + Table = finalize_fun_table_2(Table0, Uniq, <<>>), + <<"FunT",Keep/binary,Table/binary>>; +finalize_fun_table_1(Chunk, _) -> Chunk. + +finalize_fun_table_2(<<Keep:20/binary,0:32,T/binary>>, Uniq, Acc) -> + finalize_fun_table_2(T, Uniq, <<Acc/binary,Keep/binary,Uniq:32>>); +finalize_fun_table_2(<<>>, _, Acc) -> Acc. + %% Build an IFF form. build_form(Id, Chunks0) when byte_size(Id) =:= 4, is_list(Chunks0) -> @@ -191,7 +222,7 @@ flatten_exports(Exps) -> flatten_imports(Imps) -> list_to_binary(map(fun({M,F,A}) -> <<M:32,F:32,A:32>> end, Imps)). -build_attributes(Opts, SourceFile, Attr, Essentials) -> +build_attributes(Opts, SourceFile, Attr, MD5) -> Misc = case member(slim, Opts) of false -> {{Y,Mo,D},{H,Mi,S}} = erlang:universaltime(), @@ -199,7 +230,32 @@ build_attributes(Opts, SourceFile, Attr, Essentials) -> true -> [] end, Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc], - {term_to_binary(calc_vsn(Attr, Essentials)),term_to_binary(Compile)}. + {term_to_binary(set_vsn_attribute(Attr, MD5)),term_to_binary(Compile)}. + +build_line_table(Dict) -> + {NumLineInstrs,NumFnames0,Fnames0,NumLines,Lines0} = + beam_dict:line_table(Dict), + NumFnames = NumFnames0 - 1, + [_|Fnames1] = Fnames0, + Fnames2 = [unicode:characters_to_binary(F) || F <- Fnames1], + Fnames = << <<(byte_size(F)):16,F/binary>> || F <- Fnames2 >>, + Lines1 = encode_line_items(Lines0, 0), + Lines = iolist_to_binary(Lines1), + Ver = 0, + Bits = 0, + <<Ver:32,Bits:32,NumLineInstrs:32,NumLines:32,NumFnames:32, + Lines/binary,Fnames/binary>>. + +%% encode_line_items([{FnameIndex,Line}], PrevFnameIndex) +%% Encode the line items compactly. Tag the FnameIndex with +%% an 'a' tag (atom) and only include it when it has changed. +%% Tag the line numbers with an 'i' (integer) tag. + +encode_line_items([{F,L}|T], F) -> + [encode(?tag_i, L)|encode_line_items(T, F)]; +encode_line_items([{F,L}|T], _) -> + [encode(?tag_a, F),encode(?tag_i, L)|encode_line_items(T, F)]; +encode_line_items([], _) -> []. %% %% If the attributes contains no 'vsn' attribute, we'll insert one @@ -207,32 +263,30 @@ build_attributes(Opts, SourceFile, Attr, Essentials) -> %% We'll not change an existing 'vsn' attribute. %% -calc_vsn(Attr, Essentials0) -> +set_vsn_attribute(Attr, MD5) -> case keymember(vsn, 1, Attr) of true -> Attr; false -> - Essentials = filter_essentials(Essentials0), - <<Number:128>> = erlang:md5(Essentials), + <<Number:128>> = MD5, [{vsn,[Number]}|Attr] end. +module_md5(Essentials0) -> + Essentials = filter_essentials(Essentials0), + erlang:md5(Essentials). + %% filter_essentials([Chunk]) -> [Chunk'] %% Filter essentials so that we obtain the same MD5 as code:module_md5/1 and -%% beam_lib:md5/1 would calculate for this module. +%% beam_lib:md5/1 would calculate for this module. Note that at this +%% point, the 'old_uniq' entry for each fun in the 'FunT' chunk is zeroed, +%% so there is no need to go through the 'FunT' chunk. -filter_essentials([<<"FunT",_Sz:4/binary,Entries:4/binary,Table0/binary>>|T]) -> - Table = filter_funtab(Table0, <<0:32>>), - [Entries,Table|filter_essentials(T)]; filter_essentials([<<_Tag:4/binary,Sz:32,Data:Sz/binary,_Padding/binary>>|T]) -> [Data|filter_essentials(T)]; filter_essentials([<<>>|T]) -> filter_essentials(T); filter_essentials([]) -> []. -filter_funtab(<<Important:20/binary,_OldUniq:4/binary,T/binary>>, Zero) -> - [Important,Zero|filter_funtab(T, Zero)]; -filter_funtab(<<>>, _) -> []. - bif_type(fnegate, 1) -> {op,fnegate}; bif_type(fadd, 2) -> {op,fadd}; bif_type(fsub, 2) -> {op,fsub}; @@ -243,6 +297,9 @@ bif_type(_, 2) -> bif2. make_op({'%',_}, Dict) -> {[],Dict}; +make_op({line,Location}, Dict0) -> + {Index,Dict} = beam_dict:line(Location, Dict0), + encode_op(line, [Index], Dict); make_op({bif, Bif, {f,_}, [], Dest}, Dict) -> %% BIFs without arguments cannot fail. encode_op(bif0, [{extfunc, erlang, Bif, 0}, Dest], Dict); @@ -271,8 +328,8 @@ make_op({test,Cond,Fail,Ops}, Dict) when is_list(Ops) -> encode_op(Cond, [Fail|Ops], Dict); make_op({test,Cond,Fail,Live,[Op|Ops],Dst}, Dict) when is_list(Ops) -> encode_op(Cond, [Fail,Op,Live|Ops++[Dst]], Dict); -make_op({make_fun2,{f,Lbl},Index,OldUniq,NumFree}, Dict0) -> - {Fun,Dict} = beam_dict:lambda(Lbl, Index, OldUniq, NumFree, Dict0), +make_op({make_fun2,{f,Lbl},_Index,_OldUniq,NumFree}, Dict0) -> + {Fun,Dict} = beam_dict:lambda(Lbl, NumFree, Dict0), make_op({make_fun2,Fun}, Dict); make_op({kill,Y}, Dict) -> make_op({init,Y}, Dict); diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index c45874597a..432d1e7eea 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -36,13 +36,14 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> %% Collect basic blocks and optimize them. Is2 = blockify(Is1), - Is3 = move_allocates(Is2), - Is4 = beam_utils:live_opt(Is3), - Is5 = opt_blocks(Is4), - Is6 = beam_utils:delete_live_annos(Is5), + Is3 = embed_lines(Is2), + Is4 = move_allocates(Is3), + Is5 = beam_utils:live_opt(Is4), + Is6 = opt_blocks(Is5), + Is7 = beam_utils:delete_live_annos(Is6), %% Optimize bit syntax. - {Is,Lc} = bsm_opt(Is6, Lc0), + {Is,Lc} = bsm_opt(Is7, Lc0), %% Done. {{function,Name,Arity,CLabel,Is},Lc} @@ -148,6 +149,24 @@ collect(remove_message) -> {set,[],[],remove_message}; collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; collect(_) -> error. +%% embed_lines([Instruction]) -> [Instruction] +%% Combine blocks that would be split by line/1 instructions. +%% Also move a line instruction before a block into the block, +%% but leave the line/1 instruction after a block outside. + +embed_lines(Is) -> + embed_lines(reverse(Is), []). + +embed_lines([{block,B2},{line,_}=Line,{block,B1}|T], Acc) -> + B = {block,B1++[{set,[],[],Line}]++B2}, + embed_lines([B|T], Acc); +embed_lines([{block,B1},{line,_}=Line|T], Acc) -> + B = {block,[{set,[],[],Line}|B1]}, + embed_lines([B|T], Acc); +embed_lines([I|Is], Acc) -> + embed_lines(Is, [I|Acc]); +embed_lines([], Acc) -> Acc. + opt_blocks([{block,Bl0}|Is]) -> %% The live annotation at the beginning is not useful. [{'%live',_}|Bl] = Bl0, @@ -225,10 +244,12 @@ opt([{set,[Dst],As,{bif,Bif,Fail}}=I1, RevBif -> [{set,[Dst],As,{bif,RevBif,Fail}}|opt(Is)] end; opt([{set,[X],[X],move}|Is]) -> opt(Is); -opt([{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1, +opt([{set,_,_,{line,_}}=Line1, + {set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1, + {set,_,_,{line,_}}=Line2, {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,0}}}=I2|Is]) when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg -> - opt([I2,I1|Is]); + opt([Line2,I2,Line1,I1|Is]); opt([{set,Ds0,Ss,Op}|Is0]) -> {Ds,Is} = opt_moves(Ds0, Is0), [{set,Ds,Ss,Op}|opt(Is)]; diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 415864b8e9..1217f7f777 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -20,7 +20,7 @@ -module(beam_bsm). -export([module/2,format_error/1]). --import(lists, [member/2,foldl/3,reverse/1,sort/1,all/2]). +-import(lists, [member/2,foldl/3,reverse/1,sort/1,all/2,dropwhile/2]). %%% %%% We optimize bit syntax matching where the tail end of a binary is @@ -376,6 +376,8 @@ btb_reaches_match_2([{func_info,_,_,Arity}=I|_], Regs0, D) -> [] -> D; _ -> {binary_used_in,I} end; +btb_reaches_match_2([{line,_}|Is], Regs, D) -> + btb_reaches_match_1(Is, Regs, D); btb_reaches_match_2([I|_], Regs, _) -> btb_error({btb_context_regs(Regs),I,not_handled}). @@ -580,7 +582,10 @@ btb_index(Fs) -> btb_index_1(Fs, []). btb_index_1([{function,_,_,Entry,Is0}|Fs], Acc0) -> - [{label,_},{func_info,_,_,_},{label,Entry}|Is] = Is0, + [{label,Entry}|Is] = + dropwhile(fun({label,L}) when L =:= Entry -> false; + (_) -> true + end, Is0), Acc = btb_index_2(Is, Entry, false, Acc0), btb_index_1(Fs, Acc); btb_index_1([], Acc) -> gb_trees:from_orddict(sort(Acc)). diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 64c93e11f7..a7994ab3b3 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-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 @@ -23,9 +23,9 @@ -export([module/2]). -export([bs_clean_saves/1]). -export([clean_labels/1]). --import(lists, [map/2,foldl/3,reverse/1]). +-import(lists, [map/2,foldl/3,reverse/1,filter/2]). -module({Mod,Exp,Attr,Fs0,_}, _Opt) -> +module({Mod,Exp,Attr,Fs0,_}, Opts) -> Order = [Lbl || {function,_,_,Lbl,_} <- Fs0], All = foldl(fun({function,_,_,Lbl,_}=Func,D) -> dict:store(Lbl, Func, D) end, dict:new(), Fs0), @@ -33,7 +33,8 @@ module({Mod,Exp,Attr,Fs0,_}, _Opt) -> Used = find_all_used(WorkList, All, sets:from_list(WorkList)), Fs1 = remove_unused(Order, Used, All), {Fs2,Lc} = clean_labels(Fs1), - Fs = bs_fix(Fs2), + Fs3 = bs_fix(Fs2), + Fs = maybe_remove_lines(Fs3, Opts), {ok,{Mod,Exp,Attr,Fs,Lc}}. %% Remove all bs_save2/2 instructions not referenced by a bs_restore2/2. @@ -375,3 +376,20 @@ bs_clean_saves_1([{bs_save2,_,{_,_}=SavePoint}=I|Is], Needed, Acc) -> bs_clean_saves_1([I|Is], Needed, Acc) -> bs_clean_saves_1(Is, Needed, [I|Acc]); bs_clean_saves_1([], _, Acc) -> reverse(Acc). + +%%% +%%% Remove line instructions if requested. +%%% + +maybe_remove_lines(Fs, Opts) -> + case proplists:get_bool(no_line_info, Opts) of + false -> Fs; + true -> remove_lines(Fs) + end. + +remove_lines([{function,N,A,Lbl,Is0}|T]) -> + Is = filter(fun({line,_}) -> false; + (_) -> true + end, Is0), + [{function,N,A,Lbl,Is}|remove_lines(T)]; +remove_lines([]) -> []. diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 1365f3d20a..9f81a6ab43 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -144,9 +144,9 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> %% Initialize label information with the code %% for the func_info label. Without it, a register %% may seem to be live when it is not. - [{label,L},{func_info,_,_,_}=FI|_] = Is1, + [{label,L}|FiIs] = Is1, D0 = beam_utils:empty_label_index(), - D = beam_utils:index_label(L, [FI], D0), + D = beam_utils:index_label(L, FiIs, D0), %% Optimize away dead code. {Is2,Lc} = forward(Is1, Lc0), @@ -185,6 +185,8 @@ split_block([{set,[R],As,{alloc,Live,{gc_bif,N,{f,Lbl}=Fail}}}|Is], Bl, Acc) split_block(Is, [], [{gc_bif,N,Fail,Live,As,R}|make_block(Bl, Acc)]); split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) -> split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]); +split_block([{set,[],[],{line,_}=Line}|Is], Bl, Acc) -> + split_block(Is, [], [Line|make_block(Bl, Acc)]); split_block([I|Is], Bl, Acc) -> split_block(Is, [I|Bl], Acc); split_block([], Bl, Acc) -> make_block(Bl, Acc). @@ -406,7 +408,7 @@ backward([{test,Op,{f,To0},Live,Ops0,Dst}|Is], D, Acc) -> end, I = {test,Op,{f,To},Live,Ops0,Dst}, backward(Is, D, [I|Acc]); -backward([{kill,_}=I|Is], D, [Exit|_]=Acc) -> +backward([{kill,_}=I|Is], D, [{line,_},Exit|_]=Acc) -> case beam_jump:is_exit_instruction(Exit) of false -> backward(Is, D, [I|Acc]); true -> backward(Is, D, Acc) @@ -471,7 +473,7 @@ shortcut_fail_label(To0, Reg, Val, D) -> shortcut_boolean_label(To0, Reg, Bool0, D) when is_boolean(Bool0) -> case beam_utils:code_at(To0, D) of - [{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] -> + [{line,_},{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] -> Bool = not Bool0, {shortcut_select_label(To, Reg, Bool, D),Bool}; _ -> diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index c50ed28aa9..531968b3c8 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -22,9 +22,10 @@ -export([new/0,opcode/2,highest_opcode/1, atom/2,local/4,export/4,import/4, - string/2,lambda/5,literal/2, + string/2,lambda/3,literal/2,line/2,fname/2, atom_table/1,local_table/1,export_table/1,import_table/1, - string_table/1,lambda_table/1,literal_table/1]). + string_table/1,lambda_table/1,literal_table/1, + line_table/1]). -type label() :: non_neg_integer(). @@ -36,6 +37,9 @@ strings = <<>> :: binary(), %String pool lambdas = [], %[{...}] literals = dict:new() :: dict(), %Format: {Literal,Number} + fnames = gb_trees:empty() :: gb_tree(), %{Name,Index} + lines = gb_trees:empty() :: gb_tree(), %{{Fname,Line},Index} + num_lines = 0 :: non_neg_integer(), %Number of line instructions next_import = 0 :: non_neg_integer(), string_offset = 0 :: non_neg_integer(), next_literal = 0 :: non_neg_integer(), @@ -129,13 +133,18 @@ string(Str, Dict) when is_list(Str) -> {NextOffset-Offset,Dict} end. -%% Returns the index for a funentry (adding it to the table if necessary). -%% lambda(Lbl, Index, Uniq, NumFree, Dict) -> {Index,Dict'} --spec lambda(label(), non_neg_integer(), integer(), non_neg_integer(), bdict()) -> +%% Returns the index for a fun entry. +%% lambda(Lbl, NumFree, Dict) -> {Index,Dict'} +-spec lambda(label(), non_neg_integer(), bdict()) -> {non_neg_integer(), bdict()}. -lambda(Lbl, Index, OldUniq, NumFree, #asm{lambdas=Lambdas0}=Dict) -> +lambda(Lbl, NumFree, #asm{lambdas=Lambdas0}=Dict) -> OldIndex = length(Lambdas0), + %% Set Index the same as OldIndex. + Index = OldIndex, + %% Initialize OldUniq to 0. It will be set to an unique value + %% based on the MD5 checksum of the BEAM code for the module. + OldUniq = 0, Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0], {OldIndex,Dict#asm{lambdas=Lambdas}}. @@ -152,6 +161,36 @@ literal(Lit, #asm{literals=Tab0,next_literal=NextIndex}=Dict) -> {NextIndex,Dict#asm{literals=Tab,next_literal=NextIndex+1}} end. +%% Returns the index for a line instruction (adding information +%% to the location information table). +-spec line(list(), bdict()) -> {non_neg_integer(), bdict()}. + +line([], #asm{num_lines=N}=Dict) -> + %% No location available. Return the special pre-defined + %% index 0. + {0,Dict#asm{num_lines=N+1}}; +line([{location,Name,Line}], #asm{lines=Lines0,num_lines=N}=Dict0) -> + {FnameIndex,Dict1} = fname(Name, Dict0), + case gb_trees:lookup({FnameIndex,Line}, Lines0) of + {value,Index} -> + {Index,Dict1#asm{num_lines=N+1}}; + none -> + Index = gb_trees:size(Lines0) + 1, + Lines = gb_trees:insert({FnameIndex,Line}, Index, Lines0), + Dict = Dict1#asm{lines=Lines,num_lines=N+1}, + {Index,Dict} + end. + +fname(Name, #asm{fnames=Fnames0}=Dict) -> + case gb_trees:lookup(Name, Fnames0) of + {value,Index} -> + {Index,Dict}; + none -> + Index = gb_trees:size(Fnames0), + Fnames = gb_trees:insert(Name, Index, Fnames0), + {Index,Dict#asm{fnames=Fnames}} + end. + %% Returns the atom table. %% atom_table(Dict) -> {LastIndex,[Length,AtomString...]} -spec atom_table(bdict()) -> {non_neg_integer(), [[non_neg_integer(),...]]}. @@ -219,6 +258,21 @@ literal_table(#asm{literals=Tab,next_literal=NumLiterals}) -> my_term_to_binary(Term) -> term_to_binary(Term, [{minor_version,1}]). +%% Return the line table. +-spec line_table(bdict()) -> + {non_neg_integer(), %Number of line instructions. + non_neg_integer(),[string()], + non_neg_integer(),[{non_neg_integer(),non_neg_integer()}]}. + +line_table(#asm{fnames=Fnames0,lines=Lines0,num_lines=NumLineInstrs}) -> + NumFnames = gb_trees:size(Fnames0), + Fnames1 = lists:keysort(2, gb_trees:to_list(Fnames0)), + Fnames = [Name || {Name,_} <- Fnames1], + NumLines = gb_trees:size(Lines0), + Lines1 = lists:keysort(2, gb_trees:to_list(Lines0)), + Lines = [L || {L,_} <- Lines1], + {NumLineInstrs,NumFnames,Fnames,NumLines,Lines}. + %% Search for binary string Str in the binary string pool Pool. %% old_string(Str, Pool) -> none | Index -spec old_string(binary(), binary()) -> 'none' | pos_integer(). diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 5c4d8e12b5..7103d2390f 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -296,6 +296,8 @@ get_function_chunks(Code) -> labels_r([], R) -> {R, []}; labels_r([{label,_}=I|Is], R) -> labels_r(Is, [I|R]); +labels_r([{line,_}=I|Is], R) -> + labels_r(Is, [I|R]); labels_r(Is, R) -> {R, Is}. get_funs({[],[]}) -> []; @@ -335,20 +337,17 @@ local_labels(Funs) -> local_labels_1(function__code(F), R) end, [], Funs)). -%% The first clause below attempts to provide some (limited form of) -%% backwards compatibility; it is not needed for .beam files generated -%% by the R8 compiler. The clause should one fine day be taken out. -local_labels_1([{label,_}|[{label,_}|_]=Code], R) -> - local_labels_1(Code, R); -local_labels_1([{label,_},{func_info,{atom,M},{atom,F},A}|Code], R) - when is_atom(M), is_atom(F) -> - local_labels_2(Code, R, M, F, A); -local_labels_1(Code, _) -> - ?exit({'local_labels: no label in code',Code}). +local_labels_1(Code0, R) -> + Code1 = lists:dropwhile(fun({label,_}) -> true; + ({line,_}) -> true; + ({func_info,_,_,_}) -> false + end, Code0), + [{func_info,{atom,M},{atom,F},A}|Code] = Code1, + local_labels_2(Code, R, {M,F,A}). -local_labels_2([{label,[{u,L}]}|Code], R, M, F, A) -> - local_labels_2(Code, [{L,{M,F,A}}|R], M, F, A); -local_labels_2(_, R, _, _, _) -> R. +local_labels_2([{label,[{u,L}]}|Code], R, MFA) -> + local_labels_2(Code, [{L,MFA}|R], MFA); +local_labels_2(_, R, _) -> R. %%----------------------------------------------------------------------- %% Disassembles a single BEAM instruction; most instructions are handled @@ -1105,6 +1104,12 @@ resolve_inst({recv_set,[Lbl]},_,_,_) -> {recv_set,Lbl}; %% +%% R15A. +%% +resolve_inst({line,[Index]},_,_,_) -> + {line,resolve_arg(Index)}; + +%% %% Catches instructions that are not yet handled. %% resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}). diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 3cab55c4cb..537f8ca81b 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -169,7 +169,7 @@ share_1([{label,L}=Lbl|Is], Dict0, Seq, Acc) -> share_1(Is, Dict0, [], [Lbl,{jump,{f,Label}}|Acc]) end; share_1([{func_info,_,_,_}=I|Is], _, [], Acc) -> - Is++[I|Acc]; + reverse(Is, [I|Acc]); share_1([I|Is], Dict, Seq, Acc) -> case is_unreachable_after(I) of false -> @@ -206,25 +206,35 @@ is_label(_) -> false. move(Is) -> move_1(Is, [], []). -move_1([I|Is], End, Acc) -> +move_1([I|Is], End0, Acc0) -> case is_exit_instruction(I) of - false -> move_1(Is, End, [I|Acc]); - true -> move_2(I, Is, End, Acc) + false -> + move_1(Is, End0, [I|Acc0]); + true -> + case extract_seq(Acc0, [I|End0]) of + no -> + move_1(Is, End0, [I|Acc0]); + {yes,End,Acc} -> + move_1(Is, End, Acc) + end end; -move_1([], End, Acc) -> - reverse(Acc, reverse(End)). - -move_2(Exit, Is, End, [{block,_},{label,_},{func_info,_,_,_}|_]=Acc) -> - move_1(Is, End, [Exit|Acc]); -move_2(Exit, Is, End, [{block,_}=Blk,{label,_}=Lbl,Unreachable|More]) -> - move_1([Unreachable|Is], [Exit,Blk,Lbl|End], More); -move_2(Exit, Is, End, [{bs_context_to_binary,_}=Bs,{label,_}=Lbl, - Unreachable|More]) -> - move_1([Unreachable|Is], [Exit,Bs,Lbl|End], More); -move_2(Exit, Is, End, [{label,_}=Lbl,Unreachable|More]) -> - move_1([Unreachable|Is], [Exit,Lbl|End], More); -move_2(Exit, Is, End, Acc) -> - move_1(Is, End, [Exit|Acc]). +move_1([], End, Acc) -> reverse(Acc, End). + +extract_seq([{line,_}=Line|Is], Acc) -> + extract_seq(Is, [Line|Acc]); +extract_seq([{block,_}=Bl|Is], Acc) -> + extract_seq_1(Is, [Bl|Acc]); +extract_seq([{label,_}|_]=Is, Acc) -> + extract_seq_1(Is, Acc); +extract_seq(_, _) -> no. + +extract_seq_1([{line,_}=Line|Is], Acc) -> + extract_seq_1(Is, [Line|Acc]); +extract_seq_1([{label,_},{func_info,_,_,_}|_], _) -> + no; +extract_seq_1([{label,_}=Lbl|Is], Acc) -> + {yes,[Lbl|Acc],Is}; +extract_seq_1(_, _) -> no. %%% %%% (3) (4) (5) (6) Jump and unreachable code optimizations. @@ -454,6 +464,7 @@ is_label_used_in_2({set,_,_,Info}, Lbl) -> {put_tuple,_} -> false; {get_tuple_element,_} -> false; {set_tuple_element,_} -> false; + {line,_} -> false; _ when is_atom(Info) -> false end. @@ -487,6 +498,8 @@ rem_unused([], _, Acc) -> reverse(Acc). initial_labels(Is) -> initial_labels(Is, []). +initial_labels([{line,_}|Is], Acc) -> + initial_labels(Is, Acc); initial_labels([{label,Lbl}|Is], Acc) -> initial_labels(Is, [Lbl|Acc]); initial_labels([{func_info,_,_,_},{label,Lbl}|_], Acc) -> diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index be7b14c3dd..2941f6135c 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -61,7 +61,7 @@ print_op(Stream, Label) when element(1, Label) == label -> print_op(Stream, Op) -> io:format(Stream, " ~p.\n", [Op]). -function(File, {function,Name,Arity,Args,Body,Vdb}) -> +function(File, {function,Name,Arity,Args,Body,Vdb,_Anno}) -> io:nl(File), io:format(File, "function ~p/~p.\n", [Name,Arity]), io:format(File, " ~p.\n", [Args]), diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl index 9ed44ad5d7..c483d85a97 100644 --- a/lib/compiler/src/beam_receive.erl +++ b/lib/compiler/src/beam_receive.erl @@ -175,6 +175,8 @@ opt_update_regs({label,Lbl}, R, L) -> end; opt_update_regs({try_end,_}, R, L) -> {R,L}; +opt_update_regs({line,_}, R, L) -> + {R,L}; opt_update_regs(_I, _R, L) -> %% Unrecognized instruction. Abort the search. {regs_init(),L}. diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index 790aba0a9a..25e6ffbb73 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -222,7 +222,9 @@ remap([{call_last,Ar,Name,N}|Is], Map, Acc) -> reverse(Acc, [I|Is]); remap([{call_ext_last,Ar,Name,N}|Is], Map, Acc) -> I = {call_ext_last,Ar,Name,Map({frame_size,N})}, - reverse(Acc, [I|Is]). + reverse(Acc, [I|Is]); +remap([{line,_}=I|Is], Map, Acc) -> + remap(Is, Map, [I|Acc]). remap_block([{set,Ds0,Ss0,Info}|Is], Map, Acc) -> Ds = [Map(D) || D <- Ds0], @@ -230,14 +232,15 @@ remap_block([{set,Ds0,Ss0,Info}|Is], Map, Acc) -> remap_block(Is, Map, [{set,Ds,Ss,Info}|Acc]); remap_block([], _, Acc) -> reverse(Acc). -safe_labels([{label,L},{badmatch,{Tag,_}}|Is], Acc) when Tag =/= y -> +safe_labels([{label,L},{line,_},{badmatch,{Tag,_}}|Is], Acc) when Tag =/= y -> safe_labels(Is, [L|Acc]); -safe_labels([{label,L},{case_end,{Tag,_}}|Is], Acc) when Tag =/= y -> +safe_labels([{label,L},{line,_},{case_end,{Tag,_}}|Is], Acc) when Tag =/= y -> safe_labels(Is, [L|Acc]); -safe_labels([{label,L},if_end|Is], Acc) -> +safe_labels([{label,L},{line,_},if_end|Is], Acc) -> safe_labels(Is, [L|Acc]); safe_labels([{label,L}, {block,[{set,[{x,0}],[{Tag,_}],move}]}, + {line,_}, {call_ext,1,{extfunc,erlang,error,1}}|Is], Acc) when Tag =/= y -> safe_labels(Is, [L|Acc]); safe_labels([_|Is], Acc) -> @@ -321,6 +324,8 @@ frame_size([{make_fun2,_,_,_,_}|Is], Safe) -> frame_size([{deallocate,N}|_], _) -> N; frame_size([{call_last,_,_,N}|_], _) -> N; frame_size([{call_ext_last,_,_,N}|_], _) -> N; +frame_size([{line,_}|Is], Safe) -> + frame_size(Is, Safe); frame_size([_|_], _) -> throw(not_possible). frame_size_branch(0, Is, Safe) -> diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index f83f73b224..0c51251f1b 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -168,6 +168,8 @@ simplify_float_1([{set,[D0],[A,B],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0, Ts0, simplify_float_1([{set,_,_,{'catch',_}}=I|Is]=Is0, _Ts, Rs0, Acc0) -> Acc = flush_all(Rs0, Is0, Acc0), simplify_float_1(Is, tdb_new(), Rs0, [I|Acc]); +simplify_float_1([{set,_,_,{line,_}}=I|Is], Ts, Rs, Acc) -> + simplify_float_1(Is, Ts, Rs, [I|Acc]); simplify_float_1([I|Is]=Is0, Ts0, Rs0, Acc0) -> Ts = update(I, Ts0), {Rs,Acc} = flush(Rs0, Is0, Acc0), @@ -400,6 +402,7 @@ update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> update({call,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); update({call_ext,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); update({make_fun2,_,_,_,_}, Ts) -> tdb_kill_xregs(Ts); +update({line,_}, Ts) -> Ts; %% The instruction is unknown. Kill all information. update(_I, _Ts) -> tdb_new(). diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 45cdf8a659..f281ad5eac 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -26,7 +26,7 @@ code_at/2,bif_to_test/3,is_pure_test/1, live_opt/1,delete_live_annos/1,combine_heap_needs/2]). --import(lists, [member/2,sort/1,reverse/1]). +-import(lists, [member/2,sort/1,reverse/1,splitwith/2]). -record(live, {bl, %Block check fun. @@ -195,10 +195,14 @@ is_pure_test({test,Op,_,Ops}) -> %% Also insert {'%live',Live} annotations at the beginning %% and end of each block. %% -live_opt([{label,Fail}=I1, - {func_info,_,_,Live}=I2|Is]) -> +live_opt(Is0) -> + {[{label,Fail}|_]=Bef,[Fi|Is]} = + splitwith(fun({func_info,_,_,_}) -> false; + (_) -> true + end, Is0), + {func_info,_,_,Live} = Fi, D = gb_trees:insert(Fail, live_call(Live), gb_trees:empty()), - [I1,I2|live_opt(reverse(Is), 0, D, [])]. + Bef ++ [Fi|live_opt(reverse(Is), 0, D, [])]. %% delete_live_annos([Instruction]) -> [Instruction]. @@ -499,6 +503,8 @@ check_liveness(R, [{loop_rec,{f,_},{x,0}}|_], St) -> end; check_liveness(R, [{loop_rec_end,{f,Fail}}|_], St) -> check_liveness_at(R, Fail, St); +check_liveness(R, [{line,_}|Is], St) -> + check_liveness(R, Is, St); check_liveness(_R, Is, St) when is_list(Is) -> %% case Is of %% [I|_] -> @@ -799,6 +805,8 @@ live_opt([{wait,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x -> live_opt(Is, Regs, D, [I|Acc]); +live_opt([{line,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); %% The following instructions can occur if the "compilation" has been %% started from a .S file using the 'asm' option. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index fb267b35b6..fe3b1680d9 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -166,12 +166,17 @@ validate(Module, Fs) -> Ft = index_bs_start_match(Fs, []), validate_0(Module, Fs, Ft). -index_bs_start_match([{function,_,_,Entry,Code}|Fs], Acc0) -> +index_bs_start_match([{function,_,_,Entry,Code0}|Fs], Acc0) -> + Code = dropwhile(fun({label,L}) when L =:= Entry -> false; + (_) -> true + end, Code0), case Code of - [_,_,{label,Entry}|Is] -> + [{label,Entry}|Is] -> Acc = index_bs_start_match_1(Is, Entry, Acc0), index_bs_start_match(Fs, Acc); _ -> + %% Something serious is wrong. Ignore it for now. + %% It will be detected and diagnosed later. index_bs_start_match(Fs, Acc0) end; index_bs_start_match([], Acc) -> @@ -292,6 +297,8 @@ labels(Is) -> labels_1([{label,L}|Is], R) -> labels_1(Is, [L|R]); +labels_1([{line,_}|Is], R) -> + labels_1(Is, R); labels_1(Is, R) -> {lists:reverse(R),Is}. @@ -433,6 +440,8 @@ valfun_1(remove_message, Vst) -> Vst; valfun_1({'%',_}, Vst) -> Vst; +valfun_1({line,_}, Vst) -> + Vst; %% Exception generating calls valfun_1({call_ext,Live,Func}=I, Vst) -> case return_type(Func, Vst) of @@ -870,6 +879,8 @@ val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) -> error(illegal_context_for_set_tuple_element); val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=true}}=Vst) -> Vst; +val_dsetel({line,_}, Vst) -> + Vst; val_dsetel(_, #vst{current=#st{setelem=true}=St}=Vst) -> Vst#vst{current=St#st{setelem=false}}; val_dsetel(_, Vst) -> Vst. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index e46c667e47..bfa7c6cedd 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -172,9 +172,9 @@ expand_opt(report, Os) -> expand_opt(return, Os) -> [return_errors,return_warnings|Os]; expand_opt(r12, Os) -> - [no_recv_opt|Os]; + [no_recv_opt,no_line_info|Os]; expand_opt(r13, Os) -> - [no_recv_opt|Os]; + [no_recv_opt,no_line_info|Os]; expand_opt({debug_info_key,_}=O, Os) -> [encrypt_debug_info,O|Os]; expand_opt(no_float_opt, Os) -> @@ -1438,6 +1438,8 @@ iofile(File) when is_atom(File) -> iofile(File) -> {filename:dirname(File), filename:basename(File, ".erl")}. +erlfile(".", Base, Suffix) -> + Base ++ Suffix; erlfile(Dir, Base, Suffix) -> filename:join(Dir, Base ++ Suffix). @@ -1510,6 +1512,8 @@ restore_expand_module([{attribute,Line,opaque,[Type]}|Fs]) -> [{attribute,Line,opaque,Type}|restore_expand_module(Fs)]; restore_expand_module([{attribute,Line,spec,[Arg]}|Fs]) -> [{attribute,Line,spec,Arg}|restore_expand_module(Fs)]; +restore_expand_module([{attribute,Line,callback,[Arg]}|Fs]) -> + [{attribute,Line,callback,Arg}|restore_expand_module(Fs)]; restore_expand_module([F|Fs]) -> [F|restore_expand_module(Fs)]; restore_expand_module([]) -> []. diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index f8128702dd..2514c06360 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -72,7 +72,6 @@ is_pure(erlang, binary_to_list, 1) -> true; is_pure(erlang, binary_to_list, 3) -> true; is_pure(erlang, bit_size, 1) -> true; is_pure(erlang, byte_size, 1) -> true; -is_pure(erlang, concat_binary, 1) -> true; is_pure(erlang, element, 2) -> true; is_pure(erlang, float, 1) -> true; is_pure(erlang, float_to_list, 1) -> true; diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 63527bda8f..39c1e8297f 100644 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -280,3 +280,7 @@ BEAM_FORMAT_NUMBER=0 150: recv_mark/1 151: recv_set/1 152: gc_bif3/7 + +# R15A + +153: line/1 diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 249bd7a8e7..ba9cde1de0 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -31,8 +31,6 @@ -import(ordsets, [from_list/1,add_element/2,union/2]). -import(lists, [member/2,foldl/3,foldr/3]). --compile({nowarn_deprecated_function, {erlang,hash,2}}). - -include("../include/erl_bits.hrl"). -record(expand, {module=[], %Module name @@ -43,12 +41,12 @@ mod_imports, %Module Imports compile=[], %Compile flags attributes=[], %Attributes + callbacks=[], %Callbacks defined=[], %Defined functions vcount=0, %Variable counter func=[], %Current function arity=[], %Arity for current function fcount=0, %Local fun count - fun_index=0, %Global index for funs bitdefault, bittypes }). @@ -172,10 +170,41 @@ define_functions(Forms, #expand{defined=Predef}=St) -> end, Predef, Forms), St#expand{defined=ordsets:from_list(Fs)}. -module_attrs(St) -> - {[{attribute,Line,Name,Val} || {Name,Line,Val} <- St#expand.attributes],St}. +module_attrs(#expand{attributes=Attributes}=St) -> + Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes], + Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs], + {Attrs,St#expand{callbacks=Callbacks}}. module_predef_funcs(St) -> + {Mpf1,St1}=module_predef_func_beh_info(St), + {Mpf2,St2}=module_predef_funcs_mod_info(St1), + {Mpf1++Mpf2,St2}. + +module_predef_func_beh_info(#expand{callbacks=[]}=St) -> + {[], St}; +module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined, + exports=Exports}=St) -> + PreDef=[{behaviour_info,1}], + PreExp=PreDef, + {[gen_beh_info(Callbacks)], + St#expand{defined=union(from_list(PreDef), Defined), + exports=union(from_list(PreExp), Exports)}}. + +gen_beh_info(Callbacks) -> + List = make_list(Callbacks), + {function,0,behaviour_info,1, + [{clause,0,[{atom,0,callbacks}],[], + [List]}]}. + +make_list([]) -> {nil,0}; +make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) -> + {cons,0, + {tuple,0, + [{atom,0,Name}, + {integer,0,Arity}]}, + make_list(Rest)}. + +module_predef_funcs_mod_info(St) -> PreDef = [{module_info,0},{module_info,1}], PreExp = PreDef, {[{function,0,module_info,0, @@ -506,32 +535,34 @@ lc_tq(_Line, [], St0) -> %% Transform an "explicit" fun {'fun', Line, {clauses, Cs}} into an %% extended form {'fun', Line, {clauses, Cs}, Info}, unless it is the %% name of a BIF (erl_lint has checked that it is not an import). -%% Process the body sequence directly to get the new and used variables. %% "Implicit" funs {'fun', Line, {function, F, A}} are not changed. fun_tq(Lf, {function,F,A}=Function, St0) -> - {As,St1} = new_vars(A, Lf, St0), - Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}], case erl_internal:bif(F, A) of true -> + {As,St1} = new_vars(A, Lf, St0), + Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}], fun_tq(Lf, {clauses,Cs}, St1); false -> - Index = St0#expand.fun_index, - Uniq = erlang:hash(Cs, (1 bsl 27)-1), - {Fname,St2} = new_fun_name(St1), - {{'fun',Lf,Function,{Index,Uniq,Fname}}, - St2#expand{fun_index=Index+1}} + {Fname,St1} = new_fun_name(St0), + Index = Uniq = 0, + {{'fun',Lf,Function,{Index,Uniq,Fname}},St1} end; -fun_tq(L, {function,M,F,A}, St) -> - {{call,L,{remote,L,{atom,L,erlang},{atom,L,make_fun}}, - [{atom,L,M},{atom,L,F},{integer,L,A}]},St}; +fun_tq(L, {function,M,F,A}, St) when is_atom(M), is_atom(F), is_integer(A) -> + %% This is the old format for external funs, generated by a pre-R15 + %% compiler. That means that a tool, such as the debugger or xref, + %% directly invoked this module with the abstract code from a + %% pre-R15 BEAM file. Be helpful, and translate it to the new format. + fun_tq(L, {function,{atom,L,M},{atom,L,F},{integer,L,A}}, St); +fun_tq(Lf, {function,_,_,_}=ExtFun, St) -> + {{'fun',Lf,ExtFun},St}; fun_tq(Lf, {clauses,Cs0}, St0) -> - Uniq = erlang:hash(Cs0, (1 bsl 27)-1), {Cs1,St1} = fun_clauses(Cs0, St0), - Index = St1#expand.fun_index, {Fname,St2} = new_fun_name(St1), - {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}}, - St2#expand{fun_index=Index+1}}. + %% Set dummy values for Index and Uniq -- the real values will + %% be assigned by beam_asm. + Index = Uniq = 0, + {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}. fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) -> {H,St1} = head(H0, St0), diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 55e3c58d2a..e7dae67085 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -79,9 +79,10 @@ module({Mod,Exp,Attr,Forms}, Options) -> functions(Forms, AtomMod) -> mapfoldl(fun (F, St) -> function(F, AtomMod, St) end, #cg{lcount=1}, Forms). -function({function,Name,Arity,Asm0,Vb,Vdb}, AtomMod, St0) -> +function({function,Name,Arity,Asm0,Vb,Vdb,Anno}, AtomMod, St0) -> try - {Asm,EntryLabel,St} = cg_fun(Vb, Asm0, Vdb, AtomMod, {Name,Arity}, St0), + {Asm,EntryLabel,St} = cg_fun(Vb, Asm0, Vdb, AtomMod, + {Name,Arity}, Anno, St0), Func = {function,Name,Arity,EntryLabel,Asm}, {Func,St} catch @@ -93,7 +94,7 @@ function({function,Name,Arity,Asm0,Vb,Vdb}, AtomMod, St0) -> %% cg_fun([Lkexpr], [HeadVar], Vdb, State) -> {[Ainstr],State} -cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, St0) -> +cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) -> {Fi,St1} = new_label(St0), %FuncInfo label {Fl,St2} = local_func_label(NameArity, St1), @@ -129,7 +130,7 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, St0) -> ultimate_failure=UltimateMatchFail, is_top_block=true}), {Name,Arity} = NameArity, - Asm = [{label,Fi},{func_info,AtomMod,{atom,Name},Arity}, + Asm = [{label,Fi},line(Anno),{func_info,AtomMod,{atom,Name},Arity}, {label,Fl}|B++[{label,UltimateMatchFail},if_end]], {Asm,Fl,St}. @@ -307,23 +308,23 @@ match_fail_cg({badmatch,Term}, Le, Vdb, Bef, St) -> R = cg_reg_arg(Term, Bef), Int0 = clear_dead(Bef, Le#l.i, Vdb), {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis ++ [{badmatch,R}], + {Sis ++ [line(Le),{badmatch,R}], Int#sr{reg=clear_regs(Int0#sr.reg)},St}; match_fail_cg({case_clause,Reason}, Le, Vdb, Bef, St) -> R = cg_reg_arg(Reason, Bef), Int0 = clear_dead(Bef, Le#l.i, Vdb), {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis++[{case_end,R}], + {Sis++[line(Le),{case_end,R}], Int#sr{reg=clear_regs(Bef#sr.reg)},St}; match_fail_cg(if_clause, Le, Vdb, Bef, St) -> Int0 = clear_dead(Bef, Le#l.i, Vdb), {Sis,Int1} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis++[if_end],Int1#sr{reg=clear_regs(Int1#sr.reg)},St}; + {Sis++[line(Le),if_end],Int1#sr{reg=clear_regs(Int1#sr.reg)},St}; match_fail_cg({try_clause,Reason}, Le, Vdb, Bef, St) -> R = cg_reg_arg(Reason, Bef), Int0 = clear_dead(Bef, Le#l.i, Vdb), {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis ++ [{try_case_end,R}], + {Sis ++ [line(Le),{try_case_end,R}], Int#sr{reg=clear_regs(Int0#sr.reg)},St}. %% bsm_rename_ctx([Clause], Var) -> [Clause] @@ -1047,7 +1048,7 @@ call_cg({var,_V} = Var, As, Rs, Le, Vdb, Bef, St0) -> %% Build complete code and final stack/register state. Arity = length(As), {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ [{call_fun,Arity}],Aft, + {Sis ++ Frees ++ [line(Le),{call_fun,Arity}],Aft, need_stack_frame(St0)}; call_cg({remote,Mod,Name}, As, Rs, Le, Vdb, Bef, St0) when element(1, Mod) =:= var; @@ -1057,11 +1058,10 @@ call_cg({remote,Mod,Name}, As, Rs, Le, Vdb, Bef, St0) Reg = load_vars(Rs, clear_regs(Int#sr.reg)), %% Build complete code and final stack/register state. Arity = length(As), - Call = {apply,Arity}, St = need_stack_frame(St0), %%{Call,St1} = build_call(Func, Arity, St0), {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ [Call],Aft,St}; + {Sis ++ Frees ++ [line(Le),{apply,Arity}],Aft,St}; call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> case St0 of #cg{bfail=Fail} when Fail =/= 0 -> @@ -1091,7 +1091,7 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> Arity = length(As), {Call,St1} = build_call(Func, Arity, St0), {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ Call,Aft,St1} + {Sis ++ Frees ++ [line(Le)|Call],Aft,St1} end. build_call({remote,{atom,erlang},{atom,'!'}}, 2, St0) -> @@ -1118,7 +1118,7 @@ enter_cg({var,_V} = Var, As, Le, Vdb, Bef, St0) -> {Sis,Int} = cg_setup_call(As++[Var], Bef, Le#l.i, Vdb), %% Build complete code and final stack/register state. Arity = length(As), - {Sis ++ [{call_fun,Arity},return], + {Sis ++ [line(Le),{call_fun,Arity},return], clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), need_stack_frame(St0)}; enter_cg({remote,Mod,Name}, As, Le, Vdb, Bef, St0) @@ -1127,9 +1127,8 @@ enter_cg({remote,Mod,Name}, As, Le, Vdb, Bef, St0) {Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb), %% Build complete code and final stack/register state. Arity = length(As), - Call = {apply_only,Arity}, St = need_stack_frame(St0), - {Sis ++ [Call], + {Sis ++ [line(Le),{apply_only,Arity}], clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), St}; enter_cg(Func, As, Le, Vdb, Bef, St0) -> @@ -1137,7 +1136,8 @@ enter_cg(Func, As, Le, Vdb, Bef, St0) -> %% Build complete code and final stack/register state. Arity = length(As), {Call,St1} = build_enter(Func, Arity, St0), - {Sis ++ Call, + Line = enter_line(Func, Arity, Le), + {Sis ++ Line ++ Call, clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), St1}. @@ -1153,6 +1153,23 @@ build_enter(Name, Arity, St0) when is_atom(Name) -> {Lbl,St1} = local_func_label(Name, Arity, St0), {[{call_only,Arity,{f,Lbl}}],St1}. +enter_line({remote,{atom,Mod},{atom,Name}}, Arity, Le) -> + case erl_bifs:is_safe(Mod, Name, Arity) of + false -> + %% Tail-recursive call, possibly to a BIF. + %% We'll need a line instruction in case the + %% BIF call fails. + [line(Le)]; + true -> + %% Call to a safe BIF. Since it cannot fail, + %% we don't need any line instruction here. + [] + end; +enter_line(_, _, _) -> + %% Tail-recursive call to a local function. A line + %% instruction will not be useful. + []. + %% local_func_label(Name, Arity, State) -> {Label,State'} %% local_func_label({Name,Arity}, State) -> {Label,State'} %% Get the function entry label for a local function. @@ -1226,9 +1243,10 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> %% Currently, we are somewhat pessimistic in %% that we save any variable that will be live after this BIF call. + MayFail = not erl_bifs:is_safe(erlang, Bif, length(As)), {Sis,Int0} = case St0#cg.in_catch andalso St0#cg.bfail =:= 0 andalso - not erl_bifs:is_safe(erlang, Bif, length(As)) of + MayFail of true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); false -> {[],Bef} end, @@ -1237,7 +1255,14 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> Int = Int1#sr{reg=Reg}, Dst = fetch_reg(V, Reg), BifFail = {f,St0#cg.bfail}, - {Sis++[{bif,Bif,BifFail,Ars,Dst}], + %% We need a line instructions for BIFs that may fail in a body. + Line = case BifFail of + {f,0} when MayFail -> + [line(Le)]; + _ -> + [] + end, + {Sis++Line++[{bif,Bif,BifFail,Ars,Dst}], clear_dead(Int, Le#l.i, Vdb), St0}. @@ -1266,7 +1291,11 @@ gc_bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> Int = Int1#sr{reg=Reg}, Dst = fetch_reg(V, Reg), BifFail = {f,St0#cg.bfail}, - {Sis++[{gc_bif,Bif,BifFail,max_reg(Bef#sr.reg),Ars,Dst}], + Line = case BifFail of + {f,0} -> [line(Le)]; + {f,_} -> [] + end, + {Sis++Line++[{gc_bif,Bif,BifFail,max_reg(Bef#sr.reg),Ars,Dst}], clear_dead(Int, Le#l.i, Vdb), St0}. %% recv_loop_cg(TimeOut, ReceiveVar, ReceiveMatch, TimeOutExprs, @@ -1284,7 +1313,7 @@ recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St0) -> {Wis,Taft,St6} = cg_recv_wait(Te, Tes, Le#l.i, Int1, St5), Int2 = sr_merge(Raft, Taft), %Merge stack/registers Reg = load_vars(Rs, Int2#sr.reg), - {Sis ++ Ris ++ [{label,Tl}] ++ Wis ++ [{label,Bl}], + {Sis ++ [line(Le)] ++ Ris ++ [{label,Tl}] ++ Wis ++ [{label,Bl}], clear_dead(Int2#sr{reg=Reg}, Le#l.i, Vdb), St6#cg{break=St0#cg.break,recv=St0#cg.recv}}. @@ -1463,12 +1492,13 @@ cg_binary([{bs_put_binary,Fail,{atom,all},U,_Flags,Src}|PutCode], {bs_append,Fail,Target,0,MaxRegs,U,Src,BinFlags,Target} end] ++ PutCode, cg_bin_opt(Code); -cg_binary(PutCode, Target, Temp, Fail, MaxRegs, _Anno) -> +cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Anno) -> + Line = line(Anno), Live = cg_live(Target, MaxRegs), {InitOp,SzCode} = cg_binary_size(PutCode, Target, Temp, Fail, Live), - Code = SzCode ++ [{InitOp,Fail,Target,0,MaxRegs, - {field_flags,[]},Target}|PutCode], + Code = [Line|SzCode] ++ [{InitOp,Fail,Target,0,MaxRegs, + {field_flags,[]},Target}|PutCode], cg_bin_opt(Code). cg_live({x,X}, MaxRegs) when X =:= MaxRegs -> MaxRegs+1; @@ -2052,6 +2082,38 @@ drop_catch(Tag, [Other|Stk]) -> [Other|drop_catch(Tag, Stk)]. new_label(#cg{lcount=Next}=St) -> {Next,St#cg{lcount=Next+1}}. +%% line(Le) -> {line,[] | {location,File,Line}} +%% Create a line instruction, containing information about +%% the current filename and line number. A line information +%% instruction should be placed before any operation that could +%% cause an exception. + +line(#l{a=Anno}) -> + line(Anno); +line([Line,{file,Name}]) when is_integer(Line) -> + line_1(Name, Line); +line([_|_]=A) -> + {Name,Line} = find_loc(A, no_file, 0), + line_1(Name, Line); +line([]) -> + {line,[]}. + +line_1(no_file, _) -> + {line,[]}; +line_1(_, 0) -> + %% Missing line number or line number 0. + {line,[]}; +line_1(Name, Line) -> + {line,[{location,Name,abs(Line)}]}. + +find_loc([Line|T], File, _) when is_integer(Line) -> + find_loc(T, File, Line); +find_loc([{file,File}|T], _, Line) -> + find_loc(T, File, Line); +find_loc([_|T], File, Line) -> + find_loc(T, File, Line); +find_loc([], File, Line) -> {File,Line}. + flatmapfoldl(F, Accu0, [Hd|Tail]) -> {R,Accu1} = F(Hd, Accu0), {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail), diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 87bb5bec25..6885405ae0 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -180,7 +180,7 @@ body(Cs0, Name, Arity, St0) -> {Args,St1} = new_vars(Anno, Arity, St0), {Cs1,St2} = clauses(Cs0, St1), {Ps,St3} = new_vars(Arity, St2), %Need new variables here - Fc = function_clause(Ps, {Name,Arity}), + Fc = function_clause(Ps, Anno, {Name,Arity}), {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}. %% clause(Clause, State) -> {Cclause,State} | noclause. @@ -507,15 +507,15 @@ expr({block,_,Es0}, St0) -> {E1,Es1 ++ Eps,St2}; expr({'if',L,Cs0}, St0) -> {Cs1,St1} = clauses(Cs0, St0), - Fc = fail_clause([], #c_literal{val=if_clause}), Lanno = lineno_anno(L, St1), + Fc = fail_clause([], Lanno, #c_literal{val=if_clause}), {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},[],St1}; expr({'case',L,E0,Cs0}, St0) -> {E1,Eps,St1} = novars(E0, St0), {Cs1,St2} = clauses(Cs0, St1), {Fpat,St3} = new_var(St2), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=case_clause},Fpat])), - Lanno = lineno_anno(L, St3), + Lanno = lineno_anno(L, St2), + Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=case_clause},Fpat])), {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps,St3}; expr({'receive',L,Cs0}, St0) -> {Cs1,St1} = clauses(Cs0, St0), @@ -541,9 +541,10 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> {V,St2} = new_var(St1), %This name should be arbitrary {Cs1,St3} = clauses(Cs0, St2), {Fpat,St4} = new_var(St3), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=try_clause},Fpat])), + Lanno = lineno_anno(L, St4), + Fc = fail_clause([Fpat], Lanno, + c_tuple([#c_literal{val=try_clause},Fpat])), {Evs,Hs,St5} = try_exception(Ecs, St4), - Lanno = lineno_anno(L, St1), {#itry{anno=#a{anno=lineno_anno(L, St5)},args=Es1, vars=[V],body=[#icase{anno=#a{anno=Lanno},args=[V],clauses=Cs1,fc=Fc}], evars=Evs,handler=Hs}, @@ -572,6 +573,13 @@ expr({'catch',L,E0}, St0) -> expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) -> Lanno = lineno_anno(L, St), {#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St}; +expr({'fun',L,{function,M,F,A}}, St0) -> + {As,Aps,St1} = safe_list([M,F,A], St0), + Lanno = lineno_anno(L, St1), + {#icall{anno=#a{anno=Lanno}, + module=#c_literal{val=erlang}, + name=#c_literal{val=make_fun}, + args=As},Aps,St1}; expr({'fun',L,{clauses,Cs},Id}, St) -> fun_tq(Id, Cs, L, St); expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) -> @@ -607,8 +615,8 @@ expr({match,L,P0,E0}, St0) -> Thrown end, {Fpat,St4} = new_var(St3), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=badmatch},Fpat])), Lanno = lineno_anno(L, St4), + Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])), case P2 of nomatch -> St = add_warning(L, nomatch, St4), @@ -828,8 +836,9 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0) -> {Cs1,St1} = clauses(Cs0, St0), {Args,St2} = new_vars(Arity, St1), {Ps,St3} = new_vars(Arity, St2), %Need new variables here - Fc = function_clause(Ps, {Name,Arity}), - Fun = #ifun{anno=#a{anno=lineno_anno(L, St3)}, + Anno = lineno_anno(L, St3), + Fc = function_clause(Ps, Anno, {Name,Arity}), + Fun = #ifun{anno=#a{anno=Anno}, id=[{id,Id}], %We KNOW! vars=Args,clauses=Cs1,fc=Fc}, {Fun,[],St3}. @@ -929,7 +938,7 @@ lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) -> [],St}; lc_tq(Line, E, [Fil0|Qs0], Mc, St0) -> %% Special case sequences guard tests. - LA = lineno_anno(Line, St0), + LA = lineno_anno(element(2, Fil0), St0), LAnno = #a{anno=LA}, case is_guard_test(Fil0) of true -> @@ -945,7 +954,8 @@ lc_tq(Line, E, [Fil0|Qs0], Mc, St0) -> false -> {Lc,Lps,St1} = lc_tq(Line, E, Qs0, Mc, St0), {Fpat,St2} = new_var(St1), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=case_clause},Fpat])), + Fc = fail_clause([Fpat], LA, + c_tuple([#c_literal{val=case_clause},Fpat])), %% Do a novars little optimisation here. {Filc,Fps,St3} = novars(Fil0, St2), {#icase{anno=LAnno, @@ -1072,7 +1082,7 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) -> [],St}; bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) -> %% Special case sequences guard tests. - LA = lineno_anno(Line, St0), + LA = lineno_anno(element(2, Fil0), St0), LAnno = #a{anno=LA}, case is_guard_test(Fil0) of true -> @@ -1089,7 +1099,8 @@ bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) -> false -> {Bc,Bps,St1} = bc_tq1(Line, E, Qs0, AccVar, St0), {Fpat,St2} = new_var(St1), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=case_clause},Fpat])), + Fc = fail_clause([Fpat], LA, + c_tuple([#c_literal{val=case_clause},Fpat])), %% Do a novars little optimisation here. {Filc,Fps,St} = novars(Fil0, St2), {#icase{anno=LAnno, @@ -1562,17 +1573,11 @@ new_vars_1(N, Anno, St0, Vs) when N > 0 -> new_vars_1(N-1, Anno, St1, [V|Vs]); new_vars_1(0, _, St, Vs) -> {Vs,St}. -function_clause(Ps, Name) -> - function_clause(Ps, [], Name). - function_clause(Ps, LineAnno, Name) -> - FcAnno = [{function_name,Name}], + FcAnno = [{function_name,Name}|LineAnno], fail_clause(Ps, FcAnno, ann_c_tuple(LineAnno, [#c_literal{val=function_clause}|Ps])). -fail_clause(Pats, Arg) -> - fail_clause(Pats, [], Arg). - fail_clause(Pats, Anno, Arg) -> #iclause{anno=#a{anno=[compiler_generated]}, pats=Pats,guard=[], diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 3b33a08cf7..47e5e49a76 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -84,8 +84,6 @@ keymember/3,keyfind/3]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). --compile({nowarn_deprecated_function, {erlang,hash,2}}). - -include("core_parse.hrl"). -include("v3_kernel.hrl"). @@ -247,7 +245,7 @@ expr(#c_var{anno=A,name={_Name,Arity}}=Fname, Sub, St) -> %% instead of one for each occurrence as done now. Vs = [#c_var{name=list_to_atom("V" ++ integer_to_list(V))} || V <- integers(1, Arity)], - Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{op=Fname,args=Vs}}, + Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}}, expr(Fun, Sub, St); expr(#c_var{anno=A,name=V}, Sub, St) -> {#k_var{anno=A,name=get_vsub(V, Sub)},[],St}; @@ -291,7 +289,7 @@ expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> Erl = #c_literal{val=erlang}, Name = #c_literal{val=error}, Args = [#c_literal{val=badarg}], - Error = #c_call{module=Erl,name=Name,args=Args}, + Error = #c_call{anno=A,module=Erl,name=Name,args=Args}, expr(Error, Sub, St0) end; expr(#c_fun{anno=A,vars=Cvs,body=Cb}, Sub0, #kern{ff=OldFF,func=Func}=St0) -> @@ -1167,9 +1165,7 @@ select_bin_int_1(_, _, _, _) -> throw(not_possible). select_assert_match_possible(Sz, Val, Fs) -> EmptyBindings = erl_eval:new_bindings(), - MatchFun = fun({integer,_,_}, NewV, Bs) when NewV =:= Val -> - {match,Bs} - end, + MatchFun = match_fun(Val), EvalFun = fun({integer,_,S}, B) -> {value,S,B} end, Expr = [{bin_element,0,{integer,0,Val},{integer,0,Sz},[{unit,1}|Fs]}], {value,Bin,EmptyBindings} = eval_bits:expr_grp(Expr, EmptyBindings, EvalFun), @@ -1184,6 +1180,11 @@ select_assert_match_possible(Sz, Val, Fs) -> throw(not_possible) end. +match_fun(Val) -> + fun(match, {{integer,_,_},NewV,Bs}) when NewV =:= Val -> + {match,Bs} + end. + select_utf8(Val0) -> try Bin = <<Val0/utf8>>, @@ -1655,31 +1656,31 @@ uexpr(#k_catch{anno=A,body=B0}, {break,Rs0}, St0) -> {Ns,St3} = new_vars(1 - length(Rs0), St2), Rs1 = Rs0 ++ Ns, {#k_catch{anno=#k{us=Bu,ns=lit_list_vars(Rs1),a=A},body=B1,ret=Rs1},Bu,St3}; -uexpr(#ifun{anno=A,vars=Vs,body=B0}=IFun, {break,Rs}, St0) -> +uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) -> {B1,Bu,St1} = ubody(B0, return, St0), %Return out of new function Ns = lit_list_vars(Vs), Free = subtract(Bu, Ns), %Free variables in fun Fvs = make_vars(Free), Arity = length(Vs) + length(Free), - {{Index,Uniq,Fname}, St3} = + {Fname,St} = case lists:keyfind(id, 1, A) of - {id,Id} -> - {Id, St1}; + {id,{_,_,Fname0}} -> + {Fname0,St1}; false -> - %% No id annotation. Must invent one. - I = St1#kern.fcount, - U = erlang:hash(IFun, (1 bsl 27)-1), - {N, St2} = new_fun_name(St1), - {{I,U,N}, St2} + %% No id annotation. Must invent a fun name. + new_fun_name(St1) end, Fun = #k_fdef{anno=#k{us=[],ns=[],a=A},func=Fname,arity=Arity, vars=Vs ++ Fvs,body=B1}, + %% Set dummy values for Index and Uniq -- the real values will + %% be assigned by beam_asm. + Index = Uniq = 0, {#k_bif{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A}, op=#k_internal{name=make_fun,arity=length(Free)+3}, args=[#k_atom{val=Fname},#k_int{val=Arity}, #k_int{val=Index},#k_int{val=Uniq}|Fvs], ret=Rs}, - Free,add_local_function(Fun, St3)}; + Free,add_local_function(Fun, St)}; uexpr(Lit, {break,Rs}, St) -> %% Transform literals to puts here. %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,Lit]), diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index a7a4d4dc91..a1d92af9f8 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -65,7 +65,7 @@ functions([], Acc) -> reverse(Acc). %% function(Kfunc) -> Func. -function(#k_fdef{func=F,arity=Ar,vars=Vs,body=Kb}) -> +function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) -> try As = var_list(Vs), Vdb0 = foldl(fun ({var,N}, Vdb) -> new_var(N, 0, Vdb) end, [], As), @@ -80,7 +80,7 @@ function(#k_fdef{func=F,arity=Ar,vars=Vs,body=Kb}) -> put(guard_refc, 0), {B1,_,Vdb1} = body(B0, 1, Vdb0), erase(guard_refc), - {function,F,Ar,As,B1,Vdb1} + {function,F,Ar,As,B1,Vdb1,Anno} catch Class:Error -> Stack = erlang:get_stacktrace(), diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 6a795f6634..f8c71a0257 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -1028,8 +1028,8 @@ haystack_2(Haystack) -> fc({'EXIT',{function_clause,_}}) -> ok; fc({'EXIT',{{case_clause,_},_}}) when ?MODULE =:= bs_match_inline_SUITE -> ok. -fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Args}|_]}}) -> ok; -fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Arity}|_]}}) +fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Args,_}|_]}}) -> ok; +fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Arity,_}|_]}}) when length(Args) =:= Arity -> true = test_server:is_native(?MODULE); fc(_, Args, {'EXIT',{{case_clause,ActualArgs},_}}) diff --git a/lib/compiler/test/bs_utf_SUITE.erl b/lib/compiler/test/bs_utf_SUITE.erl index f30a4d3fef..94549ad0d3 100644 --- a/lib/compiler/test/bs_utf_SUITE.erl +++ b/lib/compiler/test/bs_utf_SUITE.erl @@ -264,18 +264,10 @@ literals(Config) when is_list(Config) -> ?line {'EXIT',{badarg,_}} = (catch <<(-1)/utf32,I/utf8>>), ?line {'EXIT',{badarg,_}} = (catch <<(-1)/little-utf32,I/utf8>>), ?line {'EXIT',{badarg,_}} = (catch <<16#D800/utf8,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFE/utf8,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFF/utf8,I/utf8>>), ?line {'EXIT',{badarg,_}} = (catch <<16#D800/utf16,I/utf8>>), ?line {'EXIT',{badarg,_}} = (catch <<16#D800/little-utf16,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFE/utf16,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFE/little-utf16,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFF/utf16,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFF/little-utf16,I/utf8>>), ?line {'EXIT',{badarg,_}} = (catch <<16#D800/utf32,I/utf8>>), ?line {'EXIT',{badarg,_}} = (catch <<16#D800/little-utf32,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFE/utf32,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFF/little-utf32,I/utf8>>), B = 16#10FFFF+1, ?line {'EXIT',{badarg,_}} = (catch <<B/utf8>>), @@ -286,20 +278,11 @@ literals(Config) when is_list(Config) -> %% Matching of bad literals. ?line error = bad_literal_match(<<237,160,128>>), %16#D800 in UTF-8 - ?line error = bad_literal_match(<<239,191,190>>), %16#FFFE in UTF-8 - ?line error = bad_literal_match(<<239,191,191>>), %16#FFFF in UTF-8 ?line error = bad_literal_match(<<244,144,128,128>>), %16#110000 in UTF-8 - ?line error = bad_literal_match(<<255,254>>), %16#FFFE in UTF-16 - ?line error = bad_literal_match(<<255,255>>), %16#FFFF in UTF-16 - ?line error = bad_literal_match(<<16#D800:32>>), - ?line error = bad_literal_match(<<16#FFFE:32>>), - ?line error = bad_literal_match(<<16#FFFF:32>>), ?line error = bad_literal_match(<<16#110000:32>>), ?line error = bad_literal_match(<<16#D800:32/little>>), - ?line error = bad_literal_match(<<16#FFFE:32/little>>), - ?line error = bad_literal_match(<<16#FFFF:32/little>>), ?line error = bad_literal_match(<<16#110000:32/little>>), ok. @@ -314,11 +297,7 @@ match_literal(<<"bj\366rn"/big-utf16>>) -> bjorn_utf16be; match_literal(<<"bj\366rn"/little-utf16>>) -> bjorn_utf16le. bad_literal_match(<<16#D800/utf8>>) -> ok; -bad_literal_match(<<16#FFFE/utf8>>) -> ok; -bad_literal_match(<<16#FFFF/utf8>>) -> ok; bad_literal_match(<<16#110000/utf8>>) -> ok; -bad_literal_match(<<16#FFFE/utf16>>) -> ok; -bad_literal_match(<<16#FFFF/utf16>>) -> ok; bad_literal_match(<<16#D800/utf32>>) -> ok; bad_literal_match(<<16#110000/utf32>>) -> ok; bad_literal_match(<<16#D800/little-utf32>>) -> ok; diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index b3e5376ffd..8c6a623dfb 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -82,6 +82,7 @@ file_1(Config) when is_list(Config) -> ?line {ok,simple} = compile:file(Simple, [native,report]), %Smoke test. ?line {ok,simple} = compile:file(Target, [native,from_beam]), %Smoke test. ?line {ok,simple} = compile:file(Simple, [debug_info]), + ?line {ok,simple} = compile:file(Simple, [no_line_info]), %Coverage ?line ok = file:set_cwd(Cwd), ?line true = exists(Target), ?line passed = run(Target, test, []), diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index 368a5815bf..6067ee8e06 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -20,7 +20,11 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1]). + test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1, + external/1]). + +%% Internal export. +-export([call_me/1]). -include_lib("test_server/include/test_server.hrl"). @@ -28,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [test1, overwritten_fun, otp_7202, bif_fun]. + [test1,overwritten_fun,otp_7202,bif_fun,external]. groups() -> []. @@ -45,7 +49,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - %%% The help functions below are copied from emulator:bs_construct_SUITE. -define(T(B, L), {B, ??B, L}). @@ -152,4 +155,47 @@ bif_fun(Config) when is_list(Config) -> ?line F = fun abs/1, ?line 5 = F(-5), ok. + +-define(APPLY(M, F, A), (fun(Fun) -> {ok,{a,b}} = Fun({a,b}) end)(fun M:F/A)). +-define(APPLY2(M, F, A), + (fun(Map) -> + Id = fun(I) -> I end, + List = [x,y], + List = Map(Id, List), + {type,external} = erlang:fun_info(Map, type) + end)(fun M:F/A)). +external(Config) when is_list(Config) -> + Mod = id(?MODULE), + Func = id(call_me), + Arity = id(1), + + ?APPLY(?MODULE, call_me, 1), + ?APPLY(?MODULE, call_me, Arity), + ?APPLY(?MODULE, Func, 1), + ?APPLY(?MODULE, Func, Arity), + ?APPLY(Mod, call_me, 1), + ?APPLY(Mod, call_me, Arity), + ?APPLY(Mod, Func, 1), + ?APPLY(Mod, Func, Arity), + + ListsMod = id(lists), + ListsMap = id(map), + ListsArity = id(2), + + ?APPLY2(lists, map, 2), + ?APPLY2(lists, map, ListsArity), + ?APPLY2(lists, ListsMap, 2), + ?APPLY2(lists, ListsMap, ListsArity), + ?APPLY2(ListsMod, map, 2), + ?APPLY2(ListsMod, map, ListsArity), + ?APPLY2(ListsMod, ListsMap, 2), + ?APPLY2(ListsMod, ListsMap, ListsArity), + + ok. + +call_me(I) -> + {ok,I}. + +id(I) -> + I. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 0e69efba6b..40711783ed 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -32,7 +32,8 @@ t_is_boolean/1,is_function_2/1, tricky/1,rel_ops/1,literal_type_tests/1, basic_andalso_orelse/1,traverse_dcd/1, - check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1]). + check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, + bad_constants/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -44,7 +45,8 @@ all() -> more_xor_guards, build_in_guard, old_guard_tests, gbif, t_is_boolean, is_function_2, tricky, rel_ops, literal_type_tests, basic_andalso_orelse, traverse_dcd, - check_qlc_hrl, andalso_semi, t_tuple_size, binary_part]. + check_qlc_hrl, andalso_semi, t_tuple_size, binary_part, + bad_constants]. groups() -> []. @@ -1517,8 +1519,27 @@ bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> -> bptest(_,_,_) -> error. - - +-define(FAILING(C), + if + C -> ?t:fail(should_fail); + true -> ok + end, + if + true, C -> ?t:fail(should_fail); + true -> ok + end). + +bad_constants(Config) when is_list(Config) -> + ?line ?FAILING(false), + ?line ?FAILING([]), + ?line ?FAILING([a]), + ?line ?FAILING([Config]), + ?line ?FAILING({a,b}), + ?line ?FAILING({a,Config}), + ?line ?FAILING(<<1>>), + ?line ?FAILING(42), + ?line ?FAILING(3.14), + ok. %% Call this function to turn off constant propagation. id(I) -> I. diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index af2b8ec92a..086fba2649 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -263,7 +263,8 @@ my_apply(M, F, A, Init) -> really_inlined(Config) when is_list(Config) -> %% Make sure that badarg/2 really gets inlined. - {'EXIT',{badarg,[{?MODULE,fail_me_now,[]}|_]}} = (catch fail_me_now()), + {'EXIT',{badarg,[{?MODULE,fail_me_now,[],_}|_]}} = + (catch fail_me_now()), ok. fail_me_now() -> diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index c8908858ba..f5948504b3 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -179,8 +179,8 @@ empty_generator(Config) when is_list(Config) -> id(I) -> I. -fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args}|_]}}) -> ok; -fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity}|_]}}) +fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args,_}|_]}}) -> ok; +fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity,_}|_]}}) when length(Args) =:= Arity -> true = test_server:is_native(?MODULE); fc(Args, {'EXIT',{{case_clause,ActualArgs},_}}) diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index c941a80e61..9b414cade6 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -179,7 +179,7 @@ silly_coverage(Config) when is_list(Config) -> ?line expect_error(fun() -> v3_life:module(BadKernel, []) end), %% v3_codegen - CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b}]}, + CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b,[]}]}, ?line expect_error(fun() -> v3_codegen:module(CodegenInput, []) end), %% beam_block @@ -187,7 +187,7 @@ silly_coverage(Config) when is_list(Config) -> [{function,foo,0,2, [{label,1}, {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2}|non_proper_list],99}]}, + {label,2}|non_proper_list]}],99}, ?line expect_error(fun() -> beam_block:module(BlockInput, []) end), %% beam_bool diff --git a/lib/compiler/test/pmod_SUITE.erl b/lib/compiler/test/pmod_SUITE.erl index 9a317b5762..3d02adaf52 100644 --- a/lib/compiler/test/pmod_SUITE.erl +++ b/lib/compiler/test/pmod_SUITE.erl @@ -96,6 +96,10 @@ basic_1(Config, Opts) -> ?line error = Prop4:bar_bar({s,a,b}), ?line error = Prop4:bar_bar([]), + %% Call from a fun. + Fun = fun(Arg) -> Prop4:bar(Arg) end, + ?line ok = Fun({s,0}), + ok. otp_8447(Config) when is_list(Config) -> diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index c6e0f8d85d..760cf17225 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -314,19 +314,19 @@ eclectic(Conf) when is_list(Conf) -> V = {make_ref(),3.1415926535,[[]|{}]}, ?line {{value,{value,V},V},V} = eclectic_1({foo,{value,{value,V}}}, undefined, {value,V}), - ?line {{'EXIT',{V,[{?MODULE,foo,1}|_]}},V} = + ?line {{'EXIT',{V,[{?MODULE,foo,1,_}|_]}},V} = eclectic_1({catch_foo,{error,V}}, undefined, {value,V}), ?line {{error,{exit,V},{'EXIT',V}},V} = eclectic_1({foo,{error,{exit,V}}}, error, {value,V}), ?line {{value,{value,V},V}, - {'EXIT',{badarith,[{?MODULE,my_add,2}|_]}}} = + {'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}} = eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}), ?line {{'EXIT',V},V} = eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}), - ?line {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,2}|_]}}}, + ?line {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,2,_}|_]}}}, {'EXIT',V}} = eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}), - ?line {{{error,V},{'EXIT',{V,[{?MODULE,foo,1}|_]}}}, + ?line {{{error,V},{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}}, {'EXIT',V}} = eclectic_1({catch_foo,{throw,{error,V}}}, undefined, {exit,V}), %% @@ -336,15 +336,15 @@ eclectic(Conf) when is_list(Conf) -> eclectic_2({throw,{value,V}}, throw, {value,V}), ?line {{caught,{'EXIT',V}},undefined} = eclectic_2({value,{value,V}}, undefined, {exit,V}), - ?line {{caught,{'EXIT',{V,[{?MODULE,foo,1}|_]}}},undefined} = + ?line {{caught,{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},undefined} = eclectic_2({error,{value,V}}, throw, {error,V}), - ?line {{caught,{'EXIT',{badarg,[{erlang,abs,[V]}|_]}}},V} = + ?line {{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} = eclectic_2({value,{'abs',V}}, undefined, {value,V}), - ?line {{caught,{'EXIT',{badarith,[{?MODULE,my_add,2}|_]}}},V} = + ?line {{caught,{'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}},V} = eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}), ?line {{caught,{'EXIT',V}},undefined} = eclectic_2({value,{error,V}}, undefined, {exit,V}), - ?line {{caught,{'EXIT',{V,[{?MODULE,foo,1}|_]}}},undefined} = + ?line {{caught,{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},undefined} = eclectic_2({throw,{'div',{1,0}}}, throw, {error,V}), ok. diff --git a/lib/cosEvent/doc/src/Makefile b/lib/cosEvent/doc/src/Makefile index 4b76a64b7d..db2f7e6da5 100644 --- a/lib/cosEvent/doc/src/Makefile +++ b/lib/cosEvent/doc/src/Makefile @@ -26,13 +26,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk include ../../vsn.mk VSN=$(COSEVENT_VSN) APPLICATION=cosEvent -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif # ---------------------------------------------------- # Release directory specification @@ -98,32 +91,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf - -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -136,8 +107,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -153,31 +122,6 @@ clean clean_docs: rm -f errs core *~ rm -f $(JD_HTML) $(JD_PACK) -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -192,8 +136,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -204,30 +146,4 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif - release_spec: - diff --git a/lib/cosEvent/doc/src/make.dep b/lib/cosEvent/doc/src/make.dep deleted file mode 100644 index b8a95c2d58..0000000000 --- a/lib/cosEvent/doc/src/make.dep +++ /dev/null @@ -1,34 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosEventChannelAdmin.tex CosEventChannelAdmin_ConsumerAdmin.tex \ - CosEventChannelAdmin_EventChannel.tex CosEventChannelAdmin_ProxyPullConsumer.tex \ - CosEventChannelAdmin_ProxyPullSupplier.tex \ - CosEventChannelAdmin_ProxyPushConsumer.tex \ - CosEventChannelAdmin_ProxyPushSupplier.tex \ - CosEventChannelAdmin_SupplierAdmin.tex book.tex \ - ch_contents.tex ch_event_service.tex ch_introduction.tex \ - cosEventApp.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -CosEventChannelAdmin.tex: ../../src/CosEventChannelAdmin.idl - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: e_s_components.ps e_s_models.ps - diff --git a/lib/cosEvent/src/Makefile b/lib/cosEvent/src/Makefile index a62d47ce74..736b95538a 100644 --- a/lib/cosEvent/src/Makefile +++ b/lib/cosEvent/src/Makefile @@ -164,7 +164,7 @@ debug: @${MAKE} TYPE=debug opt clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) @@ -177,16 +177,18 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_ERL_FILES1) $(EXTERNAL_GEN_HRL_FILES1): CosEventChannelAdmin.idl + +IDL-GENERATED: CosEventChannelAdmin.idl cosEventApp.idl CosEventComm.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosEventChannelAdmin.cfg"}' CosEventChannelAdmin.idl mv $(GEN_HRL_FILES1) $(EXTERNAL_INC_PATH) - -$(GEN_ERL_FILES2) $(GEN_HRL_FILES2): cosEventApp.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"cosEventApp.cfg"}' cosEventApp.idl - -$(GEN_ERL_FILES3) $(EXTERNAL_GEN_HRL_FILES3): CosEventComm.idl erlc $(ERL_IDL_FLAGS) CosEventComm.idl mv $(GEN_HRL_FILES3) $(EXTERNAL_INC_PATH) + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/cosEvent/test/Makefile b/lib/cosEvent/test/Makefile index c59c7ee315..c3f07c156f 100644 --- a/lib/cosEvent/test/Makefile +++ b/lib/cosEvent/test/Makefile @@ -121,17 +121,13 @@ docs: # Special Targets # ---------------------------------------------------- -# -# Each IDL file produces many target files so no pattern -# rule can be used. -# -TGT_COS = \ - $(GEN_HRL_COS:%=$(IDLOUTDIR)/%) \ - $(GEN_MOD_COS:%=$(IDLOUTDIR)/%.erl) +IDL-GENERATED: event_test_server.idl + erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) event_test_server.idl + >IDL-GENERATED +$(GEN_FILES): IDL-GENERATED -$(TGT_COS): event_test_server.idl - erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) event_test_server.idl +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Targets diff --git a/lib/cosEventDomain/doc/src/Makefile b/lib/cosEventDomain/doc/src/Makefile index 6a0d3c353a..b2cdef278a 100644 --- a/lib/cosEventDomain/doc/src/Makefile +++ b/lib/cosEventDomain/doc/src/Makefile @@ -28,14 +28,6 @@ VSN=$(COSEVENTDOMAIN_VSN) APPLICATION=cosEventDomain # ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - -# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) @@ -93,33 +85,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf - -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -132,8 +101,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -149,32 +116,6 @@ clean clean_docs: rm -f errs core *~ rm -f $(JD_HTML) $(JD_PACK) -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -189,9 +130,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk - -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -201,30 +139,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: - diff --git a/lib/cosEventDomain/doc/src/make.dep b/lib/cosEventDomain/doc/src/make.dep deleted file mode 100644 index 2f3f1ae53d..0000000000 --- a/lib/cosEventDomain/doc/src/make.dep +++ /dev/null @@ -1,23 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosEventDomainAdmin.tex CosEventDomainAdmin_EventDomain.tex \ - CosEventDomainAdmin_EventDomainFactory.tex \ - book.tex ch_QoS.tex ch_contents.tex ch_event_domain_service.tex \ - ch_introduction.tex cosEventDomainApp.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/cosEventDomain/src/Makefile b/lib/cosEventDomain/src/Makefile index 56a67cd225..5af790c760 100644 --- a/lib/cosEventDomain/src/Makefile +++ b/lib/cosEventDomain/src/Makefile @@ -137,7 +137,7 @@ debug: @${MAKE} TYPE=debug opt clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) @@ -150,9 +150,14 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_ERL_FILES) $(EXTERNAL_GEN_HRL_FILES): CosEventDomainAdmin.idl +IDL-GENERATED: CosEventDomainAdmin.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosEventDomainAdmin.cfg"}' CosEventDomainAdmin.idl mv $(GEN_HRL_FILES) $(EXTERNAL_INC_PATH) + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/cosFileTransfer/doc/src/Makefile b/lib/cosFileTransfer/doc/src/Makefile index 2286db43ff..e62738daba 100644 --- a/lib/cosFileTransfer/doc/src/Makefile +++ b/lib/cosFileTransfer/doc/src/Makefile @@ -26,14 +26,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk include ../../vsn.mk VSN=$(COSFILETRANSFER_VSN) APPLICATION=cosFileTransfer -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification @@ -97,33 +89,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf - -TOP_PS_FILE = $(APPLICATION)-$-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -136,8 +105,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -152,32 +119,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -192,9 +133,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk - -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -204,30 +142,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: - diff --git a/lib/cosFileTransfer/doc/src/make.dep b/lib/cosFileTransfer/doc/src/make.dep deleted file mode 100644 index 3be0c185c3..0000000000 --- a/lib/cosFileTransfer/doc/src/make.dep +++ /dev/null @@ -1,30 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosFileTransfer_Directory.tex CosFileTransfer_File.tex \ - CosFileTransfer_FileIterator.tex CosFileTransfer_FileTransferSession.tex \ - CosFileTransfer_VirtualFileSystem.tex book.tex \ - ch_contents.tex ch_example.tex ch_install.tex \ - ch_introduction.tex ch_system.tex cosFileTransferApp.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosFileTransfer.ps - diff --git a/lib/cosFileTransfer/src/Makefile b/lib/cosFileTransfer/src/Makefile index 773ed7f6b7..b811ef1106 100644 --- a/lib/cosFileTransfer/src/Makefile +++ b/lib/cosFileTransfer/src/Makefile @@ -147,7 +147,7 @@ cleanb: rm -f errs core *~ clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) @@ -161,9 +161,14 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_ERL_FILES) $(GEN_HRL_FILES): CosFileTransfer.idl +IDL-GENERATED: CosFileTransfer.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosFileTransfer.cfg"}' CosFileTransfer.idl mv $(LOCAL_HRL_FILES) $(EXTERNAL_INC_PATH) + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/cosNotification/doc/src/Makefile b/lib/cosNotification/doc/src/Makefile index bfdd2f1f8c..2ead9aba7b 100644 --- a/lib/cosNotification/doc/src/Makefile +++ b/lib/cosNotification/doc/src/Makefile @@ -28,14 +28,6 @@ VSN=$(COSNOTIFICATION_VSN) APPLICATION=cosNotification # ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - -# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) @@ -122,33 +114,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf - -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -161,8 +130,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -177,32 +144,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -217,8 +158,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -228,30 +167,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: - diff --git a/lib/cosNotification/doc/src/make.dep b/lib/cosNotification/doc/src/make.dep deleted file mode 100644 index 031a2b3e98..0000000000 --- a/lib/cosNotification/doc/src/make.dep +++ /dev/null @@ -1,48 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosNotification.tex CosNotification_AdminPropertiesAdmin.tex \ - CosNotification_QoSAdmin.tex CosNotifyChannelAdmin_ConsumerAdmin.tex \ - CosNotifyChannelAdmin_EventChannel.tex CosNotifyChannelAdmin_EventChannelFactory.tex \ - CosNotifyChannelAdmin_ProxyConsumer.tex CosNotifyChannelAdmin_ProxyPullConsumer.tex \ - CosNotifyChannelAdmin_ProxyPullSupplier.tex \ - CosNotifyChannelAdmin_ProxyPushConsumer.tex \ - CosNotifyChannelAdmin_ProxyPushSupplier.tex \ - CosNotifyChannelAdmin_ProxySupplier.tex CosNotifyChannelAdmin_SequenceProxyPullConsumer.tex \ - CosNotifyChannelAdmin_SequenceProxyPullSupplier.tex \ - CosNotifyChannelAdmin_SequenceProxyPushConsumer.tex \ - CosNotifyChannelAdmin_SequenceProxyPushSupplier.tex \ - CosNotifyChannelAdmin_StructuredProxyPullConsumer.tex \ - CosNotifyChannelAdmin_StructuredProxyPullSupplier.tex \ - CosNotifyChannelAdmin_StructuredProxyPushConsumer.tex \ - CosNotifyChannelAdmin_StructuredProxyPushSupplier.tex \ - CosNotifyChannelAdmin_SupplierAdmin.tex CosNotifyComm_NotifyPublish.tex \ - CosNotifyComm_NotifySubscribe.tex CosNotifyFilter_Filter.tex \ - CosNotifyFilter_FilterAdmin.tex CosNotifyFilter_FilterFactory.tex \ - CosNotifyFilter_MappingFilter.tex book.tex \ - ch_BNF.tex ch_QoS.tex ch_contents.tex ch_example.tex \ - ch_install.tex ch_introduction.tex ch_system.tex \ - cosNotificationApp.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: eventstructure.ps - -book.dvi: notificationFlow.ps - diff --git a/lib/cosNotification/src/Makefile b/lib/cosNotification/src/Makefile index 637c633e52..be52d1a06f 100644 --- a/lib/cosNotification/src/Makefile +++ b/lib/cosNotification/src/Makefile @@ -242,20 +242,26 @@ GEN_OE_EVENTCOMM_HRL_FILES = \ oe_CosNotificationComm.hrl \ oe_CosNotificationComm_Event.hrl -GEN_ERL_FILES = \ +IDL_GEN_ERL_FILES = \ $(GEN_NOTIFICATION_ERL_FILES) \ $(GEN_OE_EVENTCOMM_ERL_FILES) \ $(GEN_NOTIFYCOMM_ERL_FILES) \ $(GEN_NOTIFYFILTER_ERL_FILES) \ - $(GEN_CHANNELADMIN_ERL_FILES) \ - $(GEN_YECC_ERL_FILES) + $(GEN_CHANNELADMIN_ERL_FILES) -GEN_HRL_FILES = \ +IDL_GEN_HRL_FILES = \ $(EXTERNAL_GEN_NOTIFICATION_HRL_FILES) \ $(GEN_OE_EVENTCOMM_HRL_FILES) \ $(EXTERNAL_GEN_NOTIFYCOMM_HRL_FILES) \ $(EXTERNAL_GEN_NOTIFYFILTER_HRL_FILES) \ - $(EXTERNAL_GEN_CHANNELADMIN_HRL_FILES) \ + $(EXTERNAL_GEN_CHANNELADMIN_HRL_FILES) + +GEN_ERL_FILES = \ + $(IDL_GEN_ERL_FILES) \ + $(GEN_YECC_ERL_FILES) + +GEN_HRL_FILES = \ + $(IDL_GEN_HRL_FILES) \ $(GEN_YECC_HRL_FILES) @@ -322,7 +328,7 @@ cleanb: rm -f errs core *~ clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) @@ -336,20 +342,23 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_NOTIFICATION_ERL_FILES) $(EXTERNAL_GEN_NOTIFICATION_HRL_FILES): CosNotification.idl +IDL-GENERATED: CosNotification.idl CosNotifyChannelAdmin.idl \ + CosNotifyFilter.idl cosNotificationAppComm.idl CosNotifyComm.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosNotification.cfg"}' CosNotification.idl mv $(GEN_NOTIFICATION_HRL_FILES) $(EXTERNAL_INC_PATH) -$(GEN_CHANNELADMIN_ERL_FILES) $(EXTERNAL_GEN_CHANNELADMIN_HRL_FILES): CosNotifyChannelAdmin.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosNotifyChannelAdmin.cfg"}' CosNotifyChannelAdmin.idl mv $(GEN_CHANNELADMIN_HRL_FILES) $(EXTERNAL_INC_PATH) -$(GEN_NOTIFYFILTER_ERL_FILES) $(EXTERNAL_GEN_NOTIFYFILTER_HRL_FILES): CosNotifyFilter.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosNotifyFilter.cfg"}' CosNotifyFilter.idl mv $(GEN_NOTIFYFILTER_HRL_FILES) $(EXTERNAL_INC_PATH) -$(GEN_OE_EVENTCOMM_ERL_FILES) $(GEN_OE_EVENTCOMM_HRL_FILES): cosNotificationAppComm.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"cosNotificationComm.cfg"}' cosNotificationAppComm.idl -$(GEN_NOTIFYCOMM_ERL_FILES) $(EXTERNAL_GEN_NOTIFYCOMM_HRL_FILES): CosNotifyComm.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosNotifyComm.cfg"}' CosNotifyComm.idl mv $(GEN_NOTIFYCOMM_HRL_FILES) $(EXTERNAL_INC_PATH) + >IDL-GENERATED + +$(IDL_GEN_ERL_FILES) $(IDL_GEN_HRL_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED + $(GEN_YECC_ERL_FILES) $(GEN_YECC_HRL_FILES): cosNotification_Grammar.yrl # ---------------------------------------------------- diff --git a/lib/cosNotification/test/Makefile b/lib/cosNotification/test/Makefile index 43f73addae..f509370430 100644 --- a/lib/cosNotification/test/Makefile +++ b/lib/cosNotification/test/Makefile @@ -161,13 +161,14 @@ docs: # Special Targets # ---------------------------------------------------- -TGT_TEST = \ - $(GEN_HRL_FILES:%=$(IDLOUTDIR)/%) \ - $(GEN_MODULES:%=$(IDLOUTDIR)/%.erl) - -$(TGT_TEST): notify_test_server.idl +IDL-GENERATED: notify_test_server.idl erlc $(ERL_COMPILE_FLAGS) -o$(IDLOUTDIR) \ +'{cfgfile,"notify_test_server.cfg"}' notify_test_server.idl + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Targets diff --git a/lib/cosProperty/doc/src/Makefile b/lib/cosProperty/doc/src/Makefile index baf995d35e..d4c89ff44f 100644 --- a/lib/cosProperty/doc/src/Makefile +++ b/lib/cosProperty/doc/src/Makefile @@ -28,14 +28,6 @@ VSN=$(COSPROPERTY_VSN) APPLICATION=cosProperty # ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - -# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) @@ -99,35 +91,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) MAN6_FILES = $(XML_REF6_FILES:%.xml=$(MAN6DIR)/%.6) - -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_REF6_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf - -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -140,8 +107,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -156,42 +121,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -tex_users_guide: $(TEX_FILES_USERS_GUIDE) -tex_ref_man: $(TEX_FILES_REF_MAN) -tex: tex_users_guide tex_ref_man $(TEX_FILES_BOOK) - -$(DOCDIR)/latexlog: $(BOOK_FILES:%.xml=%.dvi) - -fgrep -i "latex warning" $(BOOK_FILES:%.xml=%.log) >$(DOCDIR)/latexlog - -clean_tex: - -rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - -clean: - rm -f ../html/* $(MAN3_FILES) $(MAN6_FILES) $(TEX_FILES_USERS_GUIDE) - rm -f *xmls_output *xmls_errs - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) $(MAN6_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -206,8 +135,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -217,30 +144,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: - diff --git a/lib/cosProperty/doc/src/make.dep b/lib/cosProperty/doc/src/make.dep deleted file mode 100644 index 383af54244..0000000000 --- a/lib/cosProperty/doc/src/make.dep +++ /dev/null @@ -1,26 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosPropertyService_PropertiesIterator.tex \ - CosPropertyService_PropertyNamesIterator.tex \ - CosPropertyService_PropertySet.tex CosPropertyService_PropertySetDef.tex \ - CosPropertyService_PropertySetDefFactory.tex \ - CosPropertyService_PropertySetFactory.tex \ - book.tex ch_contents.tex ch_example.tex ch_install.tex \ - ch_introduction.tex cosProperty.tex part.tex \ - ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/cosProperty/src/Makefile b/lib/cosProperty/src/Makefile index 1d2119dfb3..b72019f37d 100644 --- a/lib/cosProperty/src/Makefile +++ b/lib/cosProperty/src/Makefile @@ -147,7 +147,7 @@ cleanb: rm -f errs core *~ clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) @@ -161,10 +161,14 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_ERL_FILES) $(GEN_HRL_FILES): CosProperty.idl +IDL-GENERATED: CosProperty.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosProperty.cfg"}' CosProperty.idl mv $(LOCAL_HRL_FILES) $(EXTERNAL_INC_PATH) + >IDL-GENERATED +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/cosTime/doc/src/Makefile b/lib/cosTime/doc/src/Makefile index 83abc5e7c2..af418896aa 100644 --- a/lib/cosTime/doc/src/Makefile +++ b/lib/cosTime/doc/src/Makefile @@ -28,14 +28,6 @@ VSN=$(COSTIME_VSN) APPLICATION=cosTime # ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - -# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) @@ -93,33 +85,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf - -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -132,8 +101,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -148,32 +115,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -188,8 +129,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -199,30 +138,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: - diff --git a/lib/cosTime/doc/src/make.dep b/lib/cosTime/doc/src/make.dep deleted file mode 100644 index 69a584ab95..0000000000 --- a/lib/cosTime/doc/src/make.dep +++ /dev/null @@ -1,22 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosTime_TIO.tex CosTime_TimeService.tex CosTime_UTO.tex \ - CosTimerEvent_TimerEventHandler.tex CosTimerEvent_TimerEventService.tex \ - book.tex ch_contents.tex ch_example.tex ch_install.tex \ - ch_introduction.tex cosTime.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/cosTime/src/Makefile b/lib/cosTime/src/Makefile index 3b6f7bae2e..fa456249bd 100644 --- a/lib/cosTime/src/Makefile +++ b/lib/cosTime/src/Makefile @@ -162,7 +162,7 @@ cleanb: rm -f errs core *~ clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) @@ -176,17 +176,18 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_TIMEBASE_ERL_FILES) $(EXTERNAL_TIMEBASE_HRL_FILES): TimeBase.idl +IDL-GENERATED: TimeBase.idl CosTime.idl CosTimerEvent.idl erlc $(ERL_IDL_FLAGS) TimeBase.idl mv $(GEN_TIMEBASE_HRL_FILES) $(EXTERNAL_INC_PATH) - -$(GEN_COSTIME_ERL_FILES) $(EXTERNAL_COSTIME_HRL_FILES): CosTime.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosTime.cfg"}' CosTime.idl mv $(GEN_COSTIME_HRL_FILES) $(EXTERNAL_INC_PATH) - -$(GEN_COSTIMEREVENT_ERL_FILES) $(EXTERNAL_COSTIMEREVENT_HRL_FILES): CosTimerEvent.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosTimerEvent.cfg"}' CosTimerEvent.idl mv $(GEN_COSTIMEREVENT_HRL_FILES) $(EXTERNAL_INC_PATH) + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/cosTransactions/doc/src/Makefile b/lib/cosTransactions/doc/src/Makefile index 1af9ed24b7..7d959cbc8f 100644 --- a/lib/cosTransactions/doc/src/Makefile +++ b/lib/cosTransactions/doc/src/Makefile @@ -28,14 +28,6 @@ VSN=$(COSTRANSACTIONS_VSN) APPLICATION=cosTransactions # ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - -# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) @@ -97,33 +89,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf - -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -136,8 +105,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -152,32 +119,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -192,8 +133,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -203,30 +142,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: - diff --git a/lib/cosTransactions/doc/src/make.dep b/lib/cosTransactions/doc/src/make.dep deleted file mode 100644 index bd45aea286..0000000000 --- a/lib/cosTransactions/doc/src/make.dep +++ /dev/null @@ -1,27 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosTransactions_Control.tex CosTransactions_Coordinator.tex \ - CosTransactions_RecoveryCoordinator.tex CosTransactions_Resource.tex \ - CosTransactions_SubtransactionAwareResource.tex \ - CosTransactions_Terminator.tex CosTransactions_TransactionFactory.tex \ - book.tex ch_contents.tex ch_example.tex ch_install.tex \ - ch_introduction.tex ch_skeletons.tex cosTransactions.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -ch_example.tex: ../../../../system/doc/definitions/term.defs - diff --git a/lib/cosTransactions/src/Makefile b/lib/cosTransactions/src/Makefile index 7e10ec175b..e7d4b0b080 100644 --- a/lib/cosTransactions/src/Makefile +++ b/lib/cosTransactions/src/Makefile @@ -141,7 +141,7 @@ debug: @${MAKE} TYPE=debug clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) @@ -155,9 +155,14 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_ERL_FILES) $(EXTERNAL_GEN_HRL_FILES): CosTransactions.idl +IDL-GENERATED: CosTransactions.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosTransactions.cfg"}' CosTransactions.idl mv $(GEN_HRL_FILES) $(EXTERNAL_INC_PATH) + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/cosTransactions/test/Makefile b/lib/cosTransactions/test/Makefile index 44c90e8f84..0bc8c007da 100644 --- a/lib/cosTransactions/test/Makefile +++ b/lib/cosTransactions/test/Makefile @@ -121,13 +121,14 @@ docs: # Special Targets # ---------------------------------------------------- -TGT_TEST = \ - $(GEN_HRL_FILES:%=$(IDLOUTDIR)/%) \ - $(GEN_MODULES:%=$(IDLOUTDIR)/%.erl) - -$(TGT_TEST): etrap_test.idl +IDL-GENERATED: etrap_test.idl erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) \ +'{cfgfile,"etrap_test.cfg"}' etrap_test.idl + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Targets diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in index c2a986c334..285537643e 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -95,13 +95,9 @@ endif # Targets # ---------------------------------------------------- -debug opt valgrind: $(OBJDIR) $(LIBDIR) $(NIF_LIB) +_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) -$(OBJDIR): - -@mkdir -p $(OBJDIR) - -$(LIBDIR): - -@mkdir -p $(LIBDIR) +debug opt valgrind: $(NIF_LIB) $(OBJDIR)/%$(TYPEMARKER).o: %.c $(INSTALL_DIR) $(OBJDIR) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index c781ccb302..802c1991de 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -134,8 +134,10 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM des_ede3_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -152,7 +154,7 @@ static ERL_NIF_TERM exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM rc2_40_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM rc2_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -210,8 +212,10 @@ static ErlNifFunc nif_funcs[] = { {"hmac_final", 1, hmac_final}, {"hmac_final_n", 2, hmac_final}, {"des_cbc_crypt", 4, des_cbc_crypt}, + {"des_cfb_crypt", 4, des_cfb_crypt}, {"des_ecb_crypt", 3, des_ecb_crypt}, {"des_ede3_cbc_crypt", 6, des_ede3_cbc_crypt}, + {"des_ede3_cfb_crypt", 6, des_ede3_cfb_crypt}, {"aes_cfb_128_crypt", 4, aes_cfb_128_crypt}, {"aes_ctr_encrypt", 3, aes_ctr_encrypt}, {"aes_ctr_decrypt", 3, aes_ctr_encrypt}, @@ -230,7 +234,7 @@ static ErlNifFunc nif_funcs[] = { {"rc4_encrypt", 2, rc4_encrypt}, {"rc4_set_key", 1, rc4_set_key}, {"rc4_encrypt_with_state", 2, rc4_encrypt_with_state}, - {"rc2_40_cbc_crypt", 4, rc2_40_cbc_crypt}, + {"rc2_cbc_crypt", 4, rc2_cbc_crypt}, {"rsa_sign_nif", 3, rsa_sign_nif}, {"dss_sign_nif", 3, dss_sign_nif}, {"rsa_public_crypt", 4, rsa_public_crypt}, @@ -693,6 +697,25 @@ static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a return ret; } +static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, Ivec, Text, IsEncrypt) */ + ErlNifBinary key, ivec, text; + DES_key_schedule schedule; + DES_cblock ivec_clone; /* writable copy */ + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8 + || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { + return enif_make_badarg(env); + } + memcpy(&ivec_clone, ivec.data, 8); + DES_set_key((const_DES_cblock*)key.data, &schedule); + DES_cfb_encrypt(text.data, enif_make_new_binary(env, text.size, &ret), + 8, text.size, &schedule, &ivec_clone, (argv[3] == atom_true)); + return ret; +} + static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, Text/Cipher, IsEncrypt) */ ErlNifBinary key, text; @@ -735,6 +758,31 @@ static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_T return ret; } +static ERL_NIF_TERM des_ede3_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key1, Key2, Key3, IVec, Text/Cipher, IsEncrypt) */ + ErlNifBinary key1, key2, key3, ivec, text; + DES_key_schedule schedule1, schedule2, schedule3; + DES_cblock ivec_clone; /* writable copy */ + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key1) || key1.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[1], &key2) || key2.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[2], &key3) || key3.size != 8 + || !enif_inspect_binary(env, argv[3], &ivec) || ivec.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[4], &text)) { + return enif_make_badarg(env); + } + + memcpy(&ivec_clone, ivec.data, 8); + DES_set_key((const_DES_cblock*)key1.data, &schedule1); + DES_set_key((const_DES_cblock*)key2.data, &schedule2); + DES_set_key((const_DES_cblock*)key3.data, &schedule3); + DES_ede3_cfb_encrypt(text.data, enif_make_new_binary(env,text.size,&ret), + 8, text.size, &schedule1, &schedule2, &schedule3, + &ivec_clone, (argv[5] == atom_true)); + return ret; +} + static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, IVec, Data, IsEncrypt) */ ErlNifBinary key, ivec, text; @@ -1189,30 +1237,31 @@ static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_N return enif_make_tuple2(env,new_state,new_data); } -static ERL_NIF_TERM rc2_40_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM rc2_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,IVec,Data,IsEncrypt) */ ErlNifBinary key_bin, ivec_bin, data_bin; RC2_KEY rc2_key; ERL_NIF_TERM ret; - + unsigned char iv_copy[8]; + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || key_bin.size != 5 + || (key_bin.size != 5 && key_bin.size != 8 && key_bin.size != 16) || !enif_inspect_binary(env, argv[1], &ivec_bin) || ivec_bin.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)) { - + || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin) + || data_bin.size % 8 != 0) { return enif_make_badarg(env); } - - RC2_set_key(&rc2_key, 5, key_bin.data, 40); + + RC2_set_key(&rc2_key, key_bin.size, key_bin.data, key_bin.size*8); + memcpy(iv_copy, ivec_bin.data, 8); RC2_cbc_encrypt(data_bin.data, - enif_make_new_binary(env, data_bin.size, &ret), + enif_make_new_binary(env, data_bin.size, &ret), data_bin.size, &rc2_key, - ivec_bin.data, + iv_copy, (argv[3] == atom_true)); - return ret; -} +} static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type,Data,Key=[E,N,D]) */ diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 4c20f81cae..48243fd693 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd"> <erlref> @@ -334,14 +334,16 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </func> <func> <name>sha_mac(Key, Data) -> Mac</name> + <name>sha_mac(Key, Data, MacLength) -> Mac</name> <fsummary>Compute an <c>MD5 MAC</c>message authentification code</fsummary> <type> <v>Key = Data = iolist() | binary()</v> <v>Mac = binary()</v> + <v>MacLenength = integer() =< 20 </v> </type> <desc> <p>Computes an <c>SHA MAC</c> message authentification code - from <c>Key</c> and <c>Data</c>, where the length of the Mac + from <c>Key</c> and <c>Data</c>, where the default length of the Mac is 160 bits (20 bytes).</p> </desc> </func> @@ -404,6 +406,51 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </desc> </func> <func> + <name>des_cfb_encrypt(Key, IVec, Text) -> Cipher</name> + <fsummary>Encrypt <c>Text</c>according to DES in CFB mode</fsummary> + <type> + <v>Key = Text = iolist() | binary()</v> + <v>IVec = Cipher = binary()</v> + </type> + <desc> + <p>Encrypts <c>Text</c> according to DES in 8-bit CFB + mode. <c>Key</c> is the DES key, and <c>IVec</c> is an + arbitrary initializing vector. The lengths of <c>Key</c> and + <c>IVec</c> must be 64 bits (8 bytes).</p> + </desc> + </func> + <func> + <name>des_cfb_decrypt(Key, IVec, Cipher) -> Text</name> + <fsummary>Decrypt <c>Cipher</c>according to DES in CFB mode</fsummary> + <type> + <v>Key = Cipher = iolist() | binary()</v> + <v>IVec = Text = binary()</v> + </type> + <desc> + <p>Decrypts <c>Cipher</c> according to DES in 8-bit CFB mode. + <c>Key</c> is the DES key, and <c>IVec</c> is an arbitrary + initializing vector. <c>Key</c> and <c>IVec</c> must have + the same values as those used when encrypting. The lengths of + <c>Key</c> and <c>IVec</c> must be 64 bits (8 bytes).</p> + </desc> + </func> + <func> + <name>des_cfb_ivec(IVec, Data) -> NextIVec</name> + <fsummary>Get <c>IVec</c> to be used in next iteration of + <c>des_cfb_[ecrypt|decrypt]</c></fsummary> + <type> + <v>IVec = iolist() | binary()</v> + <v>Data = iolist() | binary()</v> + <v>NextIVec = binary()</v> + </type> + <desc> + <p>Returns the <c>IVec</c> to be used in a next iteration of + <c>des_cfb_[encrypt|decrypt]</c>. <c>IVec</c> is the vector + used in the previous iteration step. <c>Data</c> is the encrypted + data from the previous iteration step.</p> + </desc> + </func> + <func> <name>des3_cbc_encrypt(Key1, Key2, Key3, IVec, Text) -> Cipher</name> <fsummary>Encrypt <c>Text</c>according to DES3 in CBC mode</fsummary> <type> @@ -421,7 +468,7 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </func> <func> <name>des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher) -> Text</name> - <fsummary>Decrypt <c>Cipher</c>according to DES in CBC mode</fsummary> + <fsummary>Decrypt <c>Cipher</c>according to DES3 in CBC mode</fsummary> <type> <v>Key1 = Key2 = Key3 = Cipher = iolist() | binary()</v> <v>IVec = Text = binary()</v> @@ -437,6 +484,38 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> <c>Key3</c>, and <c>IVec</c> must be 64 bits (8 bytes).</p> </desc> </func> + <func> + <name>des3_cfb_encrypt(Key1, Key2, Key3, IVec, Text) -> Cipher</name> + <fsummary>Encrypt <c>Text</c>according to DES3 in CFB mode</fsummary> + <type> + <v>Key1 =Key2 = Key3 Text = iolist() | binary()</v> + <v>IVec = Cipher = binary()</v> + </type> + <desc> + <p>Encrypts <c>Text</c> according to DES3 in 8-bit CFB + mode. <c>Key1</c>, <c>Key2</c>, <c>Key3</c>, are the DES + keys, and <c>IVec</c> is an arbitrary initializing + vector. The lengths of each of <c>Key1</c>, <c>Key2</c>, + <c>Key3</c> and <c>IVec</c> must be 64 bits (8 bytes).</p> + </desc> + </func> + <func> + <name>des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher) -> Text</name> + <fsummary>Decrypt <c>Cipher</c>according to DES3 in CFB mode</fsummary> + <type> + <v>Key1 = Key2 = Key3 = Cipher = iolist() | binary()</v> + <v>IVec = Text = binary()</v> + </type> + <desc> + <p>Decrypts <c>Cipher</c> according to DES3 in 8-bit CFB mode. + <c>Key1</c>, <c>Key2</c>, <c>Key3</c> are the DES key, and + <c>IVec</c> is an arbitrary initializing vector. + <c>Key1</c>, <c>Key2</c>, <c>Key3</c> and <c>IVec</c> must + and <c>IVec</c> must have the same values as those used when + encrypting. The lengths of <c>Key1</c>, <c>Key2</c>, + <c>Key3</c>, and <c>IVec</c> must be 64 bits (8 bytes).</p> + </desc> + </func> <func> <name>des_ecb_encrypt(Key, Text) -> Cipher</name> @@ -969,6 +1048,30 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </func> <func> + <name>rc2_cbc_encrypt(Key, IVec, Text) -> Cipher</name> + <fsummary>Encrypt <c>Text</c>according to RC2 in CBC mode</fsummary> + <type> + <v>Key = Text = iolist() | binary()</v> + <v>Ivec = Cipher = binary()</v> + </type> + <desc> + <p>Encrypts <c>Text</c> according to RC2 in CBC mode.</p> + </desc> + </func> + + <func> + <name>rc2_cbc_decrypt(Key, IVec, Cipher) -> Text</name> + <fsummary>Decrypts <c>Cipher</c>according to RC2 in CBC mode</fsummary> + <type> + <v>Key = Text = iolist() | binary()</v> + <v>Ivec = Cipher = binary()</v> + </type> + <desc> + <p>Decrypts <c>Cipher</c> according to RC2 in CBC mode.</p> + </desc> + </func> + + <func> <name>rc4_encrypt(Key, Data) -> Result</name> <fsummary>Encrypt data using RC4</fsummary> <type> diff --git a/lib/crypto/doc/src/make.dep b/lib/crypto/doc/src/make.dep deleted file mode 100644 index 73b090bbb6..0000000000 --- a/lib/crypto/doc/src/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex crypto.tex crypto_app.tex licenses.tex \ - ref_man.tex usersguide.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index c3e13d6b91..0714cb686d 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -27,11 +27,13 @@ -export([sha/1, sha_init/0, sha_update/2, sha_final/1]). %-export([sha256/1, sha256_init/0, sha256_update/2, sha256_final/1]). %-export([sha512/1, sha512_init/0, sha512_update/2, sha512_final/1]). --export([md5_mac/2, md5_mac_96/2, sha_mac/2, sha_mac_96/2]). +-export([md5_mac/2, md5_mac_96/2, sha_mac/2, sha_mac/3, sha_mac_96/2]). -export([hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]). -export([des_cbc_encrypt/3, des_cbc_decrypt/3, des_cbc_ivec/1]). -export([des_ecb_encrypt/2, des_ecb_decrypt/2]). +-export([des_cfb_encrypt/3, des_cfb_decrypt/3, des_cfb_ivec/2]). -export([des3_cbc_encrypt/5, des3_cbc_decrypt/5]). +-export([des3_cfb_encrypt/5, des3_cfb_decrypt/5]). -export([blowfish_ecb_encrypt/2, blowfish_ecb_decrypt/2]). -export([blowfish_cbc_encrypt/3, blowfish_cbc_decrypt/3]). -export([blowfish_cfb64_encrypt/3, blowfish_cfb64_decrypt/3]). @@ -40,7 +42,7 @@ -export([aes_cfb_128_encrypt/3, aes_cfb_128_decrypt/3]). -export([exor/2]). -export([rc4_encrypt/2, rc4_set_key/1, rc4_encrypt_with_state/2]). --export([rc2_40_cbc_encrypt/3, rc2_40_cbc_decrypt/3]). +-export([rc2_cbc_encrypt/3, rc2_cbc_decrypt/3, rc2_40_cbc_encrypt/3, rc2_40_cbc_decrypt/3]). -export([dss_verify/3, dss_verify/4, rsa_verify/3, rsa_verify/4]). -export([dss_sign/2, dss_sign/3, rsa_sign/2, rsa_sign/3]). -export([rsa_public_encrypt/3, rsa_private_decrypt/3]). @@ -68,8 +70,10 @@ sha_mac, sha_mac_96, sha_mac_init, sha_mac_update, sha_mac_final, des_cbc_encrypt, des_cbc_decrypt, + des_cfb_encrypt, des_cfb_decrypt, des_ecb_encrypt, des_ecb_decrypt, des_ede3_cbc_encrypt, des_ede3_cbc_decrypt, + des_ede3_cfb_encrypt, des_ede3_cfb_decrypt, aes_cfb_128_encrypt, aes_cfb_128_decrypt, rand_bytes, strong_rand_bytes, @@ -79,7 +83,7 @@ dss_verify,dss_sign, rsa_verify,rsa_sign, rsa_public_encrypt,rsa_private_decrypt, - rsa_private_encrypt,rsa_public_decrypt, + rsa_private_encrypt,rsa_public_decrypt, dh_generate_key, dh_compute_key, aes_cbc_128_encrypt, aes_cbc_128_decrypt, exor, @@ -87,7 +91,7 @@ rc2_40_cbc_encrypt, rc2_40_cbc_decrypt, %% idea_cbc_encrypt, idea_cbc_decrypt, aes_cbc_256_encrypt, aes_cbc_256_decrypt, - aes_ctr_encrypt, aes_ctr_decrypt, + aes_ctr_encrypt, aes_ctr_decrypt, aes_ctr_stream_init, aes_ctr_stream_encrypt, aes_ctr_stream_decrypt, info_lib]). @@ -256,6 +260,9 @@ md5_mac_n(_Key,_Data,_MacSz) -> ?nif_stub. sha_mac(Key, Data) -> sha_mac_n(Key,Data,20). +sha_mac(Key, Data, Size) -> + sha_mac_n(Key, Data, Size). + sha_mac_96(Key, Data) -> sha_mac_n(Key,Data,12). @@ -294,6 +301,33 @@ des_cbc_ivec(Data) when is_list(Data) -> des_cbc_ivec(list_to_binary(Data)). %% +%% DES - in 8-bits cipher feedback mode (CFB) +%% +-spec des_cfb_encrypt(iodata(), binary(), iodata()) -> binary(). +-spec des_cfb_decrypt(iodata(), binary(), iodata()) -> binary(). + +des_cfb_encrypt(Key, IVec, Data) -> + des_cfb_crypt(Key, IVec, Data, true). + +des_cfb_decrypt(Key, IVec, Data) -> + des_cfb_crypt(Key, IVec, Data, false). + +des_cfb_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + +%% +%% dec_cfb_ivec(IVec, Data) -> binary() +%% +%% Returns the IVec to be used in the next iteration of +%% des_cfb_[encrypt|decrypt]. +%% +-spec des_cfb_ivec(iodata(), iodata()) -> binary(). + +des_cfb_ivec(IVec, Data) -> + IVecAndData = list_to_binary([IVec, Data]), + {_, NewIVec} = split_binary(IVecAndData, byte_size(IVecAndData) - 8), + NewIVec. + +%% %% DES - in electronic codebook mode (ECB) %% -spec des_ecb_encrypt(iodata(), iodata()) -> binary(). @@ -326,6 +360,26 @@ des_ede3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) -> des_ede3_cbc_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% +%% DES3 - in 8-bits cipher feedback mode (CFB) +%% +-spec des3_cfb_encrypt(iodata(), iodata(), iodata(), binary(), iodata()) -> + binary(). +-spec des3_cfb_decrypt(iodata(), iodata(), iodata(), binary(), iodata()) -> + binary(). + +des3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) -> + des_ede3_cfb_encrypt(Key1, Key2, Key3, IVec, Data). +des_ede3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) -> + des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, true). + +des3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) -> + des_ede3_cfb_decrypt(Key1, Key2, Key3, IVec, Data). +des_ede3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) -> + des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, false). + +des_ede3_cfb_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + +%% %% Blowfish %% -spec blowfish_ecb_encrypt(iodata(), iodata()) -> binary(). @@ -638,16 +692,25 @@ rc4_encrypt(_Key, _Data) -> ?nif_stub. rc4_set_key(_Key) -> ?nif_stub. rc4_encrypt_with_state(_State, _Data) -> ?nif_stub. + +%% RC2 block cipher + +rc2_cbc_encrypt(Key, IVec, Data) -> + rc2_cbc_crypt(Key,IVec,Data,true). + +rc2_cbc_decrypt(Key, IVec, Data) -> + rc2_cbc_crypt(Key,IVec,Data,false). + +rc2_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + %% -%% RC2 - 40 bits block cipher +%% RC2 - 40 bits block cipher - Backwards compatibility not documented. %% -rc2_40_cbc_encrypt(Key, IVec, Data) -> - rc2_40_cbc_crypt(Key,IVec,Data,true). - -rc2_40_cbc_decrypt(Key, IVec, Data) -> - rc2_40_cbc_crypt(Key,IVec,Data,false). +rc2_40_cbc_encrypt(Key, IVec, Data) when erlang:byte_size(Key) == 5 -> + rc2_cbc_crypt(Key,IVec,Data,true). -rc2_40_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. +rc2_40_cbc_decrypt(Key, IVec, Data) when erlang:byte_size(Key) == 5 -> + rc2_cbc_crypt(Key,IVec,Data,false). %% %% DH Diffie-Hellman functions diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 486751766b..86acdc27df 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -44,7 +44,12 @@ md5_mac_io/1, des_cbc/1, des_cbc_iter/1, + des_cfb/1, + des_cfb_iter/1, des_ecb/1, + des3_cbc/1, + des3_cfb/1, + rc2_cbc/1, aes_cfb/1, aes_cbc/1, aes_cbc_iter/1, @@ -75,7 +80,9 @@ all() -> md5_mac_io, sha, sha_update, hmac_update_sha, hmac_update_sha_n, hmac_update_md5_n, hmac_update_md5_io, hmac_update_md5, %% sha256, sha256_update, sha512,sha512_update, - des_cbc, aes_cfb, aes_cbc, + des_cbc, des_cfb, des3_cbc, des3_cfb, rc2_cbc, aes_cfb, aes_cbc, + aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_cfb_iter, des_ecb, + des_cbc, rc2_cbc, aes_cfb, aes_cbc, aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_ecb, rand_uniform_test, strong_rand_test, rsa_verify_test, dsa_verify_test, rsa_sign_test, @@ -292,7 +299,7 @@ sha(Config) when is_list(Config) -> hexstr2bin("84983E441C3BD26EBAAE4AA1F95129E5E54670F1")). -%% +%% hmac_update_sha_n(doc) -> ["Request a larger-than-allowed SHA1 HMAC using hmac_init, hmac_update, and hmac_final_n. " "Expected values for examples are generated using crypto:sha_mac." ]; @@ -343,7 +350,7 @@ hmac_update_md5(Config) when is_list(Config) -> Key2 = "A fine speach by a fine man!", ?line Long1 = "Four score and seven years ago our fathers brought forth on this continent a new nation, conceived in liberty, and dedicated to the proposition that all men are created equal.", ?line Long2 = "Now we are engaged in a great civil war, testing whether that nation, or any nation, so conceived and so dedicated, can long endure. We are met on a great battle-field of that war. We have come to dedicate a portion of that field, as a final resting place for those who here gave their lives that that nation might live. It is altogether fitting and proper that we should do this.", - ?line Long3 = "But, in a larger sense, we can not dedicate, we can not consecrate, we can not hallow this ground. The brave men, living and dead, who struggled here, have consecrated it, far above our poor power to add or detract. The world will little note, nor long remember what we say here, but it can never forget what they did here. It is for us the living, rather, to be dedicated here to the unfinished work which they who fought here have thus far so nobly advanced. It is rather for us to be here dedicated to the great task remaining before us-that from these honored dead we take increased devotion to that cause for which they gave the last full measure of devotion—that we here highly resolve that these dead shall not have died in vain-that this nation, under God, shall have a new birth of freedom-and that government of the people, by the people, for the people, shall not perish from the earth.", + ?line Long3 = "But, in a larger sense, we can not dedicate, we can not consecrate, we can not hallow this ground. The brave men, living and dead, who struggled here, have consecrated it, far above our poor power to add or detract. The world will little note, nor long remember what we say here, but it can never forget what they did here. It is for us the living, rather, to be dedicated here to the unfinished work which they who fought here have thus far so nobly advanced. It is rather for us to be here dedicated to the great task remaining before us-that from these honored dead we take increased devotion to that cause for which they gave the last full measure of devotion that we here highly resolve that these dead shall not have died in vain-that this nation, under God, shall have a new birth of freedom-and that government of the people, by the people, for the people, shall not perish from the earth.", ?line CtxA = crypto:hmac_init(md5, Key2), ?line CtxB = crypto:hmac_update(CtxA, Long1), ?line CtxC = crypto:hmac_update(CtxB, Long2), @@ -547,6 +554,40 @@ des_cbc_iter(Config) when is_list(Config) -> %% %% +des_cfb(doc) -> + "Encrypt and decrypt according to CFB DES. and check the result. " + "Example is from FIPS-81."; +des_cfb(suite) -> + []; +des_cfb(Config) when is_list(Config) -> + ?line Key = hexstr2bin("0123456789abcdef"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain = "Now is the", + ?line Cipher = crypto:des_cfb_encrypt(Key, IVec, Plain), + ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")), + ?line m(list_to_binary(Plain), + crypto:des_cfb_decrypt(Key, IVec, Cipher)). + +%% +%% +des_cfb_iter(doc) -> + "Encrypt and decrypt according to CFB DES in two steps, and " + "check the result. Example is from FIPS-81."; +des_cfb_iter(suite) -> + []; +des_cfb_iter(Config) when is_list(Config) -> + ?line Key = hexstr2bin("0123456789abcdef"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain1 = "Now i", + ?line Plain2 = "s the", + ?line Cipher1 = crypto:des_cfb_encrypt(Key, IVec, Plain1), + ?line IVec2 = crypto:des_cfb_ivec(IVec, Cipher1), + ?line Cipher2 = crypto:des_cfb_encrypt(Key, IVec2, Plain2), + ?line Cipher = list_to_binary([Cipher1, Cipher2]), + ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")). + +%% +%% des_ecb(doc) -> "Encrypt and decrypt according to ECB DES and check the result. " "Example are from FIPS-81."; @@ -566,6 +607,81 @@ des_ecb(Config) when is_list(Config) -> ?line m(Cipher5, <<"he time ">>), ?line Cipher6 = crypto:des_ecb_decrypt(Key, hexstr2bin("893d51ec4b563b53")), ?line m(Cipher6, <<"for all ">>). +%% +%% +rc2_cbc(doc) -> + "Encrypt and decrypt according to RC2 CBC and check the result. " + "Example stripped out from public_key application test"; +rc2_cbc(Config) when is_list(Config) -> + + Key = <<146,210,160,124,215,227,153,239,227,17,222,140,3,93,27,191>>, + IV = <<72,91,135,182,25,42,35,210>>, + + Cipher = <<36,245,206,158,168,230,58,69,148,137,32,192,250,41,237,181,181,251, 192,2,175,135,177,171,57,30,111,117,159,149,15,28,88,158,28,81,28,115, 85,219,241,82,117,222,91,85,73,117,164,25,182,52,191,64,123,57,26,19, 211,27,253,31,194,219,231,104,247,240,172,130,119,21,225,154,101,247, 32,216,42,216,133,169,78,22,97,27,227,26,196,224,172,168,17,9,148,55, 203,91,252,40,61,226,236,221,215,160,78,63,13,181,68,57,196,241,185, 207, 116,129,152,237,60,139,247,153,27,146,161,246,222,98,185,222,152, 187,135, 236,86,34,7,110,91,230,173,34,160,242,202,222,121,127,181,140, 101,203,195, 190,88,250,86,147,127,87,72,126,171,16,71,47,110,248,88, 14,29,143,161,152, 129,236,148,22,152,186,208,119,70,8,174,193,203,100, 193,203,200,117,102,242, 134,142,96,125,135,200,217,190,76,117,50,70, 209,186,101,241,200,91,40,193,54, 90,195,38,47,59,197,38,234,86,223,16, 51,253,204,129,20,171,66,21,241,26,135,216, 196,114,110,91,15,53,40, 164,201,136,113,95,247,51,181,208,241,68,168,98,151,36, 155,72,24,57, 42,191,14,125,204,10,167,214,233,138,115,125,234,121,134,227,26,247, 77,200,117,110,117,111,168,156,206,67,159,149,189,173,150,193,91,199, 216,153,22, 189,137,185,89,160,13,131,132,58,109,28,110,246,252,251,14, 232,91,38,52,29,101,188,69,123,50,0,130,178,93,73,239,118,7,77,35,59, 253,10,159,45,86,142,37,78,232,48>>, + Text = <<48,130,1,85,2,1,0,48,13,6,9,42,134,72,134,247,13,1,1,1,5,0,4,130,1,63,48,130, 1,59,2,1,0,2,65,0,222,187,252,44,9,214,27,173,162,169,70,47,36,34,78,84,204, 107,60,192,117,95,21,206,49,142,245,126,121,223,23,2,107,106,133,204,161,36, 40,2,114,69,4,93,242,5,42,50,154,47,154,211,209,123,120,161,5,114,173,155,34, 191,52,59,2,3,1,0,1,2,64,45,144,169,106,220,236,71,39,67,82,123,192,35,21,61, 143,13,110,150,180,12,142,210,40,39,109,70,125,132,51,6,66,159,134,112,85, 155,243,118,221,65,133,127,99,151,194,252,141,149,224,229,62,214,45,228,32, 184,85,67,14,228,161,184,161,2,33,0,255,202,240,131,130,57,49,224,115,255,83, 79,6,165,212,21,179,212,20,188,97,74,69,68,163,223,247,237,39,24,23,235,2,33, 0,222,234,48,36,33,23,219,45,59,136,55,245,143,29,165,48,255,131,207,146,131, 104,13,163,54,131,236,78,88,54,16,241,2,33,0,230,2,99,129,173,176,166,131, 241,106,143,76,9,107,70,41,121,185,228,39,124,200,159,62,216,169,5,180,111, 169,255,159,2,33,0,151,193,70,212,209,210,179,219,175,83,165,4,255,81,103,76, 92,39,24,0,222,132,208,3,244,241,10,198,171,54,227,129,2,32,43,250,20,31,16, 189,168,116,225,1,125,132,94,130,118,124,28,56,232,39,69,218,244,33,240,200, 205,9,215,101,35,135,7,7,7,7,7,7,7>>, + + Text = crypto:rc2_cbc_decrypt(Key, IV, Cipher), + Cipher = crypto:rc2_cbc_encrypt(Key, IV, Text). + +%% +%% +des3_cbc(doc) -> + "Encrypt and decrypt according to CBC 3DES, and check the result."; +des3_cbc(suite) -> + []; +des3_cbc(Config) when is_list(Config) -> + ?line Key1 = hexstr2bin("0123456789abcdef"), + ?line Key2 = hexstr2bin("fedcba9876543210"), + ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain = "Now is the time for all ", + ?line Cipher = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain), + ?line m(Cipher, hexstr2bin("8a2667ee5577267cd9b1af2c5a0480" + "0bac1ae66970fb2b89")), + ?line m(list_to_binary(Plain), + crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher)), + ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], + ?line Cipher2 = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain2), + ?line m(Cipher2, hexstr2bin("eb33ec6ede2c8e90f6877e77b95d5" + "4c83cee22907f7f0041ca1b7abe202bfafe")), + ?line m(list_to_binary(Plain2), + crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher2)), + + ?line Key = hexstr2bin("0123456789abcdef"), + ?line DESCipher = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain), + ?line m(DESCipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c" + "0f683788499a7c05f6")), + ?line m(list_to_binary(Plain), + crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher)), + ?line DESCipher2 = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain2), + ?line m(DESCipher2, hexstr2bin("b9916b8ee4c3da64b4f44e3cbefb9" + "9484521388fa59ae67d58d2e77e86062733")), + ?line m(list_to_binary(Plain2), + crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher2)). + +%% +%% +des3_cfb(doc) -> + "Encrypt and decrypt according to CFB 3DES, and check the result."; +des3_cfb(suite) -> + []; +des3_cfb(Config) when is_list(Config) -> + ?line Key1 = hexstr2bin("0123456789abcdef"), + ?line Key2 = hexstr2bin("fedcba9876543210"), + ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain = "Now is the time for all ", + ?line Cipher = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain), + ?line m(Cipher, hexstr2bin("fc0ba7a20646ba53cc8bff263f0937" + "1deab42a00666db02c")), + ?line m(list_to_binary(Plain), + crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher)), + ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], + ?line Cipher2 = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain2), + ?line m(Cipher2, hexstr2bin("8582c59ac01897422632c0accb66c" + "e413f5efab838fce7e41e2ba67705bad5bc")), + ?line m(list_to_binary(Plain2), + crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher2)). %% %% @@ -1233,8 +1349,8 @@ rc4_test(doc) -> rc4_test(suite) -> []; rc4_test(Config) when is_list(Config) -> - CT1 = <<"hej p� dig">>, - R1 = <<71,112,14,44,140,33,212,144,155,47>>, + CT1 = <<"Yo baby yo">>, + R1 = <<118,122,68,110,157,166,141,212,139,39>>, K = "apaapa", R1 = crypto:rc4_encrypt(K, CT1), CT1 = crypto:rc4_encrypt(K, R1), @@ -1248,14 +1364,14 @@ rc4_stream_test(doc) -> rc4_stream_test(suite) -> []; rc4_stream_test(Config) when is_list(Config) -> - CT1 = <<"hej">>, - CT2 = <<" p� dig">>, + CT1 = <<"Yo ">>, + CT2 = <<"baby yo">>, K = "apaapa", State0 = crypto:rc4_set_key(K), {State1, R1} = crypto:rc4_encrypt_with_state(State0, CT1), {_State2, R2} = crypto:rc4_encrypt_with_state(State1, CT2), R = list_to_binary([R1, R2]), - <<71,112,14,44,140,33,212,144,155,47>> = R, + <<118,122,68,110,157,166,141,212,139,39>> = R, ok. blowfish_cfb64(doc) -> ["Test Blowfish encrypt/decrypt."]; diff --git a/lib/debugger/doc/src/debugger_chapter.xml b/lib/debugger/doc/src/debugger_chapter.xml index 1f5d4dd5ff..2d812b0236 100644 --- a/lib/debugger/doc/src/debugger_chapter.xml +++ b/lib/debugger/doc/src/debugger_chapter.xml @@ -254,19 +254,17 @@ c_break(Bindings) -> used, for example, if an error occurs:</p> <pre> 1> <input>catch a+1.</input> -{'EXIT',{badarith,[{erlang,'+',[a,1]}, - {erl_eval,do_apply,5}, - {erl_eval,expr,5}, - {shell,exprs,6}, - {shell,eval_exprs,6}, - {shell,eval_loop,3}]}}</pre> - - <p>In the case above, the stack trace shows that the function called - last was <c>erl_eval:eval_op/3</c>. See <em>Erlang Reference - Manual, Errors and Error handling</em>, for more information - about stack trace.</p> - - <p>Debugger emulates the stack trace by keeping track of recently +{'EXIT',{badarith,[{erlang,'+',[a,1],[]}, + {erl_eval,do_apply,5,[{file,"erl_eval.erl"},{line,562}]}, + {erl_eval,expr,5,[{file,"erl_eval.erl"},{line,359}]}, + {shell,exprs,7,[{file,"shell.erl"},{line,668}]}, + {shell,eval_exprs,7,[{file,"shell.erl"},{line,623}]}, + {shell,eval_loop,3,[{file,"shell.erl"},{line,608}]}]}}</pre> + + <p>See the <em>Erlang Reference Manual, Errors and Error handling</em>, + for more information about the stack trace.</p> + + <p>The Debugger emulates the stack trace by keeping track of recently called interpreted functions. (The real stack trace cannot be used, as it shows which functions of the Debugger have been called, rather than which interpreted functions).</p> @@ -276,17 +274,15 @@ c_break(Bindings) -> <seealso marker="#attach">the Attach Process window</seealso>. </p> - <p>By default, the Debugger saves information about all current + <p>By default, the Debugger only saves information about recursive function calls, that is, function calls that have not yet returned - a value (option 'Stack On, Tail').</p> - - <p>This means, however, that information is saved also for tail - recursive calls. For example, repeated calls to the <c>loop</c> - function of an Erlang process. This may consume unnecessary - amounts of memory for debugged processes with long lifetimes and - many tail recursive calls. It is therefore possible to set - the option 'Stack On, no tail', in which case information about - previous calls are discarded when a tail recursive call is made. + a value (option 'Stack On, No Tail').</p> + + <p>Sometimes, however, it can be useful to save all calls, even + tail-recursive calls. That can be done with the 'Stack On, Tail' + option. Note that this option will consume more memory and slow + down execution of interpreted functions when there are many + tail-recursive calls. </p> <p>It is also possible to turn off the Debugger stack trace diff --git a/lib/debugger/doc/src/int.xml b/lib/debugger/doc/src/int.xml index 8b55461a44..c9d815755d 100644 --- a/lib/debugger/doc/src/int.xml +++ b/lib/debugger/doc/src/int.xml @@ -284,12 +284,12 @@ spawn(Module, Name, [Pid | Args]) <list> <item><c>all</c> - save information about all current calls, that is, function calls that have not yet returned a value. - This is the default.</item> + </item> <item><c>no_tail</c> - save information about current calls, but discard previous information when a tail recursive call is made. This option consumes less memory and may be necessary to use for processes with long lifetimes and many - tail recursive calls.</item> + tail recursive calls. This is the default.</item> <item><c>false</c> - do not save any information about current calls.</item> </list> diff --git a/lib/debugger/doc/src/make.dep b/lib/debugger/doc/src/make.dep deleted file mode 100644 index c11fd3c21c..0000000000 --- a/lib/debugger/doc/src/make.dep +++ /dev/null @@ -1,29 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex debugger.tex debugger_chapter.tex \ - i.tex int.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: part.xml ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: images/attach.ps images/cond_break_dialog.ps \ - images/function_break_dialog.ps images/interpret.ps \ - images/line_break_dialog.ps images/monitor.ps \ - images/view.ps - diff --git a/lib/debugger/src/Makefile b/lib/debugger/src/Makefile index 8551fe887d..6dc7d0d783 100644 --- a/lib/debugger/src/Makefile +++ b/lib/debugger/src/Makefile @@ -44,6 +44,7 @@ MODULES= \ dbg_ieval \ dbg_iload \ dbg_iserver \ + dbg_istk \ dbg_ui_break \ dbg_ui_break_win \ dbg_ui_edit \ diff --git a/lib/debugger/src/dbg_debugged.erl b/lib/debugger/src/dbg_debugged.erl index 3732c40c73..18dcd92ff3 100644 --- a/lib/debugger/src/dbg_debugged.erl +++ b/lib/debugger/src/dbg_debugged.erl @@ -76,8 +76,8 @@ msg_loop(Meta, Mref, SaveStacktrace) -> msg_loop(Meta, Mref, SaveStacktrace); %% Meta needs something evaluated within context of real process - {sys, Meta, {command, Command, Stacktrace}} -> - Reply = handle_command(Command, Stacktrace), + {sys, Meta, {command,Command}} -> + Reply = handle_command(Command), Meta ! {sys, self(), Reply}, msg_loop(Meta, Mref, SaveStacktrace); @@ -93,11 +93,12 @@ msg_loop(Meta, Mref, SaveStacktrace) -> end end. -handle_command(Command, Stacktrace) -> - try reply(Command) +handle_command(Command) -> + try + reply(Command) catch Class:Reason -> - Stacktrace2 = stacktrace_f(erlang:get_stacktrace()), - {exception, {Class,Reason,Stacktrace2++Stacktrace}} + Stacktrace = stacktrace_f(erlang:get_stacktrace()), + {exception,{Class,Reason,Stacktrace}} end. reply({apply,M,F,As}) -> @@ -116,5 +117,5 @@ demonitor(Mref) -> %% Fix stacktrace - keep all above call to this module. %% stacktrace_f([]) -> []; -stacktrace_f([{?MODULE,_,_}|_]) -> []; +stacktrace_f([{?MODULE,_,_,_}|_]) -> []; stacktrace_f([F|S]) -> [F|stacktrace_f(S)]. diff --git a/lib/debugger/src/dbg_icmd.erl b/lib/debugger/src/dbg_icmd.erl index e9502eaa2b..b230efaa7a 100644 --- a/lib/debugger/src/dbg_icmd.erl +++ b/lib/debugger/src/dbg_icmd.erl @@ -273,7 +273,7 @@ handle_int_msg({old_code,Mod}, Status, Bs, erase([Mod|db]), put(cache, []); true -> - case dbg_ieval:in_use_p(Mod, M) of + case dbg_istk:in_use_p(Mod, M) of true -> %% A call to Mod is on the stack (or might be), %% so we must terminate. @@ -342,11 +342,11 @@ handle_user_msg({set,stack_trace,Flag}, _Status, _Bs, _Ieval) -> handle_user_msg({get,bindings,From,SP}, _Status, Bs, _Ieval) -> reply(From, bindings, bindings(Bs, SP)); handle_user_msg({get,stack_frame,From,{Dir,SP}}, _Status, _Bs,_Ieval) -> - reply(From, stack_frame, dbg_ieval:stack_frame(Dir, SP)); + reply(From, stack_frame, dbg_istk:stack_frame(Dir, SP)); handle_user_msg({get,messages,From,_}, _Status, _Bs, _Ieval) -> reply(From, messages, messages()); -handle_user_msg({get,backtrace,From,N}, _Status, _Bs, _Ieval) -> - reply(From, backtrace, dbg_ieval:backtrace(N)). +handle_user_msg({get,backtrace,From,N}, _Status, _Bs, Ieval) -> + reply(From, backtrace, dbg_istk:backtrace(N, Ieval)). set_stack_trace(true) -> set_stack_trace(all); @@ -366,11 +366,11 @@ reply(From, Tag, Reply) -> bindings(Bs, nostack) -> Bs; bindings(Bs, SP) -> - case dbg_ieval:stack_level() of + case dbg_istk:stack_level() of Le when SP > Le -> Bs; _ -> - dbg_ieval:bindings(SP) + dbg_istk:bindings(SP) end. messages() -> @@ -422,7 +422,7 @@ eval_nonrestricted({From, _Mod, Cmd, _SP}, Bs, eval_nonrestricted_1({match,_,{var,_,Var},Expr}, Bs, Ieval) -> {value,Res,Bs2} = - dbg_ieval:eval_expr(Expr, Bs, Ieval#ieval{last_call=false}), + dbg_ieval:eval_expr(Expr, Bs, Ieval#ieval{top=false}), Bs3 = case lists:keyfind(Var, 1, Bs) of {Var,_Value} -> lists:keyreplace(Var, 1, Bs2, {Var,Res}); @@ -437,7 +437,7 @@ eval_nonrestricted_1({var,_,Var}, Bs, _Ieval) -> {Res,Bs}; eval_nonrestricted_1(Expr, Bs, Ieval) -> {value,Res,Bs2} = - dbg_ieval:eval_expr(Expr, Bs, Ieval#ieval{last_call=false}), + dbg_ieval:eval_expr(Expr, Bs, Ieval#ieval{top=false}), {Res,Bs2}. mark_running(LineNo, Le) -> diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 306323f8ea..2e88c35741 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -20,8 +20,7 @@ -export([eval/3,exit_info/5]). -export([eval_expr/3]). --export([check_exit_msg/3,exception/4,in_use_p/2]). --export([stack_level/0, bindings/1, stack_frame/2, backtrace/1]). +-export([check_exit_msg/3,exception/4]). -include("dbg_ieval.hrl"). @@ -71,13 +70,12 @@ exit_info(Int, AttPid, OrigPid, Reason, ExitInfo) -> case ExitInfo of {{Mod,Line},Bs,S} -> - Stack = binary_to_term(S), - put(stack, Stack), - Le = stack_level(Stack), + dbg_istk:from_external(S), + Le = dbg_istk:stack_level(), dbg_icmd:tell_attached({exit_at, {Mod, Line}, Reason, Le}), exit_loop(OrigPid, Reason, Bs,#ieval{module=Mod,line=Line}); {} -> - put(stack, []), + dbg_istk:init(), dbg_icmd:tell_attached({exit_at, null, Reason, 1}), exit_loop(OrigPid, Reason, erl_eval:new_bindings(),#ieval{}) end. @@ -142,12 +140,12 @@ check_exit_msg({'DOWN',_,_,_,Reason}, Bs, undefined when Le =:= 1 -> % died outside interpreted code {}; undefined when Le > 1 -> - StackBin = term_to_binary(get(stack)), - {{Mod, Li}, Bs, StackBin}; + StackExternal = (dbg_istk:delayed_to_external())(), + {{Mod, Li}, Bs, StackExternal}; %% Debugged has terminated due to an exception - ExitInfo0 -> - ExitInfo0 + ExitInfo0 when is_function(ExitInfo0, 0) -> + ExitInfo0() end, dbg_iserver:cast(get(int), {set_exit_info,self(),ExitInfo}), @@ -170,30 +168,26 @@ check_exit_msg(_Msg, _Bs, _Ieval) -> %% and then raise the exception. %%-------------------------------------------------------------------- exception(Class, Reason, Bs, Ieval) -> - exception(Class, Reason, fix_stacktrace(1), Bs, Ieval). - -exception(Class, Reason, Stacktrace, Bs, #ieval{module=M, line=Line}) -> - ExitInfo = {{M,Line}, Bs, term_to_binary(get(stack))}, + exception(Class, Reason, Bs, Ieval, false). + +exception(Class, Reason, Bs, Ieval, false) -> + do_exception(Class, Reason, + dbg_istk:delayed_stacktrace(no_args, Ieval), + Bs, Ieval); +exception(Class, Reason, Bs, Ieval, true) -> + do_exception(Class, Reason, + dbg_istk:delayed_stacktrace(include_args, Ieval), + Bs, Ieval). + +do_exception(Class, Reason, Stacktrace, Bs, #ieval{module=M, line=Line}) -> + StackFun = dbg_istk:delayed_to_external(), + ExitInfo = fun() -> + {{M,Line},Bs,StackFun()} + end, put(exit_info, ExitInfo), put(stacktrace, Stacktrace), erlang:Class(Reason). -%%-------------------------------------------------------------------- -%% in_use_p(Mod, Cm) -> boolean() -%% Mod = Cm = atom() -%% Returns true if Mod is found on the stack, otherwise false. -%%-------------------------------------------------------------------- -in_use_p(Mod, Mod) -> true; -in_use_p(Mod, _Cm) -> - case get(trace_stack) of - false -> true; - _ -> % all | no_tail - lists:any(fun({_,{M,_,_,_}}) when M =:= Mod -> true; - (_) -> false - end, - get(stack)) - end. - %%==================================================================== %% Internal functions %%==================================================================== @@ -225,7 +219,7 @@ meta(Int, Debugged, M, F, As) -> put(cache, []), put(next_break, Status), % break | running (other values later) put(self, Debugged), % pid() interpreted process - put(stack, []), + dbg_istk:init(), put(stacktrace, []), put(trace_stack, dbg_iserver:call(Int, get_stack_trace)), put(trace, false), % bool() Trace on/off @@ -243,8 +237,7 @@ meta(Int, Debugged, M, F, As) -> debugged_cmd(Cmd, Bs, Ieval) -> Debugged = get(self), - Stacktrace = fix_stacktrace(2), - Debugged ! {sys, self(), {command,Cmd,Stacktrace}}, + Debugged ! {sys, self(), {command,Cmd}}, meta_loop(Debugged, Bs, Ieval). meta_loop(Debugged, Bs, #ieval{level=Le} = Ieval) -> @@ -257,12 +250,17 @@ meta_loop(Debugged, Bs, #ieval{level=Le} = Ieval) -> {value, Val, Bs}; {sys, Debugged, {value,Val,Bs2}} -> {value, Val, Bs2}; - {sys, Debugged, {exception,{Class,Reason,Stacktrace}}} -> + {sys, Debugged, {exception,{Class,Reason,Stk}}} -> case get(exit_info) of - %% Error occured outside interpreted code + %% Error occurred outside of interpreted code. undefined -> - exception(Class,Reason,Stacktrace,Bs,Ieval); + MakeStk0 = dbg_istk:delayed_stacktrace(), + MakeStk = fun(Depth0) -> + Depth = max(0, Depth0 - length(Stk)), + Stk ++ MakeStk0(Depth) + end, + do_exception(Class, Reason, MakeStk, Bs, Ieval); %% Error must have occured within a re-entry to %% interpreted code, simply raise the exception @@ -275,7 +273,7 @@ meta_loop(Debugged, Bs, #ieval{level=Le} = Ieval) -> %% Reset process dictionary %% This is really only necessary if the process left %% interpreted code at a call level > 1 - put(stack, []), + dbg_istk:init(), put(stacktrace, []), put(exit_info, undefined), @@ -313,177 +311,6 @@ exit_loop(OrigPid, Reason, Bs, Ieval) -> exit_loop(OrigPid, Reason, Bs, Ieval) end. -%%--Stack emulation--------------------------------------------------- - -%% We keep track of a call stack that is used for -%% 1) saving stack frames that can be inspected from an Attached -%% Process GUI (using dbg_icmd:get(Meta, stack_frame, {Dir, SP}) -%% 2) generate an approximation of regular stacktrace -- sent to -%% Debugged when it should raise an exception or evaluate a -%% function (since it might possible raise an exception) -%% -%% Stack = [Entry] -%% Entry = {Le, {MFA, Where, Bs}} -%% Le = int() % current call level -%% MFA = {M,F,Args} % called function (or fun) -%% | {Fun,Args} % -%% Where = {M,Li} % from where (module+line) function is called -%% Bs = bindings() % current variable bindings -%% -%% How to push depends on the "Stack Trace" option (value saved in -%% process dictionary item 'trace_stack'). -%% all - everything is pushed -%% no_tail - tail recursive push -%% false - nothing is pushed -%% Whenever a function returns, the corresponding call frame is popped. - -push(MFA, Bs, #ieval{level=Le,module=Cm,line=Li,last_call=Lc}) -> - Entry = {Le, {MFA, {Cm,Li}, Bs}}, - case get(trace_stack) of - false -> ignore; - no_tail when Lc -> - case get(stack) of - [] -> put(stack, [Entry]); - [_Entry|Entries] -> put(stack, [Entry|Entries]) - end; - _ -> % all | no_tail when Lc =:= false - put(stack, [Entry|get(stack)]) - end. - -pop() -> - case get(trace_stack) of - false -> ignore; - _ -> % all � no_tail - case get(stack) of - [_Entry|Entries] -> - put(stack, Entries); - [] -> - ignore - end - end. - -pop(Le) -> - case get(trace_stack) of - false -> ignore; - _ -> % all | no_tail - put(stack, pop(Le, get(stack))) - end. - -pop(Level, [{Le, _}|Stack]) when Level=<Le -> - pop(Level, Stack); -pop(_Level, Stack) -> - Stack. - - -%% stack_level() -> Le -%% stack_level(Stack) -> Le -%% Top call level -stack_level() -> - stack_level(get(stack)). - -stack_level([]) -> 1; -stack_level([{Le,_}|_]) -> Le. - -%% fix_stacktrace(Start) -> Stacktrace -%% Start = 1|2 -%% Stacktrace = [{M,F,Args|Arity} | {Fun,Args}] -%% Convert internal stack format to imitation of regular stacktrace. -%% Max three elements, no repeated (recursive) calls to the same -%% function and convert argument lists to arity for all but topmost -%% entry (and funs). -%% 'Start' indicates where at get(stack) to start. This somewhat ugly -%% solution is because fix_stacktrace has two uses: 1) to imitate -%% the stacktrace in the case of an exception in the interpreted code, -%% in which case the current call (top of the stack = first of the list) -%% should be included, and 2) to send a current stacktrace to Debugged -%% when evaluation passes into non-interpreted code, in which case -%% the current call should NOT be included (as it is Debugged which -%% will make the actual function call). -fix_stacktrace(Start) -> - case fix_stacktrace2(sublist(get(stack), Start, 3)) of - [] -> - []; - [H|T] -> - [H|args2arity(T)] - end. - -sublist([], _Start, _Length) -> - []; % workaround, lists:sublist([],2,3) fails -sublist(L, Start, Length) -> - lists:sublist(L, Start, Length). - -fix_stacktrace2([{_,{{M,F,As1},_,_}}, {_,{{M,F,As2},_,_}}|_]) - when length(As1) =:= length(As2) -> - [{M,F,As1}]; -fix_stacktrace2([{_,{{Fun,As1},_,_}}, {_,{{Fun,As2},_,_}}|_]) - when length(As1) =:= length(As2) -> - [{Fun,As1}]; -fix_stacktrace2([{_,{MFA,_,_}}|Entries]) -> - [MFA|fix_stacktrace2(Entries)]; -fix_stacktrace2([]) -> - []. - -args2arity([{M,F,As}|Entries]) when is_list(As) -> - [{M,F,length(As)}|args2arity(Entries)]; -args2arity([Entry|Entries]) -> - [Entry|args2arity(Entries)]; -args2arity([]) -> - []. - -%% bindings(SP) -> Bs -%% SP = Le % stack pointer -%% Return the bindings for the specified call level -bindings(SP) -> - bindings(SP, get(stack)). - -bindings(SP, [{SP,{_MFA,_Wh,Bs}}|_]) -> - Bs; -bindings(SP, [_Entry|Entries]) -> - bindings(SP, Entries); -bindings(_SP, []) -> - erl_eval:new_bindings(). - -%% stack_frame(Dir, SP) -> {Le, Where, Bs} | top | bottom -%% Dir = up | down -%% Where = {Cm, Li} -%% Cm = Module | undefined % module -%% Li = int() | -1 % line number -%% Bs = bindings() -%% Return stack frame info one step up/down from given stack pointer -%% up = to lower call levels -%% down = to higher call levels -stack_frame(up, SP) -> - stack_frame(SP, up, get(stack)); -stack_frame(down, SP) -> - stack_frame(SP, down, lists:reverse(get(stack))). - -stack_frame(SP, up, [{Le, {_MFA,Where,Bs}}|_]) when Le<SP -> - {Le, Where, Bs}; -stack_frame(SP, down, [{Le, {_MFA,Where,Bs}}|_]) when Le>SP -> - {Le, Where, Bs}; -stack_frame(SP, Dir, [{SP, _}|Stack]) -> - case Stack of - [{Le, {_MFA,Where,Bs}}|_] -> - {Le, Where, Bs}; - [] when Dir =:= up -> - top; - [] when Dir =:= down -> - bottom - end; -stack_frame(SP, Dir, [_Entry|Stack]) -> - stack_frame(SP, Dir, Stack). - -%% backtrace(HowMany) -> Backtrace -%% HowMany = all | int() -%% Backtrace = {Le, MFA} -%% Return all/the last N called functions, in reversed call order -backtrace(HowMany) -> - Stack = case HowMany of - all -> get(stack); - N -> lists:sublist(get(stack), N) - end, - [{Le, MFA} || {Le,{MFA,_Wh,_Bs}} <- Stack]. - %%--Trace function---------------------------------------------------- %%-------------------------------------------------------------------- @@ -558,7 +385,7 @@ format_args1([]) -> %% Mimic catch behaviour catch_value(error, Reason) -> - {'EXIT',{Reason,get(stacktrace)}}; + {'EXIT',{Reason,get_stacktrace()}}; catch_value(exit, Reason) -> {'EXIT',Reason}; catch_value(throw, Reason) -> @@ -570,11 +397,13 @@ catch_value(throw, Reason) -> %% Top level function of meta evaluator. %% Return message to be replied to the target process. %%-------------------------------------------------------------------- -eval_mfa(Debugged, M, F, As, Ieval) -> +eval_mfa(Debugged, M, F, As, #ieval{level=Le}=Ieval0) -> Int = get(int), Bs = erl_eval:new_bindings(), - try eval_function(M,F,As,Bs,extern,Ieval#ieval{last_call=true}) of + Ieval = Ieval0#ieval{level=Le+1,top=true}, + try do_eval_function(M, F, As, Bs, extern, Ieval) of {value, Val, _Bs} -> + trace(return, {Le,Val}), {ready, Val} catch exit:{Debugged, Reason} -> @@ -582,76 +411,68 @@ eval_mfa(Debugged, M, F, As, Ieval) -> exit:{Int, Reason} -> exit(Reason); Class:Reason -> - {exception, {Class, Reason, get(stacktrace)}} + {exception, {Class, Reason, get_stacktrace()}} end. -eval_function(Mod, Fun, As0, Bs0, _Called, Ieval) when is_function(Fun); - Mod =:= ?MODULE, - Fun =:= eval_fun -> - #ieval{level=Le, line=Li, last_call=Lc} = Ieval, +eval_function(Mod, Name, As, Bs, Called, Ieval0, Lc) -> + Tail = Lc andalso get(trace_stack) =:= no_tail, + case Tail of + false -> + Ieval = dbg_istk:push(Bs, Ieval0, Lc), + {value,Val,_} = do_eval_function(Mod, Name, As, Bs, Called, Ieval), + dbg_istk:pop(), + trace(return, {Ieval#ieval.level,Val}), + {value,Val,Bs}; + true -> + do_eval_function(Mod, Name, As, Bs, Called, Ieval0) + end. + +do_eval_function(Mod, Fun, As0, Bs0, _, Ieval0) when is_function(Fun); + Mod =:= ?MODULE, + Fun =:= eval_fun -> + #ieval{level=Le,line=Li,top=Top} = Ieval0, case lambda(Fun, As0) of - {Cs,Module,Name,As,Bs} -> - push({Module,Name,As}, Bs0, Ieval), + {[{clause,Fc,_,_,_}|_]=Cs,Module,Name,As,Bs} -> + Ieval = Ieval0#ieval{module=Module,function=Name, + arguments=As0,line=Fc}, trace(call_fun, {Le,Li,Name,As}), - {value, Val, _Bs} = - fnk_clauses(Cs, Module, Name, As, Bs, - Ieval#ieval{level=Le+1}), - pop(), - trace(return, {Le,Val}), - {value, Val, Bs0}; + fnk_clauses(Cs, As, Bs, Ieval); - not_interpreted when Lc -> % We are leaving interpreted code + not_interpreted when Top -> % We are leaving interpreted code trace(call_fun, {Le,Li,Fun,As0}), {value, {dbg_apply,erlang,apply,[Fun,As0]}, Bs0}; not_interpreted -> - push({Fun,As0}, Bs0, Ieval), trace(call_fun, {Le,Li,Fun,As0}), - {value, Val, _Bs} = - debugged_cmd({apply,erlang,apply,[Fun,As0]},Bs0, - Ieval#ieval{level=Le+1}), - pop(), - trace(return, {Le,Val}), - {value, Val, Bs0}; + debugged_cmd({apply,erlang,apply,[Fun,As0]}, Bs0, Ieval0); {error,Reason} -> %% It's ok not to push anything in this case, the error %% reason contains information about the culprit %% ({badarity,{{Mod,Name},As}}) - exception(error, Reason, Bs0, Ieval) + exception(error, Reason, Bs0, Ieval0) end; %% Common Test adaptation -eval_function(ct_line, line, As, Bs, extern, #ieval{level=Le}=Ieval) -> +do_eval_function(ct_line, line, As, Bs, extern, #ieval{level=Le}=Ieval) -> debugged_cmd({apply,ct_line,line,As}, Bs, Ieval#ieval{level=Le+1}), {value, ignore, Bs}; -eval_function(Mod, Name, As0, Bs0, Called, Ieval) -> - #ieval{level=Le, line=Li, last_call=Lc} = Ieval, - - push({Mod,Name,As0}, Bs0, Ieval), +do_eval_function(Mod, Name, As0, Bs0, Called, Ieval0) -> + #ieval{level=Le,line=Li,top=Top} = Ieval0, trace(call, {Called, {Le,Li,Mod,Name,As0}}), - + Ieval = Ieval0#ieval{module=Mod,function=Name,arguments=As0}, case get_function(Mod, Name, As0, Called) of - Cs when is_list(Cs) -> - {value, Val, _Bs} = - fnk_clauses(Cs, Mod, Name, As0, erl_eval:new_bindings(), - Ieval#ieval{level=Le+1}), - pop(), - trace(return, {Le,Val}), - {value, Val, Bs0}; + [{clause,FcLine,_,_,_}|_]=Cs -> + fnk_clauses(Cs, As0, erl_eval:new_bindings(), + Ieval#ieval{line=FcLine}); - not_interpreted when Lc -> % We are leaving interpreted code + not_interpreted when Top -> % We are leaving interpreted code {value, {dbg_apply,Mod,Name,As0}, Bs0}; not_interpreted -> - {value, Val, _Bs} = - debugged_cmd({apply,Mod,Name,As0}, Bs0, - Ieval#ieval{level=Le+1}), - pop(), - trace(return, {Le,Val}), - {value, Val, Bs0}; + debugged_cmd({apply,Mod,Name,As0}, Bs0, Ieval); undef -> - exception(error, undef, Bs0, Ieval) + exception(error, undef, Bs0, Ieval, true) end. lambda(eval_fun, [Cs,As,Bs,{Mod,Name}=F]) -> @@ -752,23 +573,21 @@ cached(Key) -> %% Try to find a matching function clause %% #ieval.level is set, the other fields must be set in this function -fnk_clauses([{clause,Line,Pars,Gs,Body}|Cs], M, F, As, Bs0, Ieval) -> +fnk_clauses([{clause,Line,Pars,Gs,Body}|Cs], As, Bs0, Ieval) -> case head_match(Pars, As, [], Bs0) of {match,Bs1} -> Bs = add_bindings(Bs1, Bs0), case guard(Gs, Bs) of true -> - seq(Body, Bs, - Ieval#ieval{line=Line, - module=M,function=F,arguments=As}); + seq(Body, Bs, Ieval#ieval{line=Line}); false -> - fnk_clauses(Cs, M, F, As, Bs0, Ieval) + fnk_clauses(Cs, As, Bs0, Ieval) end; nomatch -> - fnk_clauses(Cs, M, F, As, Bs0, Ieval) + fnk_clauses(Cs, As, Bs0, Ieval) end; -fnk_clauses([], _M, _F, _As, Bs, Ieval) -> - exception(error, function_clause, Bs, Ieval). +fnk_clauses([], _As, Bs, Ieval) -> + exception(error, function_clause, Bs, Ieval, true). seq([E], Bs0, Ieval) -> case dbg_icmd:cmd(E, Bs0, Ieval) of @@ -782,7 +601,7 @@ seq([E|Es], Bs0, Ieval) -> {skip,Bs} -> seq(Es, Bs, Ieval); Bs1 -> - {value,_,Bs} = expr(E, Bs1, Ieval#ieval{last_call=false}), + {value,_,Bs} = expr(E, Bs1, Ieval#ieval{top=false}), seq(Es, Bs, Ieval) end; seq([], Bs, _) -> @@ -804,10 +623,9 @@ expr({value,Val}, Bs, _Ieval) -> % Special case straight values %% List expr({cons,Line,H0,T0}, Bs0, Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - Ieval1 = Ieval#ieval{last_call=false}, - {value,H,Bs1} = expr(H0,Bs0,Ieval1), - {value,T,Bs2} = expr(T0,Bs0,Ieval1), + Ieval = Ieval0#ieval{line=Line,top=false}, + {value,H,Bs1} = expr(H0, Bs0, Ieval), + {value,T,Bs2} = expr(T0, Bs0, Ieval), {value,[H|T],merge_bindings(Bs2, Bs1, Ieval)}; %% Tuple @@ -821,12 +639,12 @@ expr({block,Line,Es},Bs,Ieval) -> %% Catch statement expr({'catch',Line,Expr}, Bs0, Ieval) -> - try expr(Expr, Bs0, Ieval#ieval{line=Line, last_call=false}) + try expr(Expr, Bs0, Ieval#ieval{line=Line, top=false}) catch Class:Reason -> %% Exception caught, reset exit info put(exit_info, undefined), - pop(Ieval#ieval.level), + dbg_istk:pop(Ieval#ieval.level), Value = catch_value(Class, Reason), trace(return, {Ieval#ieval.level,Value}), {value, Value, Bs0} @@ -835,7 +653,7 @@ expr({'catch',Line,Expr}, Bs0, Ieval) -> %% Try-catch statement expr({'try',Line,Es,CaseCs,CatchCs,[]}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - try seq(Es, Bs0, Ieval#ieval{last_call=false}) of + try seq(Es, Bs0, Ieval#ieval{top=false}) of {value,Val,Bs} = Value -> case CaseCs of [] -> Value; @@ -848,7 +666,7 @@ expr({'try',Line,Es,CaseCs,CatchCs,[]}, Bs0, Ieval0) -> end; expr({'try',Line,Es,CaseCs,CatchCs,As}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - try seq(Es, Bs0, Ieval#ieval{last_call=false}) of + try seq(Es, Bs0, Ieval#ieval{top=false}) of {value,Val,Bs} = Value -> case CaseCs of [] -> Value; @@ -859,13 +677,13 @@ expr({'try',Line,Es,CaseCs,CatchCs,As}, Bs0, Ieval0) -> Class:Reason when CatchCs =/= [] -> catch_clauses({Class,Reason,[]}, CatchCs, Bs0, Ieval) after - seq(As, Bs0, Ieval#ieval{last_call=false}) + seq(As, Bs0, Ieval#ieval{top=false}) end; %% Case statement expr({'case',Line,E,Cs}, Bs0, Ieval) -> {value,Val,Bs} = - expr(E, Bs0, Ieval#ieval{line=Line, last_call=false}), + expr(E, Bs0, Ieval#ieval{line=Line, top=false}), case_clauses(Val, Cs, Bs, case_clause, Ieval#ieval{line=Line}); %% If statement @@ -874,20 +692,20 @@ expr({'if',Line,Cs}, Bs, Ieval) -> %% Andalso/orelse expr({'andalso',Line,E1,E2}, Bs, Ieval) -> - case expr(E1, Bs, Ieval#ieval{line=Line, last_call=false}) of + case expr(E1, Bs, Ieval#ieval{line=Line, top=false}) of {value,false,_}=Res -> Res; {value,true,_} -> - expr(E2, Bs, Ieval#ieval{line=Line, last_call=false}); + expr(E2, Bs, Ieval#ieval{line=Line, top=false}); {value,Val,Bs} -> exception(error, {badarg,Val}, Bs, Ieval) end; expr({'orelse',Line,E1,E2}, Bs, Ieval) -> - case expr(E1, Bs, Ieval#ieval{line=Line, last_call=false}) of + case expr(E1, Bs, Ieval#ieval{line=Line, top=false}) of {value,true,_}=Res -> Res; {value,false,_} -> - expr(E2, Bs, Ieval#ieval{line=Line, last_call=false}); + expr(E2, Bs, Ieval#ieval{line=Line, top=false}); {value,Val,_} -> exception(error, {badarg,Val}, Bs, Ieval) end; @@ -895,7 +713,7 @@ expr({'orelse',Line,E1,E2}, Bs, Ieval) -> %% Matching expression expr({match,Line,Lhs,Rhs0}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - {value,Rhs,Bs1} = expr(Rhs0, Bs0, Ieval#ieval{last_call=false}), + {value,Rhs,Bs1} = expr(Rhs0, Bs0, Ieval#ieval{top=false}), case match(Lhs, Rhs, Bs1) of {match,Bs} -> {value,Rhs,Bs}; @@ -950,22 +768,37 @@ expr({make_fun,Line,Name,Cs}, Bs, #ieval{module=Module}=Ieval) -> end, {value,Fun,Bs}; +%% Construct an external fun. +expr({make_ext_fun,Line,MFA0}, Bs0, Ieval0) -> + {[M,F,A],Bs} = eval_list(MFA0, Bs0, Ieval0), + try erlang:make_fun(M, F, A) of + Value -> + {value,Value,Bs} + catch + error:badarg -> + Ieval1 = Ieval0#ieval{line=Line}, + Ieval2 = dbg_istk:push(Bs0, Ieval1, false), + Ieval = Ieval2#ieval{module=erlang,function=make_fun, + arguments=[M,F,A],line=-1}, + exception(error, badarg, Bs, Ieval, true) + end; + %% Common test adaptation -expr({call_remote,0,ct_line,line,As0}, Bs0, Ieval0) -> +expr({call_remote,0,ct_line,line,As0,Lc}, Bs0, Ieval0) -> {As,_Bs} = eval_list(As0, Bs0, Ieval0), - eval_function(ct_line, line, As, Bs0, extern, Ieval0); + eval_function(ct_line, line, As, Bs0, extern, Ieval0, Lc); %% Local function call -expr({local_call,Line,F,As0}, Bs0, #ieval{module=M} = Ieval0) -> +expr({local_call,Line,F,As0,Lc}, Bs0, #ieval{module=M} = Ieval0) -> Ieval = Ieval0#ieval{line=Line}, {As,Bs} = eval_list(As0, Bs0, Ieval), - eval_function(M, F, As, Bs, local, Ieval); + eval_function(M, F, As, Bs, local, Ieval, Lc); %% Remote function call -expr({call_remote,Line,M,F,As0}, Bs0, Ieval0) -> +expr({call_remote,Line,M,F,As0,Lc}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, {As,Bs} = eval_list(As0, Bs0, Ieval), - eval_function(M, F, As, Bs, extern, Ieval); + eval_function(M, F, As, Bs, extern, Ieval, Lc); %% Emulated semantics of some BIFs expr({dbg,Line,self,[]}, Bs, #ieval{level=Le}) -> @@ -975,9 +808,28 @@ expr({dbg,Line,self,[]}, Bs, #ieval{level=Le}) -> {value,Self,Bs}; expr({dbg,Line,get_stacktrace,[]}, Bs, #ieval{level=Le}) -> trace(bif, {Le,Line,erlang,get_stacktrace,[]}), - Stacktrace = get(stacktrace), + Stacktrace = get_stacktrace(), trace(return, {Le,Stacktrace}), {value,Stacktrace,Bs}; +expr({dbg,Line,raise,As0}, Bs0, #ieval{level=Le}=Ieval0) -> + %% Since erlang:get_stacktrace/0 is emulated, we will + %% need to emulate erlang:raise/3 too so that we can + %% capture the stacktrace. + Ieval = Ieval0#ieval{line=Line}, + {[Class,Reason,Stk0]=As,Bs} = eval_list(As0, Bs0, Ieval), + trace(bif, {Le,Line,erlang,raise,As}), + try + %% Evaluate raise/3 for error checking and + %% truncating of the stacktrace to the correct depth. + Error = erlang:raise(Class, Reason, Stk0), + trace(return, {Le,Error}), + {value,Error,Bs} + catch + _:_ -> + Stk = erlang:get_stacktrace(), %Possibly truncated. + StkFun = fun(_) -> Stk end, + do_exception(Class, Reason, StkFun, Bs, Ieval) + end; expr({dbg,Line,throw,As0}, Bs0, #ieval{level=Le}=Ieval0) -> Ieval = Ieval0#ieval{line=Line}, {[Term],Bs} = eval_list(As0, Bs0, Ieval), @@ -988,11 +840,6 @@ expr({dbg,Line,error,As0}, Bs0, #ieval{level=Le}=Ieval0) -> {[Term],Bs} = eval_list(As0, Bs0, Ieval), trace(bif, {Le,Line,erlang,error,[Term]}), exception(error, Term, Bs, Ieval); -expr({dbg,Line,fault,As0}, Bs0, #ieval{level=Le}=Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {[Term],Bs} = eval_list(As0, Bs0, Ieval), - trace(bif, {Le,Line,erlang,fault,[Term]}), - exception(fault, Term, Bs, Ieval); expr({dbg,Line,exit,As0}, Bs0, #ieval{level=Le}=Ieval0) -> Ieval = Ieval0#ieval{line=Line}, {[Term],Bs} = eval_list(As0, Bs0, Ieval), @@ -1001,36 +848,26 @@ expr({dbg,Line,exit,As0}, Bs0, #ieval{level=Le}=Ieval0) -> %% Call to "safe" BIF, ie a BIF that can be executed in Meta process expr({safe_bif,Line,M,F,As0}, Bs0, #ieval{level=Le}=Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {As,Bs} = eval_list(As0, Bs0, Ieval), + Ieval1 = Ieval0#ieval{line=Line}, + {As,Bs} = eval_list(As0, Bs0, Ieval1), trace(bif, {Le,Line,M,F,As}), - push({M,F,As}, Bs0, Ieval), + Ieval2 = dbg_istk:push(Bs0, Ieval1, false), + Ieval = Ieval2#ieval{module=M,function=F,arguments=As,line=-1}, {_,Value,_} = Res = safe_bif(M, F, As, Bs, Ieval), trace(return, {Le,Value}), - pop(), + dbg_istk:pop(), Res; %% Call to a BIF that must be evaluated in the correct process expr({bif,Line,M,F,As0}, Bs0, #ieval{level=Le}=Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {As,Bs} = eval_list(As0, Bs0, Ieval), + Ieval1 = Ieval0#ieval{line=Line}, + {As,Bs} = eval_list(As0, Bs0, Ieval1), trace(bif, {Le,Line,M,F,As}), - push({M,F,As}, Bs0, Ieval), - {_,Value,_} = - Res = debugged_cmd({apply,M,F,As}, Bs, Ieval#ieval{level=Le+1}), + Ieval2 = dbg_istk:push(Bs0, Ieval1, false), + Ieval = Ieval2#ieval{module=M,function=F,arguments=As,line=-1}, + {_,Value,_} = Res = debugged_cmd({apply,M,F,As}, Bs, Ieval), trace(return, {Le,Value}), - pop(), - Res; - -%% Call to a BIF that spawns a new process -expr({spawn_bif,Line,M,F,As0}, Bs0, #ieval{level=Le}=Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {As,Bs} = eval_list(As0, Bs0, Ieval), - trace(bif, {Le,Line,M,F,As}), - push({M,F,As}, Bs0, Ieval), - Res = debugged_cmd({apply,M,F,As}, Bs,Ieval#ieval{level=Le+1}), - trace(return, {Le,Res}), - pop(), + dbg_istk:pop(), Res; %% Call to an operation @@ -1046,7 +883,7 @@ expr({op,Line,Op,As0}, Bs0, Ieval0) -> end; %% apply/2 (fun) -expr({apply_fun,Line,Fun0,As0}, Bs0, #ieval{level=Le}=Ieval0) -> +expr({apply_fun,Line,Fun0,As0,Lc}, Bs0, #ieval{level=Le}=Ieval0) -> Ieval = Ieval0#ieval{line=Line}, FunValue = case expr(Fun0, Bs0, Ieval) of {value,{dbg_apply,Mx,Fx,Asx},Bsx} -> @@ -1058,31 +895,20 @@ expr({apply_fun,Line,Fun0,As0}, Bs0, #ieval{level=Le}=Ieval0) -> case FunValue of {value,Fun,Bs1} when is_function(Fun) -> {As,Bs} = eval_list(As0, Bs1, Ieval), - eval_function(undefined, Fun, As, Bs, extern, Ieval); + eval_function(undefined, Fun, As, Bs, extern, Ieval, Lc); {value,{M,F},Bs1} when is_atom(M), is_atom(F) -> {As,Bs} = eval_list(As0, Bs1, Ieval), - eval_function(M, F, As, Bs, extern, Ieval); + eval_function(M, F, As, Bs, extern, Ieval, Lc); {value,BadFun,Bs1} -> exception(error, {badfun,BadFun}, Bs1, Ieval) end; %% apply/3 -expr({apply,Line,As0}, Bs0, Ieval0) -> +expr({apply,Line,As0,Lc}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, {[M,F,As],Bs} = eval_list(As0, Bs0, Ieval), - eval_function(M, F, As, Bs, extern, Ieval); + eval_function(M, F, As, Bs, extern, Ieval, Lc); -%% Mod:module_info/0,1 -expr({module_info_0,_,Mod}, Bs, _Ieval) -> - {value,[{compile,module_info(Mod,compile)}, - {attributes,module_info(Mod,attributes)}, - {imports,module_info(Mod,imports)}, - {exports,module_info(Mod,exports)}],Bs}; -expr({module_info_1,Line,Mod,[As0]}, Bs0, Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {value,What,Bs} = expr(As0, Bs0, Ieval), - {value,module_info(Mod, What),Bs}; - %% Receive statement expr({'receive',Line,Cs}, Bs0, #ieval{level=Le}=Ieval) -> trace(receivex, {Le,false}), @@ -1091,7 +917,7 @@ expr({'receive',Line,Cs}, Bs0, #ieval{level=Le}=Ieval) -> %% Receive..after statement expr({'receive',Line,Cs,To,ToExprs}, Bs0, #ieval{level=Le}=Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - {value,ToVal,ToBs} = expr(To, Bs0, Ieval#ieval{last_call=false}), + {value,ToVal,ToBs} = expr(To, Bs0, Ieval#ieval{top=false}), trace(receivex, {Le,true}), check_timeoutvalue(ToVal, ToBs, To, Ieval), {Stamp,_} = statistics(wall_clock), @@ -1101,7 +927,7 @@ expr({'receive',Line,Cs,To,ToExprs}, Bs0, #ieval{level=Le}=Ieval0) -> %% Send (!) expr({send,Line,To0,Msg0}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - Ieval1 = Ieval#ieval{last_call=false}, + Ieval1 = Ieval#ieval{top=false}, {value,To,Bs1} = expr(To0, Bs0, Ieval1), {value,Msg,Bs2} = expr(Msg0, Bs0, Ieval1), Bs = merge_bindings(Bs2, Bs1, Ieval), @@ -1110,10 +936,15 @@ expr({send,Line,To0,Msg0}, Bs0, Ieval0) -> %% Binary expr({bin,Line,Fs}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - eval_bits:expr_grp(Fs, Bs0, - fun (E, B) -> expr(E, B, Ieval) end, - [], - false); + try + eval_bits:expr_grp(Fs, Bs0, + fun (E, B) -> expr(E, B, Ieval) end, + [], + false) + catch + Class:Reason -> + exception(Class, Reason, Bs0, Ieval) + end; %% List comprehension expr({lc,_Line,E,Qs}, Bs, Ieval) -> @@ -1138,12 +969,12 @@ eval_lc(E, Qs, Bs, Ieval) -> eval_lc1(E, [{generate,Line,P,L0}|Qs], Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{last_call=false}), + {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{top=false}), CompFun = fun(NewBs) -> eval_lc1(E, Qs, NewBs, Ieval) end, eval_generate(L1, P, Bs1, CompFun, Ieval); eval_lc1(E, [{b_generate,Line,P,L0}|Qs], Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - {value,Bin,_} = expr(L0, Bs0, Ieval#ieval{last_call=false}), + {value,Bin,_} = expr(L0, Bs0, Ieval#ieval{top=false}), CompFun = fun(NewBs) -> eval_lc1(E, Qs, NewBs, Ieval) end, eval_b_generate(Bin, P, Bs0, CompFun, Ieval); eval_lc1(E, [{guard,Q}|Qs], Bs0, Ieval) -> @@ -1152,13 +983,13 @@ eval_lc1(E, [{guard,Q}|Qs], Bs0, Ieval) -> false -> [] end; eval_lc1(E, [Q|Qs], Bs0, Ieval) -> - case expr(Q, Bs0, Ieval#ieval{last_call=false}) of + case expr(Q, Bs0, Ieval#ieval{top=false}) of {value,true,Bs} -> eval_lc1(E, Qs, Bs, Ieval); {value,false,_Bs} -> []; {value,V,Bs} -> exception(error, {bad_filter,V}, Bs, Ieval) end; eval_lc1(E, [], Bs, Ieval) -> - {value,V,_} = expr(E, Bs, Ieval#ieval{last_call=false}), + {value,V,_} = expr(E, Bs, Ieval#ieval{top=false}), [V]. %% eval_bc(Expr,[Qualifier],Bindings,IevalState) -> @@ -1171,12 +1002,12 @@ eval_bc(E, Qs, Bs, Ieval) -> eval_bc1(E, [{generate,Line,P,L0}|Qs], Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{last_call=false}), + {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{top=false}), CompFun = fun(NewBs) -> eval_bc1(E, Qs, NewBs, Ieval) end, eval_generate(L1, P, Bs1, CompFun, Ieval); eval_bc1(E, [{b_generate,Line,P,L0}|Qs], Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - {value,Bin,_} = expr(L0, Bs0, Ieval#ieval{last_call=false}), + {value,Bin,_} = expr(L0, Bs0, Ieval#ieval{top=false}), CompFun = fun(NewBs) -> eval_bc1(E, Qs, NewBs, Ieval) end, eval_b_generate(Bin, P, Bs0, CompFun, Ieval); eval_bc1(E, [{guard,Q}|Qs], Bs0, Ieval) -> @@ -1185,13 +1016,13 @@ eval_bc1(E, [{guard,Q}|Qs], Bs0, Ieval) -> false -> [] end; eval_bc1(E, [Q|Qs], Bs0, Ieval) -> - case expr(Q, Bs0, Ieval#ieval{last_call=false}) of + case expr(Q, Bs0, Ieval#ieval{top=false}) of {value,true,Bs} -> eval_bc1(E, Qs, Bs, Ieval); {value,false,_Bs} -> []; {value,V,Bs} -> exception(error, {bad_filter,V}, Bs, Ieval) end; eval_bc1(E, [], Bs, Ieval) -> - {value,V,_} = expr(E, Bs, Ieval#ieval{last_call=false}), + {value,V,_} = expr(E, Bs, Ieval#ieval{top=false}), [V]. eval_generate([V|Rest], P, Bs0, CompFun, Ieval) -> @@ -1208,7 +1039,7 @@ eval_generate(Term, _P, Bs, _CompFun, Ieval) -> exception(error, {bad_generator,Term}, Bs, Ieval). eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, CompFun, Ieval) -> - Mfun = fun(L, R, Bs) -> match1(L, R, Bs, Bs0) end, + Mfun = match_fun(Bs0), Efun = fun(Exp, Bs) -> expr(Exp, Bs, #ieval{}) end, case eval_bits:bin_gen(P, Bin, erl_eval:new_bindings(), Bs0, Mfun, Efun) of {match,Rest,Bs1} -> @@ -1222,24 +1053,13 @@ eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, CompFun, Ieval) -> eval_b_generate(Term, _P, Bs, _CompFun, Ieval) -> exception(error, {bad_generator,Term}, Bs, Ieval). -module_info(Mod, module) -> Mod; -module_info(_Mod, compile) -> []; -module_info(Mod, attributes) -> - {ok, Attr} = dbg_iserver:call(get(int), {lookup, Mod, attributes}), - Attr; -module_info(_Mod, imports) -> []; -module_info(Mod, exports) -> - {ok, Exp} = dbg_iserver:call(get(int), {lookup, Mod, exports}), - Exp; -module_info(_Mod, functions) -> []. - safe_bif(M, F, As, Bs, Ieval) -> try apply(M, F, As) of Value -> {value,Value,Bs} catch Class:Reason -> - exception(Class, Reason, Bs, Ieval) + exception(Class, Reason, Bs, Ieval, true) end. eval_send(To, Msg, Bs, Ieval) -> @@ -1408,12 +1228,12 @@ flush_traces(Debugged) -> %% eval_list(ExpressionList, Bindings, Ieval) %% Evaluate a list of expressions "in parallel" at the same level. eval_list(Es, Bs, Ieval) -> - eval_list(Es, [], Bs, Bs, Ieval). + eval_list_1(Es, [], Bs, Bs, Ieval#ieval{top=false}). -eval_list([E|Es], Vs, BsOrig, Bs0, Ieval) -> - {value,V,Bs1} = expr(E, BsOrig, Ieval#ieval{last_call=false}), - eval_list(Es, [V|Vs], BsOrig, merge_bindings(Bs1,Bs0,Ieval), Ieval); -eval_list([], Vs, _, Bs, _Ieval) -> +eval_list_1([E|Es], Vs, BsOrig, Bs0, Ieval) -> + {value,V,Bs1} = expr(E, BsOrig, Ieval), + eval_list_1(Es, [V|Vs], BsOrig, merge_bindings(Bs1, Bs0, Ieval), Ieval); +eval_list_1([], Vs, _, Bs, _Ieval) -> {lists:reverse(Vs,[]),Bs}. %% if_clauses(Clauses, Bindings, Ieval) @@ -1453,7 +1273,7 @@ catch_clauses(Exception, [{clause,_,[P],G,B}|CatchCs], Bs0, Ieval) -> true -> %% Exception caught, reset exit info put(exit_info, undefined), - pop(Ieval#ieval.level), + dbg_istk:pop(Ieval#ieval.level), seq(B, Bs, Ieval); false -> catch_clauses(Exception, CatchCs, Bs0, Ieval) @@ -1588,11 +1408,9 @@ match1({cons,_,H,T}, [H1|T1], Bs0, BBs) -> match1({tuple,_,Elts}, Tuple, Bs, BBs) when length(Elts) =:= tuple_size(Tuple) -> match_tuple(Elts, Tuple, 1, Bs, BBs); -match1({bin,_,Fs}, B, Bs0, BBs0) when is_bitstring(B) -> - Bs1 = lists:sort(Bs0), %Kludge. - BBs = lists:sort(BBs0), - try eval_bits:match_bits(Fs, B, Bs1, BBs, - fun(L, R, Bs) -> match1(L, R, Bs, BBs) end, +match1({bin,_,Fs}, B, Bs0, BBs) when is_bitstring(B) -> + try eval_bits:match_bits(Fs, B, Bs0, BBs, + match_fun(BBs), fun(E, Bs) -> expr(E, Bs, #ieval{}) end, false) catch @@ -1601,6 +1419,12 @@ match1({bin,_,Fs}, B, Bs0, BBs0) when is_bitstring(B) -> match1(_,_,_,_) -> throw(nomatch). +match_fun(BBs) -> + fun(match, {L,R,Bs}) -> match1(L, R, Bs, BBs); + (binding, {Name,Bs}) -> binding(Name, Bs); + (add_binding, {Name,Val,Bs}) -> add_binding(Name, Val, Bs) + end. + match_tuple([E|Es], Tuple, I, Bs0, BBs) -> {match,Bs} = match1(E, element(I, Tuple), Bs0, BBs), match_tuple(Es, Tuple, I+1, Bs, BBs); @@ -1731,3 +1555,19 @@ add_binding(N,Val,[B1|Bs]) -> [B1|add_binding(N,Val,Bs)]; add_binding(N,Val,[]) -> [{N,Val}]. + +%% get_stacktrace() -> Stacktrace +%% Return the latest stacktrace for the process. +get_stacktrace() -> + case get(stacktrace) of + MakeStk when is_function(MakeStk, 1) -> + %% The stacktrace has not been constructed before. + %% Construct it and remember the result. + Depth = erlang:system_flag(backtrace_depth, 8), + erlang:system_flag(backtrace_depth, Depth), + Stk = MakeStk(Depth), + put(stacktrace, Stk), + Stk; + Stk when is_list(Stk) -> + Stk + end. diff --git a/lib/debugger/src/dbg_ieval.hrl b/lib/debugger/src/dbg_ieval.hrl index a344748f48..ea6189ad02 100644 --- a/lib/debugger/src/dbg_ieval.hrl +++ b/lib/debugger/src/dbg_ieval.hrl @@ -21,6 +21,8 @@ module, % MFA which called the currently function, % interpreted function arguments, % - last_call = false % True if current expression is - }). % the VERY last to be evaluated - % (ie at all, not only in a clause) + + %% True if the current expression is at the top level + %% (i.e. the next call will leave interpreted code). + top = false + }). diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index 2ae0c333da..3c95ef8068 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -62,22 +62,23 @@ load_mod1(Mod, File, Binary, Db) -> store_module(Mod, File, Binary, Db) -> {interpreter_module, Exp, Abst, Src, MD5} = binary_to_term(Binary), Forms = case abstr(Abst) of - {abstract_v1,Forms0} -> Forms0; - {abstract_v2,Forms0} -> Forms0; + {abstract_v1,_} -> + exit({Mod,too_old_beam_file}); + {abstract_v2,_} -> + exit({Mod,too_old_beam_file}); {raw_abstract_v1,Code0} -> Code = interpret_file_attribute(Code0), {_,_,Forms0,_} = sys_pre_expand:module(Code, []), Forms0 end, dbg_idb:insert(Db, mod_file, File), - dbg_idb:insert(Db, exports, Exp), dbg_idb:insert(Db, defs, []), put(vcount, 0), put(fun_count, 0), put(funs, []), put(mod_md5, MD5), - Attr = store_forms(Forms, Mod, Db, Exp, []), + store_forms(Forms, Mod, Db, Exp), erase(mod_md5), erase(current_function), %% store_funs(Db, Mod), @@ -85,11 +86,10 @@ store_module(Mod, File, Binary, Db) -> erase(funs), erase(fun_count), - dbg_idb:insert(Db, attributes, Attr), NewBinary = store_mod_line_no(Mod, Db, binary_to_list(Src)), dbg_idb:insert(Db, mod_bin, NewBinary), - dbg_idb:insert(Db, mod_raw, <<Src/binary,0:8>>), %% Add eos - dbg_idb:insert(Db, module, Mod). + dbg_idb:insert(Db, mod_raw, <<Src/binary,0:8>>). %% Add eos + %% Adjust line numbers using the file/2 attribute. %% Also take the absolute value of line numbers. %% This simple fix will make the marker point at the correct line @@ -111,27 +111,19 @@ abstr(Term) -> Term. % store_funs_1(Fs, Db, Mod); % store_funs_1([], _, _) -> ok. -store_forms([{function,_,module_info,0,_}|Fs], Mod, Db, Exp, Attr) -> - Cs = [{clause,0,[],[], [{module_info_0,0,Mod}]}], - dbg_idb:insert(Db, {Mod,module_info,0,true}, Cs), - store_forms(Fs, Mod, Db, Exp, Attr); -store_forms([{function,_,module_info,1,_}|Fs], Mod, Db, Exp, Attr) -> - Cs = [{clause,0,[{var,0,'What'}],[], [{module_info_1,0,Mod,[{var,0,'What'}]}]}], - dbg_idb:insert(Db, {Mod,module_info,1,true}, Cs), - store_forms(Fs, Mod, Db, Exp, Attr); -store_forms([{function,_,Name,Arity,Cs0}|Fs], Mod, Db, Exp, Attr) -> +store_forms([{function,_,Name,Arity,Cs0}|Fs], Mod, Db, Exp) -> FA = {Name,Arity}, put(current_function, FA), Cs = clauses(Cs0), Exported = lists:member(FA, Exp), dbg_idb:insert(Db, {Mod,Name,Arity,Exported}, Cs), - store_forms(Fs, Mod, Db, Exp, Attr); -store_forms([{attribute,_,Name,Val}|Fs], Mod, Db, Exp, Attr) -> - store_forms(Fs, Mod, Db, Exp, [{Name,Val}|Attr]); -store_forms([F|_], _Mod, _Db, _Exp, _Attr) -> + store_forms(Fs, Mod, Db, Exp); +store_forms([{attribute,_,_Name,_Val}|Fs], Mod, Db, Exp) -> + store_forms(Fs, Mod, Db, Exp); +store_forms([F|_], _Mod, _Db, _Exp) -> exit({unknown_form,F}); -store_forms([], _, _, _, Attr) -> - lists:reverse(Attr). +store_forms([], _, _, _) -> + ok. store_mod_line_no(Mod, Db, Contents) -> store_mod_line_no(Mod, Db, Contents, 1, 0, []). @@ -164,14 +156,14 @@ get_nl([],Pos,Head) -> {lists:reverse(Head),[],Pos}. %%% to interpret. clauses([C0|Cs]) -> - C1 = clause(C0), + C1 = clause(C0, true), [C1|clauses(Cs)]; clauses([]) -> []. -clause({clause,Line,H0,G0,B0}) -> +clause({clause,Line,H0,G0,B0}, Lc) -> H1 = head(H0), G1 = guard(G0), - B1 = exprs(B0), + B1 = exprs(B0, Lc), {clause,Line,H1,G1,B1}. head(Ps) -> patterns(Ps). @@ -219,7 +211,7 @@ pattern({bin,Line,Grp}) -> {bin,Line,Grp1}; pattern({bin_element,Line,Expr,Size,Type}) -> Expr1 = pattern(Expr), - Size1 = expr(Size), + Size1 = expr(Size, false), {bin_element,Line,Expr1,Size1,Type}. %% These patterns are processed "in parallel" for purposes of variable @@ -235,8 +227,6 @@ guard([G0|Gs]) -> [G1|guard(Gs)]; guard([]) -> []. -and_guard([{atom,_,true}|Gs]) -> - and_guard(Gs); and_guard([G0|Gs]) -> G1 = guard_test(G0), [G1|and_guard(Gs)]; @@ -244,12 +234,7 @@ and_guard([]) -> []. guard_test({call,Line,{remote,_,{atom,_,erlang},{atom,_,F}},As0}) -> As = gexpr_list(As0), - case map_guard_bif(F, length(As0)) of - {ok,Name} -> - {safe_bif,Line,erlang,Name,As}; - error -> - {safe_bif,Line,erlang,F,As} - end; + {safe_bif,Line,erlang,F,As}; guard_test({op,Line,Op,L0}) -> true = erl_internal:arith_op(Op, 1) orelse %Assertion. erl_internal:bool_op(Op, 1), @@ -266,25 +251,18 @@ guard_test({op,Line,Op,L0,R0}) -> L1 = gexpr(L0), R1 = gexpr(R0), %They see the same variables {safe_bif,Line,erlang,Op,[L1,R1]}; -guard_test({integer,_,_}=I) -> I; -guard_test({char,_,_}=C) -> C; -guard_test({float,_,_}=F) -> F; -guard_test({atom,_,_}=A) -> A; -guard_test({nil,_}=N) -> N; -guard_test({var,_,_}=V) ->V. % Boolean var - -map_guard_bif(integer, 1) -> {ok,is_integer}; -map_guard_bif(float, 1) -> {ok,is_float}; -map_guard_bif(number, 1) -> {ok,is_number}; -map_guard_bif(atom, 1) -> {ok,is_atom}; -map_guard_bif(list, 1) -> {ok,is_list}; -map_guard_bif(tuple, 1) -> {ok,is_tuple}; -map_guard_bif(pid, 1) -> {ok,is_pid}; -map_guard_bif(reference, 1) -> {ok,is_reference}; -map_guard_bif(port, 1) -> {ok,is_port}; -map_guard_bif(binary, 1) -> {ok,is_binary}; -map_guard_bif(function, 1) -> {ok,is_function}; -map_guard_bif(_, _) -> error. +guard_test({var,_,_}=V) ->V; % Boolean var +guard_test({atom,Line,true}) -> {value,Line,true}; +%% All other constants at this level means false. +guard_test({atom,Line,_}) -> {value,Line,false}; +guard_test({integer,Line,_}) -> {value,Line,false}; +guard_test({char,Line,_}) -> {value,Line,false}; +guard_test({float,Line,_}) -> {value,Line,false}; +guard_test({string,Line,_}) -> {value,Line,false}; +guard_test({nil,Line}) -> {value,Line,false}; +guard_test({cons,Line,_,_}) -> {value,Line,false}; +guard_test({tuple,Line,_}) -> {value,Line,false}; +guard_test({bin,Line,_}) -> {value,Line,false}. gexpr({var,Line,V}) -> {var,Line,V}; gexpr({integer,Line,I}) -> {value,Line,I}; @@ -341,186 +319,187 @@ gexpr_list([]) -> []. %% These expressions are processed "sequentially" for purposes of variable %% definition etc. -exprs([E0|Es]) -> - E1 = expr(E0), - [E1|exprs(Es)]; -exprs([]) -> []. - -expr({var,Line,V}) -> {var,Line,V}; -expr({integer,Line,I}) -> {value,Line,I}; -expr({char,Line,I}) -> {value,Line,I}; -expr({float,Line,F}) -> {value,Line,F}; -expr({atom,Line,A}) -> {value,Line,A}; -expr({string,Line,S}) -> {value,Line,S}; -expr({nil,Line}) -> {value,Line,[]}; -expr({cons,Line,H0,T0}) -> - case {expr(H0),expr(T0)} of +exprs([E], Lc) -> + [expr(E, Lc)]; +exprs([E0|Es], Lc) -> + E1 = expr(E0, false), + [E1|exprs(Es, Lc)]; +exprs([], _Lc) -> []. + +expr({var,Line,V}, _Lc) -> {var,Line,V}; +expr({integer,Line,I}, _Lc) -> {value,Line,I}; +expr({char,Line,I}, _Lc) -> {value,Line,I}; +expr({float,Line,F}, _Lc) -> {value,Line,F}; +expr({atom,Line,A}, _Lc) -> {value,Line,A}; +expr({string,Line,S}, _Lc) -> {value,Line,S}; +expr({nil,Line}, _Lc) -> {value,Line,[]}; +expr({cons,Line,H0,T0}, _Lc) -> + case {expr(H0, false),expr(T0, false)} of {{value,Line,H1},{value,Line,T1}} -> {value,Line,[H1|T1]}; {H1,T1} -> {cons,Line,H1,T1} end; -expr({tuple,Line,Es0}) -> +expr({tuple,Line,Es0}, _Lc) -> Es1 = expr_list(Es0), {tuple,Line,Es1}; -expr({block,Line,Es0}) -> +expr({block,Line,Es0}, Lc) -> %% Unfold block into a sequence. - Es1 = exprs(Es0), + Es1 = exprs(Es0, Lc), {block,Line,Es1}; -expr({'if',Line,Cs0}) -> - Cs1 = icr_clauses(Cs0), +expr({'if',Line,Cs0}, Lc) -> + Cs1 = icr_clauses(Cs0, Lc), {'if',Line,Cs1}; -expr({'case',Line,E0,Cs0}) -> - E1 = expr(E0), - Cs1 = icr_clauses(Cs0), +expr({'case',Line,E0,Cs0}, Lc) -> + E1 = expr(E0, false), + Cs1 = icr_clauses(Cs0, Lc), {'case',Line,E1,Cs1}; -expr({'receive',Line,Cs0}) -> - Cs1 = icr_clauses(Cs0), +expr({'receive',Line,Cs0}, Lc) -> + Cs1 = icr_clauses(Cs0, Lc), {'receive',Line,Cs1}; -expr({'receive',Line,Cs0,To0,ToEs0}) -> - To1 = expr(To0), - ToEs1 = exprs(ToEs0), - Cs1 = icr_clauses(Cs0), +expr({'receive',Line,Cs0,To0,ToEs0}, Lc) -> + To1 = expr(To0, false), + ToEs1 = exprs(ToEs0, Lc), + Cs1 = icr_clauses(Cs0, Lc), {'receive',Line,Cs1,To1,ToEs1}; -expr({'fun',Line,{clauses,Cs0},{_,_,Name}}) when is_atom(Name) -> +expr({'fun',Line,{clauses,Cs0},{_,_,Name}}, _Lc) when is_atom(Name) -> %% New R10B-2 format (abstract_v2). Cs = fun_clauses(Cs0), {make_fun,Line,Name,Cs}; -expr({'fun',Line,{clauses,Cs0},{_,_,_,_,Name}}) when is_atom(Name) -> - %% New R8 format (abstract_v2). - Cs = fun_clauses(Cs0), - {make_fun,Line,Name,Cs}; -expr({'fun',Line,{function,F,A},{_Index,_OldUniq,Name}}) -> +expr({'fun',Line,{function,F,A},{_Index,_OldUniq,Name}}, _Lc) -> %% New R8 format (abstract_v2). As = new_vars(A, Line), - Cs = [{clause,Line,As,[],[{local_call,Line,F,As}]}], + Cs = [{clause,Line,As,[],[{local_call,Line,F,As,true}]}], {make_fun,Line,Name,Cs}; -expr({'fun',_,{clauses,_},{_OldUniq,_Hvss,_Free}}) -> - %% Old format (abstract_v1). - exit({?MODULE,old_funs}); -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,self}},[]}) -> +expr({'fun',Line,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Lc) + when 0 =< A, A =< 255 -> + %% New format in R15 for fun M:F/A (literal values). + {value,Line,erlang:make_fun(M, F, A)}; +expr({'fun',Line,{function,M,F,A}}, _Lc) -> + %% New format in R15 for fun M:F/A (one or more variables). + MFA = expr_list([M,F,A]), + {make_ext_fun,Line,MFA}; +expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,self}},[]}, _Lc) -> {dbg,Line,self,[]}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,get_stacktrace}},[]}) -> +expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,get_stacktrace}},[]}, _Lc) -> {dbg,Line,get_stacktrace,[]}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,throw}},[_]=As}) -> +expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,throw}},[_]=As}, _Lc) -> {dbg,Line,throw,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,error}},[_]=As}) -> +expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,error}},[_]=As}, _Lc) -> {dbg,Line,error,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,fault}},[_]=As}) -> - {dbg,Line,fault,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,exit}},[_]=As}) -> +expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,exit}},[_]=As}, _Lc) -> {dbg,Line,exit,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,apply}},[_,_,_]=As0}) -> +expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,raise}},[_,_,_]=As}, _Lc) -> + {dbg,Line,raise,expr_list(As)}; +expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,apply}},[_,_,_]=As0}, Lc) -> As = expr_list(As0), - {apply,Line,As}; -expr({call,Line,{remote,_,{atom,_,Mod},{atom,_,Func}},As0}) -> + {apply,Line,As,Lc}; +expr({call,Line,{remote,_,{atom,_,Mod},{atom,_,Func}},As0}, Lc) -> As = expr_list(As0), case erlang:is_builtin(Mod, Func, length(As)) of false -> - {call_remote,Line,Mod,Func,As}; + {call_remote,Line,Mod,Func,As,Lc}; true -> - case bif_type(Mod, Func) of + case bif_type(Mod, Func, length(As0)) of safe -> {safe_bif,Line,Mod,Func,As}; - spawn -> {spawn_bif,Line,Mod,Func,As}; unsafe ->{bif,Line,Mod,Func,As} end end; -expr({call,Line,{remote,_,Mod0,Func0},As0}) -> +expr({call,Line,{remote,_,Mod0,Func0},As0}, Lc) -> %% New R8 format (abstract_v2). - Mod = expr(Mod0), - Func = expr(Func0), + Mod = expr(Mod0, false), + Func = expr(Func0, false), As = consify(expr_list(As0)), - {apply,Line,[Mod,Func,As]}; -expr({call,Line,{atom,_,Func},As0}) -> + {apply,Line,[Mod,Func,As],Lc}; +expr({call,Line,{atom,_,Func},As0}, Lc) -> As = expr_list(As0), - {local_call,Line,Func,As}; -expr({call,Line,Fun0,As0}) -> - Fun = expr(Fun0), + {local_call,Line,Func,As,Lc}; +expr({call,Line,Fun0,As0}, Lc) -> + Fun = expr(Fun0, false), As = expr_list(As0), - {apply_fun,Line,Fun,As}; -expr({'catch',Line,E0}) -> + {apply_fun,Line,Fun,As,Lc}; +expr({'catch',Line,E0}, _Lc) -> %% No new variables added. - E1 = expr(E0), + E1 = expr(E0, false), {'catch',Line,E1}; -expr({'try',Line,Es0,CaseCs0,CatchCs0,As0}) -> +expr({'try',Line,Es0,CaseCs0,CatchCs0,As0}, Lc) -> %% No new variables added. Es = expr_list(Es0), - CaseCs = icr_clauses(CaseCs0), - CatchCs = icr_clauses(CatchCs0), + CaseCs = icr_clauses(CaseCs0, Lc), + CatchCs = icr_clauses(CatchCs0, Lc), As = expr_list(As0), {'try',Line,Es,CaseCs,CatchCs,As}; -expr({'query', Line, E0}) -> - E = expr(E0), - {'query', Line, E}; -expr({lc,Line,E0,Gs0}) -> %R8. +expr({lc,Line,E0,Gs0}, _Lc) -> %R8. Gs = lists:map(fun ({generate,L,P0,Qs}) -> - {generate,L,expr(P0),expr(Qs)}; + {generate,L,expr(P0, false),expr(Qs, false)}; ({b_generate,L,P0,Qs}) -> %R12. - {b_generate,L,expr(P0),expr(Qs)}; + {b_generate,L,expr(P0, false),expr(Qs, false)}; (Expr) -> - case is_guard_test(Expr) of - true -> {guard,[[guard_test(Expr)]]}; - false -> expr(Expr) + case is_guard(Expr) of + true -> {guard,guard([[Expr]])}; + false -> expr(Expr, false) end end, Gs0), - {lc,Line,expr(E0),Gs}; -expr({bc,Line,E0,Gs0}) -> %R12. + {lc,Line,expr(E0, false),Gs}; +expr({bc,Line,E0,Gs0}, _Lc) -> %R12. Gs = lists:map(fun ({generate,L,P0,Qs}) -> - {generate,L,expr(P0),expr(Qs)}; + {generate,L,expr(P0, false),expr(Qs, false)}; ({b_generate,L,P0,Qs}) -> %R12. - {b_generate,L,expr(P0),expr(Qs)}; + {b_generate,L,expr(P0, false),expr(Qs, false)}; (Expr) -> - case is_guard_test(Expr) of - true -> {guard,[[guard_test(Expr)]]}; - false -> expr(Expr) + case is_guard(Expr) of + true -> {guard,guard([[Expr]])}; + false -> expr(Expr, false) end end, Gs0), - {bc,Line,expr(E0),Gs}; -expr({match,Line,P0,E0}) -> - E1 = expr(E0), + {bc,Line,expr(E0, false),Gs}; +expr({match,Line,P0,E0}, _Lc) -> + E1 = expr(E0, false), P1 = pattern(P0), {match,Line,P1,E1}; -expr({op,Line,Op,A0}) -> - A1 = expr(A0), +expr({op,Line,Op,A0}, _Lc) -> + A1 = expr(A0, false), {op,Line,Op,[A1]}; -expr({op,Line,'++',L0,R0}) -> - L1 = expr(L0), - R1 = expr(R0), %They see the same variables +expr({op,Line,'++',L0,R0}, _Lc) -> + L1 = expr(L0, false), + R1 = expr(R0, false), %They see the same variables {op,Line,append,[L1,R1]}; -expr({op,Line,'--',L0,R0}) -> - L1 = expr(L0), - R1 = expr(R0), %They see the same variables +expr({op,Line,'--',L0,R0}, _Lc) -> + L1 = expr(L0, false), + R1 = expr(R0, false), %They see the same variables {op,Line,subtract,[L1,R1]}; -expr({op,Line,'!',L0,R0}) -> - L1 = expr(L0), - R1 = expr(R0), %They see the same variables +expr({op,Line,'!',L0,R0}, _Lc) -> + L1 = expr(L0, false), + R1 = expr(R0, false), %They see the same variables {send,Line,L1,R1}; -expr({op,Line,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' -> - L1 = expr(L0), - R1 = expr(R0), %They see the same variables +expr({op,Line,Op,L0,R0}, _Lc) when Op =:= 'andalso'; Op =:= 'orelse' -> + L1 = expr(L0, false), + R1 = expr(R0, false), %They see the same variables {Op,Line,L1,R1}; -expr({op,Line,Op,L0,R0}) -> - L1 = expr(L0), - R1 = expr(R0), %They see the same variables +expr({op,Line,Op,L0,R0}, _Lc) -> + L1 = expr(L0, false), + R1 = expr(R0, false), %They see the same variables {op,Line,Op,[L1,R1]}; -expr({bin,Line,Grp}) -> +expr({bin,Line,Grp}, _Lc) -> Grp1 = expr_list(Grp), {bin,Line,Grp1}; -expr({bin_element,Line,Expr,Size,Type}) -> - Expr1 = expr(Expr), - Size1 = expr(Size), +expr({bin_element,Line,Expr,Size,Type}, _Lc) -> + Expr1 = expr(Expr, false), + Size1 = expr(Size, false), {bin_element,Line,Expr1,Size1,Type}; -expr(Other) -> +expr(Other, _Lc) -> exit({?MODULE,{unknown_expr,Other}}). -%% is_guard_test(Expression) -> true | false. -%% Test if a general expression is a guard test. Cannot use erl_lint -%% here as sys_pre_expand has transformed source. +%% is_guard(Expression) -> true | false. +%% Test if a general expression is a guard test or guard BIF. +%% Cannot use erl_lint here as sys_pre_expand has transformed source. -is_guard_test({op,_,Op,L,R}) -> +is_guard({op,_,Op,L,R}) -> erl_internal:comp_op(Op, 2) andalso is_gexpr_list([L,R]); -is_guard_test({call,_,{remote,_,{atom,_,erlang},{atom,_,Test}},As}) -> - erl_internal:type_test(Test, length(As)) andalso is_gexpr_list(As); -is_guard_test({atom,_,true}) -> true; -is_guard_test(_) -> false. +is_guard({call,_,{remote,_,{atom,_,erlang},{atom,_,Test}},As}) -> + Arity = length(As), + (erl_internal:guard_bif(Test, Arity) orelse + erl_internal:old_type_test(Test, Arity)) andalso is_gexpr_list(As); +is_guard({atom,_,true}) -> true; +is_guard(_) -> false. is_gexpr({var,_,_}) -> true; is_gexpr({atom,_,_}) -> true; @@ -555,17 +534,17 @@ consify([]) -> {value,0,[]}. %% definition etc. expr_list([E0|Es]) -> - E1 = expr(E0), + E1 = expr(E0, false), [E1|expr_list(Es)]; expr_list([]) -> []. -icr_clauses([C0|Cs]) -> - C1 = clause(C0), - [C1|icr_clauses(Cs)]; -icr_clauses([]) -> []. +icr_clauses([C0|Cs], Lc) -> + C1 = clause(C0, Lc), + [C1|icr_clauses(Cs, Lc)]; +icr_clauses([], _) -> []. fun_clauses([{clause,L,H,G,B}|Cs]) -> - [{clause,L,head(H),guard(G),exprs(B)}|fun_clauses(Cs)]; + [{clause,L,head(H),guard(G),exprs(B, true)}|fun_clauses(Cs)]; fun_clauses([]) -> []. %% new_var_name() -> VarName. @@ -585,24 +564,21 @@ new_vars(N, L, Vs) when N > 0 -> new_vars(N-1, L, [V|Vs]); new_vars(0, _, Vs) -> Vs. -bif_type(erlang, Name) -> bif_type(Name); -bif_type(_, _) -> unsafe. +bif_type(erlang, Name, Arity) -> + case erl_internal:guard_bif(Name, Arity) of + true -> + %% Guard BIFs are safe (except for self/0, but it is + %% handled with a special instruction anyway). + safe; + false -> + bif_type(Name) + end; +bif_type(_, _, _) -> unsafe. bif_type(register) -> safe; bif_type(unregister) -> safe; bif_type(whereis) -> safe; bif_type(registered) -> safe; -bif_type(abs) -> safe; -bif_type(float) -> safe; -bif_type(trunc) -> safe; -bif_type(round) -> safe; -bif_type(math) -> safe; -bif_type(node) -> safe; -bif_type(length) -> safe; -bif_type(hd) -> safe; -bif_type(tl) -> safe; -bif_type(size) -> safe; -bif_type(element) -> safe; bif_type(setelement) -> safe; bif_type(atom_to_list) -> safe; bif_type(list_to_atom) -> safe; @@ -627,22 +603,14 @@ bif_type(list_to_pid) -> safe; bif_type(module_loaded) -> safe; bif_type(binary_to_term) -> safe; bif_type(term_to_binary) -> safe; -bif_type(alive) -> safe; -bif_type(notalive) -> safe; bif_type(nodes) -> safe; bif_type(is_alive) -> safe; bif_type(disconnect_node) -> safe; bif_type(binary_to_list) -> safe; bif_type(list_to_binary) -> safe; bif_type(split_binary) -> safe; -bif_type(concat_binary) -> safe; -bif_type(term_to_atom) -> safe; bif_type(hash) -> safe; bif_type(pre_loaded) -> safe; -bif_type(info) -> safe; bif_type(set_cookie) -> safe; bif_type(get_cookie) -> safe; -bif_type(spawn) -> spawn; -bif_type(spawn_link) -> spawn; -bif_type(spawn_opt) -> spawn; bif_type(_) -> unsafe. diff --git a/lib/debugger/src/dbg_iserver.erl b/lib/debugger/src/dbg_iserver.erl index 212bc2b8ab..1bb73a43b9 100644 --- a/lib/debugger/src/dbg_iserver.erl +++ b/lib/debugger/src/dbg_iserver.erl @@ -97,13 +97,10 @@ ensure_started() -> %% %% Key Value %% --- ----- -%% attributes Attr -%% exports Exp %% defs [] %% mod_bin Binary %% mod_raw Raw Binary %% mod_file File -%% module Mod %% {Mod,Name,Arity,Exported} Cs %% {'fun',Mod,Index,Uniq} {Name,Arity,Cs} %% Line {Pos,PosNL} @@ -117,7 +114,7 @@ init([]) -> process_flag(trap_exit, true), global:register_name(?MODULE, self()), Db = ets:new(?MODULE, [ordered_set, protected]), - {ok, #state{db=Db, auto=false, stack=all}}. + {ok, #state{db=Db, auto=false, stack=no_tail}}. %% Attaching to a process handle_call({attached, AttPid, Pid}, _From, State) -> diff --git a/lib/debugger/src/dbg_istk.erl b/lib/debugger/src/dbg_istk.erl new file mode 100644 index 0000000000..c6922a80e4 --- /dev/null +++ b/lib/debugger/src/dbg_istk.erl @@ -0,0 +1,245 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% +%% +-module(dbg_istk). +-export([init/0,delayed_to_external/0,from_external/1, + push/3,pop/0,pop/1,stack_level/0, + delayed_stacktrace/0,delayed_stacktrace/2, + bindings/1,stack_frame/2,backtrace/2, + in_use_p/2]). + +-include("dbg_ieval.hrl"). + +-define(STACK, ?MODULE). + +-record(e, + {level, %Level + mfa, %{Mod,Func,Args|Arity}|{Fun,Args} + line, %Line called from + bindings, + lc %Last call (true|false) + }). + +init() -> + init([]). + +delayed_to_external() -> + Stack = get(?STACK), + fun() -> {stack,term_to_binary(Stack)} end. + +from_external({stack,Stk}) -> + put(?STACK, binary_to_term(Stk)). + +init(Stack) -> + put(?STACK, Stack). + +%% We keep track of a call stack that is used for +%% 1) saving stack frames that can be inspected from an Attached +%% Process GUI (using dbg_icmd:get(Meta, stack_frame, {Dir, SP}) +%% 2) generate an approximation of regular stacktrace -- sent to +%% Debugged when it should raise an exception or evaluate a +%% function (since it might possible raise an exception) +%% +%% How to push depends on the "Stack Trace" option (value saved in +%% process dictionary item 'trace_stack'). +%% all - everything is pushed +%% no_tail - tail recursive push +%% false - nothing is pushed +%% Whenever a function returns, the corresponding call frame is popped. + +push(Bs, #ieval{level=Le,module=Mod,function=Name, + arguments=As,line=Li}=Ieval, Lc) -> + Entry = #e{level=Le,mfa={Mod,Name,As},line=Li,bindings=Bs,lc=Lc}, + case get(trace_stack) of + false -> + Ieval#ieval{level=Le+1}; + no_tail when Lc -> + Ieval; + _ -> % all | no_tail when Lc =:= false + put(?STACK, [Entry|get(?STACK)]), + Ieval#ieval{level=Le+1} + end. + +pop() -> + case get(trace_stack) of + false -> ignore; + _ -> % all ¦ no_tail + case get(?STACK) of + [_Entry|Entries] -> + put(?STACK, Entries); + [] -> + ignore + end + end. + +pop(Le) -> + case get(trace_stack) of + false -> ignore; + _ -> % all | no_tail + put(?STACK, pop(Le, get(?STACK))) + end. + +pop(Level, [#e{level=Le}|Stack]) when Level =< Le -> + pop(Level, Stack); +pop(_Level, Stack) -> + Stack. + +%% stack_level() -> Le +%% stack_level(Stack) -> Le +%% Top call level +stack_level() -> + stack_level(get(?STACK)). + +stack_level([]) -> 1; +stack_level([#e{level=Le}|_]) -> Le. + +%% delayed_stacktrace() -> CreateStacktraceFun +%% delayed_stacktrace(ArgFlag, #ieval{}) -> CreateStacktraceFun +%% ArgFlag = no_args | include_args +%% CreateStacktraceFun = fun(NumberOfEntries) +%% +%% Return a fun that can convert the internal stack format to +%% an imitation of the regular stacktrace. + +delayed_stacktrace() -> + Stack0 = get(?STACK), + fun(NumEntries) -> + Stack = stacktrace(NumEntries, Stack0, []), + [finalize(ArityOnly) || {ArityOnly,_} <- Stack] + end. + +delayed_stacktrace(include_args, Ieval) -> + #ieval{module=Mod,function=Name,arguments=As,line=Li} = Ieval, + Stack0 = [#e{mfa={Mod,Name,As},line=Li}|get(?STACK)], + fun(NumEntries) -> + case stacktrace(NumEntries, Stack0, []) of + [] -> + []; + [{_,WithArgs}|Stack] -> + [finalize(WithArgs) | + [finalize(ArityOnly) || {ArityOnly,_} <- Stack]] + end + end; +delayed_stacktrace(no_args, Ieval) -> + #ieval{module=Mod,function=Name,arguments=As,line=Li} = Ieval, + Stack0 = [#e{mfa={Mod,Name,As},line=Li}|get(?STACK)], + fun(NumEntries) -> + Stack = stacktrace(NumEntries, Stack0, []), + [finalize(ArityOnly) || {ArityOnly,_} <- Stack] + end. + +stacktrace(N, [#e{lc=true}|T], Acc) -> + stacktrace(N, T, Acc); +stacktrace(N, [E|T], []) -> + stacktrace(N-1, T, [normalize(E)]); +stacktrace(N, [E|T], [{P,_}|_]=Acc) when N > 0 -> + case normalize(E) of + {P,_} -> + stacktrace(N, T, Acc); + New -> + stacktrace(N-1, T, [New|Acc]) + end; +stacktrace(_, _, Acc) -> + lists:reverse(Acc). + +normalize(#e{mfa={M,Fun,As},line=Li}) when is_function(Fun) -> + Loc = {M,Li}, + {{Fun,length(As),Loc},{Fun,As,Loc}}; +normalize(#e{mfa={M,F,As},line=Li}) -> + Loc = {M,Li}, + {{M,F,length(As),Loc},{M,F,As,Loc}}. + +finalize({M,F,A,Loc}) -> {M,F,A,line(Loc)}; +finalize({Fun,A,Loc}) -> {Fun,A,line(Loc)}. + +line({Mod,Line}) when Line > 0 -> + [{file,atom_to_list(Mod)++".erl"},{line,Line}]; +line(_) -> []. + +%% bindings(SP) -> Bs +%% SP = Le % stack pointer +%% Return the bindings for the specified call level +bindings(SP) -> + bindings(SP, get(?STACK)). + +bindings(SP, [#e{level=SP,bindings=Bs}|_]) -> + Bs; +bindings(SP, [_Entry|Entries]) -> + bindings(SP, Entries); +bindings(_SP, []) -> + erl_eval:new_bindings(). + +%% stack_frame(Dir, SP) -> {Le, Where, Bs} | top | bottom +%% Dir = up | down +%% Where = {Cm, Li} +%% Cm = Module | undefined % module +%% Li = int() | -1 % line number +%% Bs = bindings() +%% Return stack frame info one step up/down from given stack pointer +%% up = to lower call levels +%% down = to higher call levels +stack_frame(up, SP) -> + stack_frame(SP, up, get(?STACK)); +stack_frame(down, SP) -> + stack_frame(SP, down, lists:reverse(get(?STACK))). + +stack_frame(SP, up, [#e{level=Le,mfa={Cm,_,_},line=Li,bindings=Bs}|_]) + when Le < SP -> + {Le,{Cm,Li},Bs}; +stack_frame(SP, down, [#e{level=Le,mfa={Cm,_,_},line=Li,bindings=Bs}|_]) + when Le > SP -> + {Le,{Cm,Li},Bs}; +stack_frame(SP, Dir, [#e{level=SP}|Stack]) -> + case Stack of + [#e{level=Le,mfa={Cm,_,_},line=Li,bindings=Bs}|_] -> + {Le,{Cm,Li},Bs}; + [] when Dir =:= up -> + top; + [] when Dir =:= down -> + bottom + end; +stack_frame(SP, Dir, [_Entry|Stack]) -> + stack_frame(SP, Dir, Stack). + +%% backtrace(HowMany) -> Backtrace +%% HowMany = all | int() +%% Backtrace = {Le, MFA} +%% Return all/the last N called functions, in reversed call order +backtrace(HowMany, Ieval) -> + #ieval{level=Level,module=Mod,function=Name,arguments=As} = Ieval, + Stack0 = [#e{level=Level,mfa={Mod,Name,As}}|get(?STACK)], + Stack = case HowMany of + all -> Stack0; + N -> lists:sublist(Stack0, N) + end, + [{Le,MFA} || #e{level=Le,mfa=MFA} <- Stack]. + +%%-------------------------------------------------------------------- +%% in_use_p(Mod, Cm) -> boolean() +%% Mod = Cm = atom() +%% Returns true if Mod is found on the stack, otherwise false. +%%-------------------------------------------------------------------- +in_use_p(Mod, Mod) -> true; +in_use_p(Mod, _Cm) -> + case get(trace_stack) of + false -> true; + _ -> % all | no_tail + lists:any(fun(#e{mfa={M,_,_}}) when M =:= Mod -> true; + (_) -> false + end, get(?STACK)) + end. diff --git a/lib/debugger/src/dbg_ui_break_win.erl b/lib/debugger/src/dbg_ui_break_win.erl index 4039bf785f..abbec158b0 100644 --- a/lib/debugger/src/dbg_ui_break_win.erl +++ b/lib/debugger/src/dbg_ui_break_win.erl @@ -81,12 +81,12 @@ create_win(GS, {X, Y}, function, Mod, _Line) -> {pack_x, 2}, {pack_y, 3}, {selectmode, multiple}]), - %% Add Ok and Cancel buttons - {Wbtn, Hbtn} = dbg_ui_win:min_size(["Ok","Cancel"], 70, 30), + %% Add OK and Cancel buttons + {Wbtn, Hbtn} = dbg_ui_win:min_size(["OK","Cancel"], 70, 30), Bot = gs:frame(Frm, [{pack_x, {1, 3}}, {pack_y, 4}]), - Ok = gs:button(Bot, [{x, Pad}, {y, Pad}, + OK = gs:button(Bot, [{x, Pad}, {y, Pad}, {width, Wbtn}, {height, Hbtn}, - {label, {text,"Ok"}}, {font, Font}]), + {label, {text,"OK"}}, {font, Font}]), Cancel = gs:button(Bot, [{x, W-Pad-Wbtn}, {y, Pad}, {width, Wbtn}, {height, Hbtn}, {label, {text,"Cancel"}}, {font, Font}]), @@ -95,7 +95,7 @@ create_win(GS, {X, Y}, function, Mod, _Line) -> gs:config(Win, [{width, Wfrm}, {height, Hfrm}, {map, true}]), #winInfo{type=function, win=Win, packer=Frm, entries=Entries, trigger=enable, - ok=Ok, cancel=Cancel, listbox=Lb, funcs=[]}; + ok=OK, cancel=Cancel, listbox=Lb, funcs=[]}; create_win(GS, {X, Y}, Type, Mod, Line) -> Pad = 8, W = 230, @@ -161,12 +161,12 @@ create_win(GS, {X, Y}, Type, Mod, Line) -> {align, w}, {group, Grp}, {data, {trigger, delete}}]), - %% Add Ok and Cancel buttons - {Wbtn, Hbtn} = dbg_ui_win:min_size(["Ok","Cancel"], 70, 30), + %% Add OK and Cancel buttons + {Wbtn, Hbtn} = dbg_ui_win:min_size(["OK","Cancel"], 70, 30), Ybtn = Yacc + Pad + Hfrm + Pad, - Ok = gs:button(Win, [{x, Pad}, {y, Ybtn}, + OK = gs:button(Win, [{x, Pad}, {y, Ybtn}, {width, Wbtn}, {height, Hbtn}, - {label, {text,"Ok"}}, {font, Font}]), + {label, {text,"OK"}}, {font, Font}]), gs:button(Win, [{x, W-Pad-Wbtn}, {y, Ybtn}, {width, Wbtn}, {height, Hbtn}, {label, {text,"Cancel"}}, {font, Font}]), @@ -175,7 +175,7 @@ create_win(GS, {X, Y}, Type, Mod, Line) -> gs:config(Win, [{width, W}, {height, Hwin}, {map, true}]), #winInfo{type=Type, win=Win, - entries=Entries, trigger=enable, ok=Ok}. + entries=Entries, trigger=enable, ok=OK}. %%-------------------------------------------------------------------- %% update_functions(WinInfo, Funcs) -> WinInfo @@ -229,7 +229,7 @@ handle_event({gs, LB, keypress, window, [Key|_]}, WinInfo) -> Key/='Tab', Key/='Return' -> ignore; true -> - handle_event({gs, LB, click, listbox, ["Ok"]}, WinInfo) + handle_event({gs, LB, click, listbox, ["OK"]}, WinInfo) end; handle_event({gs, Ent, keypress, Data, [Key|_]}, WinInfo) -> case WinInfo#winInfo.type of @@ -249,14 +249,14 @@ handle_event({gs, Ent, keypress, Data, [Key|_]}, WinInfo) -> case next_entry(Ent, WinInfo#winInfo.entries) of last -> gs:config(WinInfo#winInfo.ok, flash), - handle_event({gs, Ent, click, Data, ["Ok"]}, WinInfo); + handle_event({gs, Ent, click, Data, ["OK"]}, WinInfo); Next -> gs:config(Next, {setfocus, true}), ignore end; _Type -> ignore end; -handle_event({gs, _Id, click, _Data, ["Ok"|_]}, WinInfo) -> +handle_event({gs, _Id, click, _Data, ["OK"|_]}, WinInfo) -> case check_input(WinInfo#winInfo.entries) of error -> ignore; Data when WinInfo#winInfo.type/=function -> diff --git a/lib/debugger/src/dbg_ui_edit_win.erl b/lib/debugger/src/dbg_ui_edit_win.erl index badaf4bef4..82f784aa83 100644 --- a/lib/debugger/src/dbg_ui_edit_win.erl +++ b/lib/debugger/src/dbg_ui_edit_win.erl @@ -64,13 +64,13 @@ create_win(GS, {X, Y}, Title, Prompt, {Type, Value}) -> {text, Value}, {keypress, true}]), - %% Ok and Cancel buttons + %% OK and Cancel buttons W = Pad + Wlbl + Went + Pad, {Wbtn, Hbtn} = dbg_ui_win:min_size(["Cancel"], 70, 30), Ybtn = Pad + Hlbl + Pad, Btn = gs:button(Win, [{x, Pad}, {y, Ybtn}, {width, Wbtn}, {height, Hbtn}, - {label, {text,"Ok"}}, {font, Font}]), + {label, {text,"OK"}}, {font, Font}]), gs:button(Win, [{x, W-Pad-Wbtn}, {y, Ybtn}, {width, Wbtn}, {height, Hbtn}, {label, {text,"Cancel"}}, {font, Font}]), @@ -100,8 +100,8 @@ handle_event({gs, _Id, destroy, _Data, _Arg}, _WinInfo) -> stopped; handle_event({gs, Id, keypress, Data, ['Return'|_]}, WinInfo) -> gs:config(WinInfo#winInfo.button, flash), - handle_event({gs, Id, click, Data, ["Ok"]}, WinInfo); -handle_event({gs, _Id, click, _Data, ["Ok"|_]}, WinInfo) -> + handle_event({gs, Id, click, Data, ["OK"]}, WinInfo); +handle_event({gs, _Id, click, _Data, ["OK"|_]}, WinInfo) -> Ent = WinInfo#winInfo.entry, Str = gs:read(Ent, text), Type = WinInfo#winInfo.type, diff --git a/lib/debugger/src/dbg_ui_filedialog_win.erl b/lib/debugger/src/dbg_ui_filedialog_win.erl index 3203991c1f..1eced1104d 100644 --- a/lib/debugger/src/dbg_ui_filedialog_win.erl +++ b/lib/debugger/src/dbg_ui_filedialog_win.erl @@ -100,7 +100,7 @@ create_win(GS, Title, {X,Y}, Mode, Filter, Extra, FileName) -> Opts = [{y, Y4}, {width, Wbtn}, {height, Hbtn}, {font, Font}], case Mode of normal -> - gs:button(Win, [{label, {text,"Ok"}}, {x, Pad}, + gs:button(Win, [{label, {text,"OK"}}, {x, Pad}, {data, select} | Opts]), gs:button(Win, [{label, {text,"Filter"}}, {x, Wlb/2-Wbtn/2}, {data, filter} | Opts]), diff --git a/lib/debugger/src/dbg_ui_interpret.erl b/lib/debugger/src/dbg_ui_interpret.erl index 952e73b537..079eaeb634 100644 --- a/lib/debugger/src/dbg_ui_interpret.erl +++ b/lib/debugger/src/dbg_ui_interpret.erl @@ -145,7 +145,7 @@ interpret_all(State, Dir, [File0|Files]) -> Window = dbg_ui_filedialog_win:get_window(State#state.win), Error = format_error(int:interpretable(File)), Msg = ["Error when interpreting:", File, Error, - "Ok to continue?"], + "OK to continue?"], case tool_utils:confirm(Window, Msg) of ok -> interpret_all(State, Dir, Files); cancel -> true diff --git a/lib/debugger/src/dbg_ui_settings.erl b/lib/debugger/src/dbg_ui_settings.erl index 146aa7e239..38b2ec424f 100644 --- a/lib/debugger/src/dbg_ui_settings.erl +++ b/lib/debugger/src/dbg_ui_settings.erl @@ -136,8 +136,8 @@ default_settings_dir(GS) -> {ok, CWD} = file:get_cwd(), Msg = ["Default directory", DefDir, "does not exist.", - "Click Ok to create it or", - "Cancel to use other directory!"], + "Click OK to create it or", + "Cancel to use other directory."], case tool_utils:confirm(GS, Msg) of ok -> ToolsDir = filename:dirname(DefDir), diff --git a/lib/debugger/src/dbg_wx_break_win.erl b/lib/debugger/src/dbg_wx_break_win.erl index 7ac82c8fb4..062da3937a 100644 --- a/lib/debugger/src/dbg_wx_break_win.erl +++ b/lib/debugger/src/dbg_wx_break_win.erl @@ -82,8 +82,8 @@ create_win(Parent, Pos, function, Mod, _Line) -> wxComboBox:connect(Text, command_text_updated), wxListBox:connect(LB, command_listbox_selected), wxListBox:connect(LB, command_listbox_doubleclicked), - OkId = wxDialog:getAffirmativeId(Win), - OKButt = wxWindow:findWindowById(OkId, [{parent, Win}]), + OKId = wxDialog:getAffirmativeId(Win), + OKButt = wxWindow:findWindowById(OKId, [{parent, Win}]), wxWindow:disable(OKButt), wxDialog:centreOnParent(Win), wxDialog:show(Win), @@ -141,8 +141,8 @@ create_win(Parent, Pos, Type, Mod, Line) -> wxComboBox:setFocus(ModT), wxDialog:connect(Win, command_button_clicked), wxDialog:connect(Win, command_text_updated), - OkId = wxDialog:getAffirmativeId(Win), - OKButt = wxWindow:findWindowById(OkId), + OKId = wxDialog:getAffirmativeId(Win), + OKButt = wxWindow:findWindowById(OKId), wxWindow:disable(OKButt), wxDialog:centreOnParent(Win), wxDialog:show(Win), @@ -180,30 +180,30 @@ handle_event(#wx{id=?wxID_CANCEL}, #winInfo{win=Win}) -> wxDialog:destroy(Win), stopped; handle_event(#wx{event=#wxCommand{type=command_text_updated}}, - #winInfo{type=function, text=Text, ok=Ok}) -> + #winInfo{type=function, text=Text, ok=OK}) -> Module = wxComboBox:getValue(Text), - wxWindow:disable(Ok), + wxWindow:disable(OK), {module, list_to_atom(Module)}; handle_event(#wx{event=#wxCommand{type=command_text_updated}}, - #winInfo{text=Text, ok=Ok, entries=Es}) -> + #winInfo{text=Text, ok=OK, entries=Es}) -> Module = wxComboBox:getValue(Text), case check_input(Es) of - error -> wxWindow:disable(Ok); - _Data when Module =/= "" -> wxWindow:enable(Ok); - _ -> wxWindow:disable(Ok) + error -> wxWindow:disable(OK); + _Data when Module =/= "" -> wxWindow:enable(OK); + _ -> wxWindow:disable(OK) end, ignore; handle_event(#wx{event=#wxCommand{type=command_listbox_selected}}, - #winInfo{type=function, listbox=LB, ok=Ok}) -> + #winInfo{type=function, listbox=LB, ok=OK}) -> case wxListBox:getSelections(LB) of - {N,_} when N > 0 -> wxWindow:enable(Ok); - _ -> wxWindow:disable(Ok) + {N,_} when N > 0 -> wxWindow:enable(OK); + _ -> wxWindow:disable(OK) end, ignore; -handle_event(#wx{id=OKorListBox, event=#wxCommand{type=OkorDoubleClick}}, +handle_event(#wx{id=OKorListBox, event=#wxCommand{type=OKorDoubleClick}}, #winInfo{type=function,win=Win,listbox=LB,funcs=Funcs,text=Text}) when OKorListBox =:= ?wxID_OK; - OkorDoubleClick =:= command_listbox_doubleclicked -> + OKorDoubleClick =:= command_listbox_doubleclicked -> Mod = wxComboBox:getValue(Text), {_, IndexL} = wxListBox:getSelections(LB), Breaks = [[list_to_atom(Mod)|lists:nth(Index+1, Funcs)] || Index <- IndexL], diff --git a/lib/debugger/src/dbg_wx_filedialog_win.erl b/lib/debugger/src/dbg_wx_filedialog_win.erl index 9687efa981..9f45ad0c47 100644 --- a/lib/debugger/src/dbg_wx_filedialog_win.erl +++ b/lib/debugger/src/dbg_wx_filedialog_win.erl @@ -151,7 +151,7 @@ init([Parent, Id, Options0]) -> Bott = wxDialog:createButtonSizer(Dlg, ?wxCANCEL bor ?wxOK), wxDialog:connect(Dlg, command_button_clicked), - %% Ok done + %% OK done Box = wxBoxSizer:new(?wxVERTICAL), wxSizer:add(Box, Top, [{border, 2}, {flag,?wxALL bor ?wxEXPAND}]), wxSizer:add(Box, Dir, [{border, 2}, {flag,?wxALL bor ?wxEXPAND}]), diff --git a/lib/debugger/src/dbg_wx_settings.erl b/lib/debugger/src/dbg_wx_settings.erl index 8f87815949..bc88bdf7da 100644 --- a/lib/debugger/src/dbg_wx_settings.erl +++ b/lib/debugger/src/dbg_wx_settings.erl @@ -83,9 +83,9 @@ default_settings_dir(Win) -> false -> {ok, CWD} = file:get_cwd(), - Msg = ["Default directory", DefDir, "does not exist.", - "Click Ok to create it or", - "Cancel to use other directory!"], + Msg = ["Default directory ", DefDir, " does not exist. ", + "Click OK to create it or ", + "Cancel to use other directory."], case dbg_wx_win:confirm(Win, Msg) of ok -> ToolsDir = filename:dirname(DefDir), diff --git a/lib/debugger/src/dbg_wx_trace_win.erl b/lib/debugger/src/dbg_wx_trace_win.erl index 720b913024..720b913024 100755..100644 --- a/lib/debugger/src/dbg_wx_trace_win.erl +++ b/lib/debugger/src/dbg_wx_trace_win.erl diff --git a/lib/debugger/src/dbg_wx_winman.erl b/lib/debugger/src/dbg_wx_winman.erl index 79dcc47f6f..79dcc47f6f 100755..100644 --- a/lib/debugger/src/dbg_wx_winman.erl +++ b/lib/debugger/src/dbg_wx_winman.erl diff --git a/lib/debugger/src/debugger.app.src b/lib/debugger/src/debugger.app.src index 21cf59a2e1..5538f66260 100644 --- a/lib/debugger/src/debugger.app.src +++ b/lib/debugger/src/debugger.app.src @@ -26,6 +26,7 @@ dbg_ieval, dbg_iload, dbg_iserver, + dbg_istk, dbg_ui_break, dbg_ui_break_win, dbg_ui_edit, diff --git a/lib/debugger/test/Makefile b/lib/debugger/test/Makefile index 2296bd0ae6..3dfbed31ff 100644 --- a/lib/debugger/test/Makefile +++ b/lib/debugger/test/Makefile @@ -43,6 +43,7 @@ MODULES= \ exception_SUITE \ fun_SUITE \ lc_SUITE \ + line_number_SUITE \ record_SUITE \ trycatch_SUITE \ test_lib \ diff --git a/lib/debugger/test/bs_construct_SUITE.erl b/lib/debugger/test/bs_construct_SUITE.erl index 5c7d49e951..187c9f53b0 100644 --- a/lib/debugger/test/bs_construct_SUITE.erl +++ b/lib/debugger/test/bs_construct_SUITE.erl @@ -19,18 +19,31 @@ -module(bs_construct_SUITE). +%% Copied from bs_construct_SUITE in the emulator test suite. +%% The following test cases have been omitted since they don't +%% make much sense for the debugger: +%% bs_add +%% kostis + -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, - test1/1, test2/1, test3/1, test4/1, test5/1, testf/1, not_used/1, in_guard/1, - coerce_to_float/1]). + test1/1, test2/1, test3/1, test4/1, test5/1, testf/1, + not_used/1, in_guard/1, + mem_leak/1, coerce_to_float/1, bjorn/1, + huge_float_field/1, huge_binary/1, system_limit/1, badarg/1, + copy_writable_binary/1, dynamic/1, + otp_7422/1, zero_width/1]). -include_lib("test_server/include/test_server.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - cases(). + [test1, test2, test3, test4, test5, testf, not_used, + in_guard, mem_leak, coerce_to_float, bjorn, + huge_float_field, huge_binary, system_limit, badarg, + copy_writable_binary, dynamic, otp_7422, zero_width]. groups() -> []. @@ -41,11 +54,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - -cases() -> - [test1, test2, test3, test4, test5, testf, not_used, - in_guard, coerce_to_float]. - init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), Dog = test_server:timetrap(?t:minutes(1)), @@ -75,7 +83,9 @@ r(L) -> -define(T(B, L), {B, ??B, L}). -define(N(B), {B, ??B, unknown}). --define(FAIL(Expr), ?line {'EXIT',{badarg,_}} = (catch Expr)). +-define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])). + +-define(FAIL_VARS(Expr, Vars), ?line fail_check(catch Expr, ??Expr, Vars)). l(I_13, I_big1) -> [ @@ -143,7 +153,13 @@ l(I_13, I_big1) -> native_3798()), ?T(<<32978297842987249827298387697777669766334937:128/native-integer>>, - native_bignum()) + native_bignum()), + + %% Unit tests. + ?T(<<<<5:3>>/bitstring>>, <<5:3>>), + ?T(<<42,<<7:4>>/binary-unit:4>>, <<42,7:4>>), + ?T(<<<<344:17>>/binary-unit:17>>, <<344:17>>), + ?T(<<<<42,3,7656:16>>/binary-unit:16>>, <<42,3,7656:16>>) ]. @@ -179,7 +195,7 @@ eval_list([{C_bin, Str, Bytes} | Rest], Vars) -> [{C_bin, E_bin, Str, Bytes} | eval_list(Rest, Vars)] end. -one_test({C_bin, E_bin, Str, Bytes}) when list(Bytes) -> +one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) -> io:format(" ~s, ~p~n", [Str, Bytes]), Bin = list_to_binary(Bytes), if @@ -222,7 +238,7 @@ one_test({C_bin, E_bin, Str, Result}) -> ok; %% For situations where the final bits may not matter, like %% for floats: - N when integer(N) -> + N when is_integer(N) -> io:format("Info: compiled and interpreted differ in the" " last bytes:~n ~p, ~p.~n", [binary_to_list(C_bin), binary_to_list(E_bin)]), @@ -248,9 +264,22 @@ equal_lists(A, B, R) -> false end. +fail_check({'EXIT',{badarg,_}}, Str, Vars) -> + try evaluate(Str, Vars) of + Res -> + io:format("Interpreted result: ~p", [Res]), + ?t:fail(did_not_fail_in_intepreted_code) + catch + error:badarg -> + ok + end; +fail_check(Res, _, _) -> + io:format("Compiled result: ~p", [Res]), + ?t:fail(did_not_fail_in_compiled_code). + %%% Simple working cases test1(suite) -> []; -test1(Config) when list(Config) -> +test1(Config) when is_list(Config) -> ?line I_13 = i(13), ?line I_big1 = big(1), ?line Vars = [{'I_13', I_13}, @@ -272,7 +301,7 @@ gen_l(N, S, A) -> [?T(<<A:S/little, A:(N-S)/little>>, comp(N, A, S))]. test2(suite) -> []; -test2(Config) when list(Config) -> +test2(Config) when is_list(Config) -> ?line test2(0, 8, 2#10101010101010101), ?line test2(0, 8, 2#1111111111). @@ -300,7 +329,7 @@ t3() -> ]. test3(suite) -> []; -test3(Config) when list(Config) -> +test3(Config) when is_list(Config) -> ?line Vars = [], ?line lists:foreach(fun one_test/1, eval_list(t3(), Vars)). @@ -311,7 +340,7 @@ gen_u_l(N, S, A) -> [?N(<<A:S/little, A:(N-S)/little>>)]. test4(suite) -> []; -test4(Config) when list(Config) -> +test4(Config) when is_list(Config) -> ?line test4(0, 16, 2#10101010101010101), ?line test4(0, 16, 2#1111111111). @@ -333,7 +362,7 @@ gen_b(N, S, A) -> test5(suite) -> []; test5(doc) -> ["OTP-3995"]; -test5(Config) when list(Config) -> +test5(Config) when is_list(Config) -> ?line test5(0, 8, <<73>>), ?line test5(0, 8, <<68>>). @@ -350,40 +379,63 @@ test5(S, A) -> %%% Failure cases testf(suite) -> []; -testf(Config) when list(Config) -> - ?FAIL(<<3.14>>), - ?FAIL(<<<<1,2>>>>), - - ?FAIL(<<2.71/binary>>), - ?FAIL(<<24334/binary>>), - ?FAIL(<<24334344294788947129487129487219847/binary>>), - - ?FAIL(<<<<1,2,3>>/float>>), +testf(Config) when is_list(Config) -> + ?line ?FAIL(<<3.14>>), + ?line ?FAIL(<<<<1,2>>>>), + + ?line ?FAIL(<<2.71/binary>>), + ?line ?FAIL(<<24334/binary>>), + ?line ?FAIL(<<24334344294788947129487129487219847/binary>>), + BigInt = id(24334344294788947129487129487219847), + ?line ?FAIL_VARS(<<BigInt/binary>>, [{'BigInt',BigInt}]), + ?line ?FAIL_VARS(<<42,BigInt/binary>>, [{'BigInt',BigInt}]), + ?line ?FAIL_VARS(<<BigInt:2/binary>>, [{'BigInt',BigInt}]), + + %% One negative field size, but the sum of field sizes will be 1 byte. + %% Make sure that we reject that properly. + I_minus_777 = id(-777), + I_minus_2047 = id(-2047), + ?line ?FAIL_VARS(<<I_minus_777:2048/unit:8,57:I_minus_2047/unit:8>>, + ordsets:from_list([{'I_minus_777',I_minus_777}, + {'I_minus_2047',I_minus_2047}])), + ?line ?FAIL(<<<<1,2,3>>/float>>), %% Negative field widths. - testf_1(-8, <<1,2,3,4,5>>), - - ?FAIL(<<42:(-16)>>), - ?FAIL(<<3.14:(-8)/float>>), - ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>), - ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>), - ?FAIL(<<<<23,56,0,2>>:(anka)>>), + ?line testf_1(-8, <<1,2,3,4,5>>), + ?line ?FAIL(<<0:(-(1 bsl 100))>>), + + ?line ?FAIL(<<42:(-16)>>), + ?line ?FAIL(<<3.14:(-8)/float>>), + ?line ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>), + ?line ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>), + ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>), + ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>), + + %% Unit failures. + ?line ?FAIL(<<<<1:1>>/binary>>), + Sz = id(1), + ?line ?FAIL_VARS(<<<<1:Sz>>/binary>>, [{'Sz',Sz}]), + ?line {'EXIT',{badarg,_}} = (catch <<<<1:(id(1))>>/binary>>), + ?line ?FAIL(<<<<7,8,9>>/binary-unit:16>>), + ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:16>>), + ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:17>>), ok. testf_1(W, B) -> - ?FAIL(<<42:W>>), - ?FAIL(<<3.14:W/float>>), - ?FAIL(<<B:W/binary>>). + Vars = [{'W',W}], + ?FAIL_VARS(<<42:W>>, Vars), + ?FAIL_VARS(<<3.14:W/float>>, Vars), + ?FAIL_VARS(<<B:W/binary>>, [{'B',B}|Vars]). not_used(doc) -> "Test that constructed binaries that are not used will still give an exception."; not_used(Config) when is_list(Config) -> ?line ok = not_used1(3, <<"dum">>), - ?line ?FAIL(not_used1(3, "dum")), - ?line ?FAIL(not_used2(444, -2)), - ?line ?FAIL(not_used2(444, anka)), - ?line ?FAIL(not_used3(444)), + ?line {'EXIT',{badarg,_}} = (catch not_used1(3, "dum")), + ?line {'EXIT',{badarg,_}} = (catch not_used2(444, -2)), + ?line {'EXIT',{badarg,_}} = (catch not_used2(444, anka)), + ?line {'EXIT',{badarg,_}} = (catch not_used3(444)), ok. not_used1(I, BinString) -> @@ -398,7 +450,7 @@ not_used3(I) -> <<I:(-8)>>, ok. -in_guard(Config) when list(Config) -> +in_guard(Config) when is_list(Config) -> ?line 1 = in_guard(<<16#74ad:16>>, 16#e95, 5), ?line 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>), ?line 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), @@ -415,6 +467,36 @@ in_guard(Bin, A, B) when <<A:14,B/float,3:2>> == Bin -> 3; in_guard(Bin, A, B) when {a,b,<<A:14,B/float,3:2>>} == Bin -> cant_happen; in_guard(_, _, _) -> nope. +mem_leak(doc) -> "Make sure that construction has no memory leak"; +mem_leak(Config) when is_list(Config) -> + ?line B = make_bin(16, <<0>>), + ?line mem_leak(1024, B), + ok. + +mem_leak(0, _) -> ok; +mem_leak(N, B) -> + ?line big_bin(B, <<23>>), + ?line {'EXIT',{badarg,_}} = (catch big_bin(B, bad)), + maybe_gc(), + mem_leak(N-1, B). + +big_bin(B1, B2) -> + <<B1/binary,B1/binary,B1/binary,B1/binary, + B1/binary,B1/binary,B1/binary,B1/binary, + B1/binary,B1/binary,B1/binary,B1/binary, + B1/binary,B1/binary,B1/binary,B1/binary, + B2/binary>>. + +make_bin(0, Acc) -> Acc; +make_bin(N, Acc) -> make_bin(N-1, <<Acc/binary,Acc/binary>>). + +maybe_gc() -> + case erlang:system_info(heap_type) of + shared -> erlang:garbage_collect(); + hybrid -> erlang:garbage_collect(); + private -> ok + end. + -define(COF(Int0), ?line (fun(Int) -> true = <<Int:32/float>> =:= <<(float(Int)):32/float>>, @@ -431,7 +513,7 @@ in_guard(_, _, _) -> nope. nonliteral(X) -> X. -coerce_to_float(Config) when list(Config) -> +coerce_to_float(Config) when is_list(Config) -> ?COF(0), ?COF(-1), ?COF(1), @@ -444,3 +526,232 @@ coerce_to_float(Config) when list(Config) -> ?COF64(298748888888888888888888888883478264866528467367364766666666666666663), ?COF64(-367546729879999999999947826486652846736736476555566666663), ok. + +bjorn(Config) when is_list(Config) -> + ?line error = bjorn_1(), + ok. + +bjorn_1() -> + Bitstr = <<7:13>>, + try + do_something() + catch + throw:blurf -> + ignore + end, + do_more(Bitstr, 13). + +do_more(Bin, Sz) -> + %% Previous bug in the bs_bits_to_bytes instruction: The exeption code + %% was not set - the previous exception (throw:blurf) would be used, + %% causing the catch to slip. + try <<Bin:Sz/binary>> of + _V -> ok + catch + error:_ -> + error + end. + +do_something() -> + throw(blurf). + +huge_float_field(Config) when is_list(Config) -> + ?line {'EXIT',{badarg,_}} = (catch <<0.0:9/float-unit:8>>), + ?line huge_float_check(catch <<0.0:67108865/float-unit:64>>), + ?line huge_float_check(catch <<0.0:((1 bsl 26)+1)/float-unit:64>>), + ?line huge_float_check(catch <<0.0:(id(67108865))/float-unit:64>>), +%% ?line huge_float_check(catch <<0.0:((1 bsl 60)+1)/float-unit:64>>), + ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 26)+1)/float-unit:64>>), +%% ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 60)+1)/float-unit:64>>), + ok. + +huge_float_check({'EXIT',{system_limit,_}}) -> ok; +huge_float_check({'EXIT',{badarg,_}}) -> ok. + +huge_binary(Config) when is_list(Config) -> + ?line 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>), + ok. + +system_limit(Config) when is_list(Config) -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + ?line {'EXIT',{system_limit,_}} = + (catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>), + ?line {'EXIT',{system_limit,_}} = + (catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>), + ?line {'EXIT',{system_limit,_}} = + (catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>), + + case WordSize of + 4 -> + system_limit_32(); + 8 -> + ok + end. + +system_limit_32() -> + ?line {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), + ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), + ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + ?line {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), + ?line {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), + ?line {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), + ?line {'EXIT',{system_limit,_}} = + (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), + ok. + +badarg(Config) when is_list(Config) -> + %% BEAM will generate a badarg exception for: + %% <<0:(id(1 bsl 100)),0:(id(-1))>> + %% but the debugger will generate a system_limit exception. + %% It does not seems worthwhile to fix the debugger. + + ?line {'EXIT',{badarg,_}} = + (catch <<(id(<<>>))/binary,0:(id(-(1 bsl 100)))>>), + + ok. + +copy_writable_binary(Config) when is_list(Config) -> + ?line [copy_writable_binary_1(I) || I <- lists:seq(0, 256)], + ok. + +copy_writable_binary_1(_) -> + ?line Bin0 = <<(id(<<>>))/binary,0,1,2,3,4,5,6,7>>, + ?line SubBin = make_sub_bin(Bin0), + ?line id(<<42,34,55,Bin0/binary>>), %Make reallocation likelier. + ?line Pid = spawn(fun() -> + copy_writable_binary_holder(Bin0, SubBin) + end), + ?line Tab = ets:new(holder, []), + ?line ets:insert(Tab, {17,Bin0}), + ?line ets:insert(Tab, {42,SubBin}), + ?line id(<<Bin0/binary,0:(64*1024*8)>>), + ?line Pid ! self(), + ?line [{17,Bin0}] = ets:lookup(Tab, 17), + ?line [{42,Bin0}] = ets:lookup(Tab, 42), + receive + {Pid,Bin0,Bin0} -> ok; + Other -> + io:format("Unexpected message: ~p", [Other]), + ?line ?t:fail() + end, + ok. + +copy_writable_binary_holder(Bin, SubBin) -> + receive + Pid -> + Pid ! {self(),Bin,SubBin} + end. + +make_sub_bin(Bin0) -> + N = bit_size(Bin0), + <<_:17,Bin:N/bitstring,_:5>> = <<(-1):17,Bin0/bitstring,(-1):5>>, + Bin = Bin0, %Assertion. + Bin. + +%% Test that different ways of using bit syntax instructions +%% give the same result. + +dynamic(Config) when is_list(Config) -> + ?line dynamic_1(fun dynamic_big/5), + ?line dynamic_1(fun dynamic_little/5), + ok. + +dynamic_1(Dynamic) -> + <<Lpad:128>> = erlang:md5([0]), + <<Rpad:128>> = erlang:md5([1]), + <<Int:128>> = erlang:md5([2]), + 8385 = dynamic_2(0, {Int,Lpad,Rpad,Dynamic}, 0). + +dynamic_2(129, _, Count) -> Count; +dynamic_2(Bef, Data, Count0) -> + Count = dynamic_3(Bef, 128-Bef, Data, Count0), + dynamic_2(Bef+1, Data, Count). + +dynamic_3(_, -1, _, Count) -> Count; +dynamic_3(Bef, N, {Int0,Lpad,Rpad,Dynamic}=Data, Count) -> + Int1 = Int0 band ((1 bsl (N+3))-1), + Dynamic(Bef, N, Int1, Lpad, Rpad), + Dynamic(Bef, N, -Int1, Lpad, Rpad), + + %% OTP-7085: Test a small number in a wide field. + Int2 = Int0 band 16#FFFFFF, + Dynamic(Bef, N, Int2, Lpad, Rpad), + Dynamic(Bef, N, -Int2, Lpad, Rpad), + dynamic_3(Bef, N-1, Data, Count+1). + +dynamic_big(Bef, N, Int, Lpad, Rpad) -> + NumBin = id(<<Int:N>>), + MaskedInt = Int band ((1 bsl N) - 1), + <<MaskedInt:N>> = NumBin, + + %% Construct the binary in two different ways. + Bin = id(<<Lpad:Bef,NumBin/bitstring,Rpad:(128-Bef-N)>>), + Bin = <<Lpad:Bef,Int:N,Rpad:(128-Bef-N)>>, + + %% Further verify the result by matching. + LpadMasked = Lpad band ((1 bsl Bef) - 1), + RpadMasked = Rpad band ((1 bsl (128-Bef-N)) - 1), + Rbits = (128-Bef-N), + <<LpadMasked:Bef,MaskedInt:N,RpadMasked:Rbits>> = id(Bin), + ok. + +dynamic_little(Bef, N, Int, Lpad, Rpad) -> + NumBin = id(<<Int:N/little>>), + MaskedInt = Int band ((1 bsl N) - 1), + <<MaskedInt:N/little>> = NumBin, + + %% Construct the binary in two different ways. + Bin = id(<<Lpad:Bef/little,NumBin/bitstring,Rpad:(128-Bef-N)/little>>), + Bin = <<Lpad:Bef/little,Int:N/little,Rpad:(128-Bef-N)/little>>, + + %% Further verify the result by matching. + LpadMasked = Lpad band ((1 bsl Bef) - 1), + RpadMasked = Rpad band ((1 bsl (128-Bef-N)) - 1), + Rbits = (128-Bef-N), + <<LpadMasked:Bef/little,MaskedInt:N/little,RpadMasked:Rbits/little>> = id(Bin), + ok. + +otp_7422(Config) when is_list(Config) -> + otp_7422_int(0), + otp_7422_bin(0). + +otp_7422_int(N) when N < 512 -> + T = erlang:make_tuple(N, []), + spawn_link(fun() -> + id(T), + %% A size of field 0 would write one byte beyond + %% the current position in the binary. It could + %% overwrite the continuation pointer stored on + %% the stack if HTOP was equal to E (the stack pointer). + id(<<0:(id(0))>>) + end), + otp_7422_int(N+1); +otp_7422_int(_) -> ok. + +otp_7422_bin(N) when N < 512 -> + T = erlang:make_tuple(N, []), + Z = id(<<>>), + spawn_link(fun() -> + id(T), + id(<<Z:(id(0))/bits>>) + end), + otp_7422_bin(N+1); +otp_7422_bin(_) -> ok. + +zero_width(Config) when is_list(Config) -> + ?line Z = id(0), + Small = id(42), + Big = id(1 bsl 128), + ?line <<>> = <<Small:Z>>, + ?line <<>> = <<Small:0>>, + ?line <<>> = <<Big:Z>>, + ?line <<>> = <<Big:0>>, + + ?line {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>), + ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):Z>>), + ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):0>>), + + ok. + +id(I) -> I. diff --git a/lib/debugger/test/bs_match_bin_SUITE.erl b/lib/debugger/test/bs_match_bin_SUITE.erl index b42b84aef2..5a7c30f16b 100644 --- a/lib/debugger/test/bs_match_bin_SUITE.erl +++ b/lib/debugger/test/bs_match_bin_SUITE.erl @@ -24,14 +24,14 @@ -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, - byte_split_binary/1,bit_split_binary/1]). + byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]). -include_lib("test_server/include/test_server.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - cases(). + [byte_split_binary, bit_split_binary, match_huge_bin]. groups() -> []. @@ -42,10 +42,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - -cases() -> - [byte_split_binary, bit_split_binary]. - init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), Dog = test_server:timetrap(?t:minutes(1)), @@ -65,11 +61,12 @@ end_per_suite(Config) when is_list(Config) -> ok. byte_split_binary(doc) -> "Tries to split a binary at all byte-aligned positions."; -byte_split_binary(suite) -> []; -byte_split_binary(Config) when list(Config) -> +byte_split_binary(Config) when is_list(Config) -> ?line L = lists:seq(0, 57), ?line B = mkbin(L), - ?line byte_split(L, B, size(B)). + ?line byte_split(L, B, size(B)), + ?line Unaligned = make_unaligned_sub_binary(B), + ?line byte_split(L, Unaligned, size(Unaligned)). byte_split(L, B, Pos) when Pos >= 0 -> ?line Sz1 = Pos, @@ -78,18 +75,19 @@ byte_split(L, B, Pos) when Pos >= 0 -> ?line B1 = list_to_binary(lists:sublist(L, 1, Pos)), ?line B2 = list_to_binary(lists:nthtail(Pos, L)), ?line byte_split(L, B, Pos-1); -byte_split(_L, _B, _) -> ok. +byte_split(_, _, _) -> ok. bit_split_binary(doc) -> "Tries to split a binary at all positions."; -bit_split_binary(suite) -> []; -bit_split_binary(Config) when list(Config) -> +bit_split_binary(Config) when is_list(Config) -> Fun = fun(Bin, List, SkipBef, N) -> ?line SkipAft = 8*size(Bin) - N - SkipBef, - io:format("~p, ~p, ~p", [SkipBef,N,SkipAft]), - ?line <<_I1:SkipBef,OutBin:N/binary-unit:1,_I2:SkipAft>> = Bin, + %%io:format("~p, ~p, ~p", [SkipBef,N,SkipAft]), + ?line <<_:SkipBef,OutBin:N/binary-unit:1,_:SkipAft>> = Bin, ?line OutBin = make_bin_from_list(List, N) end, ?line bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)), + ?line bit_split_binary1(Fun, + make_unaligned_sub_binary(erlang:md5(<<1,2,3>>))), ok. bit_split_binary1(Action, Bin) -> @@ -99,24 +97,23 @@ bit_split_binary1(Action, Bin) -> bit_split_binary2(Action, Bin, [_|T]=List, Bef) -> bit_split_binary3(Action, Bin, List, Bef, size(Bin)*8), bit_split_binary2(Action, Bin, T, Bef+1); -bit_split_binary2(_Action, _Bin, [], _Bef) -> ok. +bit_split_binary2(_, _, [], _) -> ok. bit_split_binary3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> Action(Bin, List, Bef, (Aft-Bef) div 8 * 8), bit_split_binary3(Action, Bin, List, Bef, Aft-8); bit_split_binary3(_, _, _, _, _) -> ok. -make_bin_from_list(_List, 0) -> - mkbin([]); +make_bin_from_list(_, 0) -> mkbin([]); make_bin_from_list(List, N) -> list_to_binary([make_int(List, 8, 0), make_bin_from_list(lists:nthtail(8, List), N-8)]). -make_int(_List, 0, Acc) -> Acc; +make_int(_, 0, Acc) -> Acc; make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H). -bits_to_list([_H|T], 0) -> bits_to_list(T, 16#80); +bits_to_list([_|T], 0) -> bits_to_list(T, 16#80); bits_to_list([H|_]=List, Mask) -> [case H band Mask of 0 -> 0; @@ -124,5 +121,109 @@ bits_to_list([H|_]=List, Mask) -> end|bits_to_list(List, Mask bsr 1)]; bits_to_list([], _) -> []. +mkbin(L) when is_list(L) -> list_to_binary(L). + +make_unaligned_sub_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +id(I) -> I. + +match_huge_bin(Config) when is_list(Config) -> + ?line Bin = <<0:(1 bsl 27),13:8>>, + ?line skip_huge_bin_1(1 bsl 27, Bin), + ?line 16777216 = match_huge_bin_1(1 bsl 27, Bin), + + %% Test overflowing the size of a binary field. + ?line nomatch = overflow_huge_bin_skip_32(Bin), + ?line nomatch = overflow_huge_bin_32(Bin), + ?line nomatch = overflow_huge_bin_skip_64(Bin), + ?line nomatch = overflow_huge_bin_64(Bin), + + %% Size in variable + ?line ok = overflow_huge_bin(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ?line ok = overflow_huge_bin_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + + ok. + +overflow_huge_bin(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/binary-unit:8,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <<NewBin:Sz/binary-unit:8,0,_/binary>> -> + {error,Sz,size(NewBin)}; + _ -> + overflow_huge_bin(Bin, Sizes) + end + end; +overflow_huge_bin(_, []) -> ok. + +overflow_huge_bin_unit128(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/binary-unit:128,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <<NewBin:Sz/binary-unit:128,0,_/binary>> -> + {error,Sz,size(NewBin)}; + _ -> + overflow_huge_bin_unit128(Bin, Sizes) + end + end; +overflow_huge_bin_unit128(_, []) -> ok. + +skip_huge_bin_1(I, Bin) -> + <<_:I/binary-unit:1,13>> = Bin, + ok. -mkbin(L) when list(L) -> list_to_binary(L). +match_huge_bin_1(I, Bin) -> + case Bin of + <<Val:I/binary-unit:1,13>> -> size(Val); + _ -> nomatch + end. + +overflow_huge_bin_skip_32(<<_:4294967296/binary,0,_/binary>>) -> 1; % 1 bsl 32 +overflow_huge_bin_skip_32(<<_:33554432/binary-unit:128,0,_/binary>>) -> 2; % 1 bsl 25 +overflow_huge_bin_skip_32(<<_:67108864/binary-unit:64,0,_/binary>>) -> 3; % 1 bsl 26 +overflow_huge_bin_skip_32(<<_:134217728/binary-unit:32,0,_/binary>>) -> 4; % 1 bsl 27 +overflow_huge_bin_skip_32(<<_:268435456/binary-unit:16,0,_/binary>>) -> 5; % 1 bsl 28 +overflow_huge_bin_skip_32(<<_:536870912/binary-unit:8,0,_/binary>>) -> 6; % 1 bsl 29 +overflow_huge_bin_skip_32(<<_:1073741824/binary-unit:8,0,_/binary>>) -> 7; % 1 bsl 30 +overflow_huge_bin_skip_32(<<_:2147483648/binary-unit:8,0,_/binary>>) -> 8; % 1 bsl 31 +overflow_huge_bin_skip_32(_) -> nomatch. + +overflow_huge_bin_32(<<Bin:4294967296/binary,_/binary>>) -> {1,Bin}; % 1 bsl 32 +overflow_huge_bin_32(<<Bin:33554432/binary-unit:128,0,_/binary>>) -> {2,Bin}; % 1 bsl 25 +overflow_huge_bin_32(<<Bin:67108864/binary-unit:128,0,_/binary>>) -> {3,Bin}; % 1 bsl 26 +overflow_huge_bin_32(<<Bin:134217728/binary-unit:128,0,_/binary>>) -> {4,Bin}; % 1 bsl 27 +overflow_huge_bin_32(<<Bin:268435456/binary-unit:128,0,_/binary>>) -> {5,Bin}; % 1 bsl 28 +overflow_huge_bin_32(<<Bin:536870912/binary-unit:128,0,_/binary>>) -> {6,Bin}; % 1 bsl 29 +overflow_huge_bin_32(<<Bin:1073741824/binary-unit:128,0,_/binary>>) -> {7,Bin}; % 1 bsl 30 +overflow_huge_bin_32(<<Bin:2147483648/binary-unit:128,0,_/binary>>) -> {8,Bin}; % 1 bsl 31 +overflow_huge_bin_32(_) -> nomatch. + +overflow_huge_bin_skip_64(<<_:18446744073709551616/binary,0,_/binary>>) -> 1; % 1 bsl 64 +overflow_huge_bin_skip_64(<<_:144115188075855872/binary-unit:128,0,_/binary>>) -> 2; % 1 bsl 57 +overflow_huge_bin_skip_64(<<_:288230376151711744/binary-unit:64,0,_/binary>>) -> 3; % 1 bsl 58 +overflow_huge_bin_skip_64(<<_:576460752303423488/binary-unit:32,0,_/binary>>) -> 4; % 1 bsl 59 +overflow_huge_bin_skip_64(<<_:1152921504606846976/binary-unit:16,0,_/binary>>) -> 5; % 1 bsl 60 +overflow_huge_bin_skip_64(<<_:2305843009213693952/binary-unit:8,0,_/binary>>) -> 6; % 1 bsl 61 +overflow_huge_bin_skip_64(<<_:4611686018427387904/binary-unit:8,0,_/binary>>) -> 7; % 1 bsl 62 +overflow_huge_bin_skip_64(<<_:9223372036854775808/binary-unit:8,_/binary>>) -> 8; % 1 bsl 63 +overflow_huge_bin_skip_64(_) -> nomatch. + +overflow_huge_bin_64(<<Bin:18446744073709551616/binary,_/binary>>) -> {1,Bin}; % 1 bsl 64 +overflow_huge_bin_64(<<Bin:144115188075855872/binary-unit:128,0,_/binary>>) -> {2,Bin}; % 1 bsl 57 +overflow_huge_bin_64(<<Bin:288230376151711744/binary-unit:128,0,_/binary>>) -> {3,Bin}; % 1 bsl 58 +overflow_huge_bin_64(<<Bin:576460752303423488/binary-unit:128,0,_/binary>>) -> {4,Bin}; % 1 bsl 59 +overflow_huge_bin_64(<<Bin:1152921504606846976/binary-unit:128,0,_/binary>>) -> {5,Bin}; % 1 bsl 60 +overflow_huge_bin_64(<<Bin:2305843009213693952/binary-unit:128,0,_/binary>>) -> {6,Bin}; % 1 bsl 61 +overflow_huge_bin_64(<<Bin:4611686018427387904/binary-unit:128,0,_/binary>>) -> {7,Bin}; % 1 bsl 62 +overflow_huge_bin_64(<<Bin:9223372036854775808/binary-unit:128,0,_/binary>>) -> {8,Bin}; % 1 bsl 63 +overflow_huge_bin_64(_) -> nomatch. diff --git a/lib/debugger/test/bs_match_int_SUITE.erl b/lib/debugger/test/bs_match_int_SUITE.erl index 745368fdfc..bff5f8ff65 100644 --- a/lib/debugger/test/bs_match_int_SUITE.erl +++ b/lib/debugger/test/bs_match_int_SUITE.erl @@ -19,11 +19,11 @@ -module(bs_match_int_SUITE). --author('[email protected]'). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, - integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1]). + integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1, + match_huge_int/1,bignum/1,unaligned_32_bit/1]). -include_lib("test_server/include/test_server.hrl"). @@ -32,7 +32,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [cases()]. + [integer, signed_integer, dynamic, more_dynamic, mml, + match_huge_int, bignum, unaligned_32_bit]. groups() -> []. @@ -43,10 +44,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - -cases() -> - [integer, signed_integer, dynamic, more_dynamic, mml]. - init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), Dog = test_server:timetrap(?t:minutes(4)), @@ -65,8 +62,7 @@ init_per_suite(Config) when is_list(Config) -> end_per_suite(Config) when is_list(Config) -> ok. -integer(suite) -> []; -integer(Config) when list(Config) -> +integer(Config) when is_list(Config) -> ?line 0 = get_int(mkbin([])), ?line 0 = get_int(mkbin([0])), ?line 42 = get_int(mkbin([42])), @@ -78,22 +74,33 @@ integer(Config) when list(Config) -> ?line 65534 = get_int(mkbin([255,254])), ?line 16776455 = get_int(mkbin([255,253,7])), ?line 4245492555 = get_int(mkbin([253,13,19,75])), + ?line 4294967294 = get_int(mkbin([255,255,255,254])), + ?line 4294967295 = get_int(mkbin([255,255,255,255])), ?line Eight = [200,1,19,128,222,42,97,111], ?line cmp128(Eight, uint(Eight)), ?line fun_clause(catch get_int(mkbin(seq(1,5)))), ok. -get_int(<<I:0>>) -> I; -get_int(<<I:8>>) -> I; -get_int(<<I:16>>) -> I; -get_int(<<I:24>>) -> I; -get_int(<<I:32>>) -> I. +get_int(Bin) -> + I = get_int1(Bin), + get_int(Bin, I). + +get_int(Bin0, I) when size(Bin0) < 4 -> + Bin = <<0,Bin0/binary>>, + I = get_int1(Bin), + get_int(Bin, I); +get_int(_, I) -> I. + +get_int1(<<I:0>>) -> I; +get_int1(<<I:8>>) -> I; +get_int1(<<I:16>>) -> I; +get_int1(<<I:24>>) -> I; +get_int1(<<I:32>>) -> I. cmp128(<<I:128>>, I) -> equal; -cmp128(_B, _I) -> not_equal. +cmp128(_, _) -> not_equal. -signed_integer(suite) -> []; -signed_integer(Config) when list(Config) -> +signed_integer(Config) when is_list(Config) -> ?line {no_match,_} = sint(mkbin([])), ?line {no_match,_} = sint(mkbin([1,2,3])), ?line 127 = sint(mkbin([127])), @@ -113,7 +120,7 @@ uint(L) -> uint(L, 0). uint([H|T], Acc) -> uint(T, Acc bsl 8 bor H); uint([], Acc) -> Acc. -dynamic(Config) when list(Config) -> +dynamic(Config) when is_list(Config) -> dynamic(mkbin([255]), 8), dynamic(mkbin([255,255]), 16), dynamic(mkbin([255,255,255]), 24), @@ -124,7 +131,7 @@ dynamic(Bin, S1) when S1 >= 0 -> S2 = size(Bin) * 8 - S1, dynamic(Bin, S1, S2, (1 bsl S1) - 1, (1 bsl S2) - 1), dynamic(Bin, S1-1); -dynamic(_Bin, _) -> ok. +dynamic(_, _) -> ok. dynamic(Bin, S1, S2, A, B) -> % io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), @@ -132,25 +139,24 @@ dynamic(Bin, S1, S2, A, B) -> <<A:S1,B:S2>> -> io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), ok; - _Other -> - erlang:error(badmatch, [Bin,S1,S2,A,B]) + _Other -> erlang:error(badmatch, [Bin,S1,S2,A,B]) end. more_dynamic(doc) -> "Extract integers at different alignments and of different sizes."; -more_dynamic(Config) when list(Config) -> +more_dynamic(Config) when is_list(Config) -> % Unsigned big-endian numbers. Unsigned = fun(Bin, List, SkipBef, N) -> SkipAft = 8*size(Bin) - N - SkipBef, - <<_I1:SkipBef,Int:N,_I2:SkipAft>> = Bin, + <<_:SkipBef,Int:N,_:SkipAft>> = Bin, Int = make_int(List, N, 0) end, ?line more_dynamic1(Unsigned, funny_binary(42)), - % Signed big-endian numbers. + %% Signed big-endian numbers. Signed = fun(Bin, List, SkipBef, N) -> SkipAft = 8*size(Bin) - N - SkipBef, - <<_I1:SkipBef,Int:N/signed,_I2:SkipAft>> = Bin, + <<_:SkipBef,Int:N/signed,_:SkipAft>> = Bin, case make_signed_int(List, N) of Int -> ok; Other -> @@ -162,18 +168,18 @@ more_dynamic(Config) when list(Config) -> end, ?line more_dynamic1(Signed, funny_binary(43)), - % Unsigned little-endian numbers. + %% Unsigned little-endian numbers. UnsLittle = fun(Bin, List, SkipBef, N) -> SkipAft = 8*size(Bin) - N - SkipBef, - <<_I1:SkipBef,Int:N/little,_I2:SkipAft>> = Bin, + <<_:SkipBef,Int:N/little,_:SkipAft>> = Bin, Int = make_int(big_to_little(List, N), N, 0) end, ?line more_dynamic1(UnsLittle, funny_binary(44)), - % Signed little-endian numbers. + %% Signed little-endian numbers. SignLittle = fun(Bin, List, SkipBef, N) -> SkipAft = 8*size(Bin) - N - SkipBef, - <<_I1:SkipBef,Int:N/signed-little,_I2:SkipAft>> = Bin, + <<_:SkipBef,Int:N/signed-little,_:SkipAft>> = Bin, Little = big_to_little(List, N), Int = make_signed_int(Little, N) end, @@ -181,11 +187,6 @@ more_dynamic(Config) when list(Config) -> ok. -funny_binary(N) -> - B0 = erlang:md5([N]), - {B1,_B2} = split_binary(B0, size(B0) div 2), - B1. - more_dynamic1(Action, Bin) -> BitList = bits_to_list(binary_to_list(Bin), 16#80), more_dynamic2(Action, Bin, BitList, 0). @@ -193,7 +194,7 @@ more_dynamic1(Action, Bin) -> more_dynamic2(Action, Bin, [_|T]=List, Bef) -> more_dynamic3(Action, Bin, List, Bef, size(Bin)*8), more_dynamic2(Action, Bin, T, Bef+1); -more_dynamic2(_Action, _Bin, [], _Bef) -> ok. +more_dynamic2(_, _, [], _) -> ok. more_dynamic3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> %% io:format("~p, ~p", [Bef,Aft-Bef]), @@ -208,8 +209,8 @@ big_to_little([B0,B1,B2,B3,B4,B5,B6,B7|T], N, Acc) when N >= 8 -> big_to_little(List, N, Acc) -> lists:sublist(List, 1, N) ++ Acc. make_signed_int(_List, 0) -> 0; -make_signed_int([0|_T]=List, N) -> make_int(List, N, 0); -make_signed_int([1|_T]=List0, N) -> +make_signed_int([0|_]=List, N) -> make_int(List, N, 0); +make_signed_int([1|_]=List0, N) -> List1 = reversed_sublist(List0, N, []), List2 = two_complement_and_reverse(List1, 1, []), -make_int(List2, length(List2), 0). @@ -225,7 +226,7 @@ two_complement_and_reverse([], Carry, Acc) -> [Carry|Acc]. make_int(_List, 0, Acc) -> Acc; make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H). -bits_to_list([_H|T], 0) -> bits_to_list(T, 16#80); +bits_to_list([_|T], 0) -> bits_to_list(T, 16#80); bits_to_list([H|_]=List, Mask) -> [case H band Mask of 0 -> 0; @@ -234,11 +235,134 @@ bits_to_list([H|_]=List, Mask) -> bits_to_list([], _) -> []. fun_clause({'EXIT',{function_clause,_}}) -> ok. -mkbin(L) when list(L) -> list_to_binary(L). +mkbin(L) when is_list(L) -> list_to_binary(L). + +funny_binary(N) -> + B0 = erlang:md5([N]), + {B1,_B2} = split_binary(B0, byte_size(B0) div 3), + B1. -mml(Config) when list(Config) -> +mml(Config) when is_list(Config) -> ?line single_byte_binary = mml_choose(<<42>>), ?line multi_byte_binary = mml_choose(<<42,43>>). mml_choose(<<_A:8>>) -> single_byte_binary; -mml_choose(<<_A:8, _T/binary>>) -> multi_byte_binary. +mml_choose(<<_A:8,_T/binary>>) -> multi_byte_binary. + +match_huge_int(Config) when is_list(Config) -> + Sz = 1 bsl 27, + ?line Bin = <<0:Sz,13:8>>, + ?line skip_huge_int_1(Sz, Bin), + ?line 0 = match_huge_int_1(Sz, Bin), + + %% Test overflowing the size of an integer field. + ?line nomatch = overflow_huge_int_skip_32(Bin), + case erlang:system_info(wordsize) of + 4 -> + ?line nomatch = overflow_huge_int_32(Bin); + 8 -> + %% An attempt will be made to allocate heap space for + %% the bignum (which will probably fail); only if the + %% allocation succeds will the matching fail because + %% the binary is too small. + ok + end, + ?line nomatch = overflow_huge_int_skip_64(Bin), + ?line nomatch = overflow_huge_int_64(Bin), + + %% Test overflowing the size of an integer field using variables as sizes. + ?line Sizes = case erlang:system_info(wordsize) of + 4 -> lists:seq(25, 32); + 8 -> [] + end ++ lists:seq(50, 64), + ?line ok = overflow_huge_int_unit128(Bin, Sizes), + + ok. + +overflow_huge_int_unit128(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/unit:128,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <<Var:Sz/unit:128,0,_/binary>> -> + {error,Sz,Var}; + _ -> + overflow_huge_int_unit128(Bin, Sizes) + end + end; +overflow_huge_int_unit128(_, []) -> ok. + +match_huge_int_1(I, Bin) -> + <<Int:I,13>> = Bin, + Int. + +skip_huge_int_1(I, Bin) -> + <<_:I,13>> = Bin. + +overflow_huge_int_skip_32(<<_:4294967296,0,_/binary>>) -> 1; % 1 bsl 32 +overflow_huge_int_skip_32(<<_:33554432/unit:128,0,_/binary>>) -> 2; % 1 bsl 25 +overflow_huge_int_skip_32(<<_:67108864/unit:64,0,_/binary>>) -> 3; % 1 bsl 26 +overflow_huge_int_skip_32(<<_:134217728/unit:32,0,_/binary>>) -> 4; % 1 bsl 27 +overflow_huge_int_skip_32(<<_:268435456/unit:16,0,_/binary>>) -> 5; % 1 bsl 28 +overflow_huge_int_skip_32(<<_:536870912/unit:8,0,_/binary>>) -> 6; % 1 bsl 29 +overflow_huge_int_skip_32(<<_:1073741824/unit:8,0,_/binary>>) -> 7; % 1 bsl 30 +overflow_huge_int_skip_32(<<_:2147483648/unit:8,0,_/binary>>) -> 8; % 1 bsl 31 +overflow_huge_int_skip_32(_) -> nomatch. + +overflow_huge_int_32(<<Int:4294967296,_/binary>>) -> {1,Int}; % 1 bsl 32 +overflow_huge_int_32(<<Int:33554432/unit:128,0,_/binary>>) -> {2,Int}; % 1 bsl 25 +overflow_huge_int_32(<<Int:67108864/unit:128,0,_/binary>>) -> {3,Int}; % 1 bsl 26 +overflow_huge_int_32(<<Int:134217728/unit:128,0,_/binary>>) -> {4,Int}; % 1 bsl 27 +overflow_huge_int_32(<<Int:268435456/unit:128,0,_/binary>>) -> {5,Int}; % 1 bsl 28 +overflow_huge_int_32(<<Int:536870912/unit:128,0,_/binary>>) -> {6,Int}; % 1 bsl 29 +overflow_huge_int_32(<<Int:1073741824/unit:128,0,_/binary>>) -> {7,Int}; % 1 bsl 30 +overflow_huge_int_32(<<Int:2147483648/unit:128,0,_/binary>>) -> {8,Int}; % 1 bsl 31 +overflow_huge_int_32(_) -> nomatch. + +overflow_huge_int_skip_64(<<_:18446744073709551616,_/binary>>) -> 1; % 1 bsl 64 +overflow_huge_int_skip_64(<<_:144115188075855872/unit:128,0,_/binary>>) -> 2; % 1 bsl 57 +overflow_huge_int_skip_64(<<_:288230376151711744/unit:64,0,_/binary>>) -> 3; % 1 bsl 58 +overflow_huge_int_skip_64(<<_:576460752303423488/unit:32,0,_/binary>>) -> 4; % 1 bsl 59 +overflow_huge_int_skip_64(<<_:1152921504606846976/unit:16,0,_/binary>>) -> 5; % 1 bsl 60 +overflow_huge_int_skip_64(<<_:2305843009213693952/unit:8,0,_/binary>>) -> 6; % 1 bsl 61 +overflow_huge_int_skip_64(<<_:4611686018427387904/unit:8,0,_/binary>>) -> 7; % 1 bsl 62 +overflow_huge_int_skip_64(<<_:9223372036854775808/unit:8,0,_/binary>>) -> 8; % 1 bsl 63 +overflow_huge_int_skip_64(_) -> nomatch. + +overflow_huge_int_64(<<Int:18446744073709551616,_/binary>>) -> {1,Int}; % 1 bsl 64 +overflow_huge_int_64(<<Int:144115188075855872/unit:128,0,_/binary>>) -> {2,Int}; % 1 bsl 57 +overflow_huge_int_64(<<Int:288230376151711744/unit:128,0,_/binary>>) -> {3,Int}; % 1 bsl 58 +overflow_huge_int_64(<<Int:576460752303423488/unit:128,0,_/binary>>) -> {4,Int}; % 1 bsl 59 +overflow_huge_int_64(<<Int:1152921504606846976/unit:128,0,_/binary>>) -> {5,Int}; % 1 bsl 60 +overflow_huge_int_64(<<Int:2305843009213693952/unit:128,0,_/binary>>) -> {6,Int}; % 1 bsl 61 +overflow_huge_int_64(<<Int:4611686018427387904/unit:128,0,_/binary>>) -> {7,Int}; % 1 bsl 62 +overflow_huge_int_64(<<Int:9223372036854775808/unit:128,0,_/binary>>) -> {8,Int}; % 1 bsl 63 +overflow_huge_int_64(_) -> nomatch. + +bignum(Config) when is_list(Config) -> + ?line Bin = id(<<42,0:1024/unit:8,43>>), + ?line <<42:1025/little-integer-unit:8,_:8>> = Bin, + ?line <<_:8,43:1025/integer-unit:8>> = Bin, + + ?line BignumBin = id(<<0:512/unit:8,258254417031933722623:9/unit:8>>), + ?line <<258254417031933722623:(512+9)/unit:8>> = BignumBin, + erlang:garbage_collect(), %Search for holes in debug-build. + ok. + +unaligned_32_bit(Config) when is_list(Config) -> + %% There used to be a risk for heap overflow (fixed in R11B-5). + ?line L = unaligned_32_bit_1(<<-1:(64*1024)>>), + ?line unaligned_32_bit_verify(L, 1638). + +unaligned_32_bit_1(<<1:1,U:32,_:7,T/binary>>) -> + [U|unaligned_32_bit_1(T)]; +unaligned_32_bit_1(_) -> + []. + +unaligned_32_bit_verify([], 0) -> ok; +unaligned_32_bit_verify([4294967295|T], N) when N > 0 -> + unaligned_32_bit_verify(T, N-1). + +id(I) -> I. diff --git a/lib/debugger/test/bs_match_misc_SUITE.erl b/lib/debugger/test/bs_match_misc_SUITE.erl index 53d11ba179..89fce263f5 100644 --- a/lib/debugger/test/bs_match_misc_SUITE.erl +++ b/lib/debugger/test/bs_match_misc_SUITE.erl @@ -19,18 +19,24 @@ -module(bs_match_misc_SUITE). --author('[email protected]'). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, - bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1]). + bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1, + kenneth/1,encode_binary/1,native/1,happi/1, + size_var/1,wiger/1,x0_context/1,huge_float_field/1, + writable_binary_matched/1,otp_7198/1, + unordered_bindings/1]). -include_lib("test_server/include/test_server.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - cases(). + [bound_var, bound_tail, t_float, little_float, sean, + kenneth, encode_binary, native, happi, size_var, wiger, + x0_context, huge_float_field, writable_binary_matched, + otp_7198, unordered_bindings]. groups() -> []. @@ -41,9 +47,13 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_suite(Config) when is_list(Config) -> + ?line test_lib:interpret(?MODULE), + ?line true = lists:member(?MODULE, int:interpreted()), + Config. -cases() -> - [bound_var, bound_tail, t_float, little_float, sean]. +end_per_suite(Config) when is_list(Config) -> + ok. init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), @@ -55,16 +65,8 @@ end_per_testcase(_Case, Config) -> ?t:timetrap_cancel(Dog), ok. -init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), - Config. - -end_per_suite(Config) when is_list(Config) -> - ok. - bound_var(doc) -> "Test matching of bound variables."; -bound_var(Config) when list(Config) -> +bound_var(Config) when is_list(Config) -> ?line ok = bound_var(42, 13, <<42,13>>), ?line nope = bound_var(42, 13, <<42,255>>), ?line nope = bound_var(42, 13, <<154,255>>), @@ -74,7 +76,7 @@ bound_var(A, B, <<A:8,B:8>>) -> ok; bound_var(_, _, _) -> nope. bound_tail(doc) -> "Test matching of a bound tail."; -bound_tail(Config) when list(Config) -> +bound_tail(Config) when is_list(Config) -> ?line ok = bound_tail(<<>>, <<13,14>>), ?line ok = bound_tail(<<2,3>>, <<1,1,2,3>>), ?line nope = bound_tail(<<2,3>>, <<1,1,2,7>>), @@ -85,7 +87,7 @@ bound_tail(Config) when list(Config) -> bound_tail(T, <<_:16,T/binary>>) -> ok; bound_tail(_, _) -> nope. -t_float(Config) when list(Config) -> +t_float(Config) when is_list(Config) -> F = f1(), G = f_one(), @@ -98,6 +100,10 @@ t_float(Config) when list(Config) -> ?line fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), ?line fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)), ?line fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), + + ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16, 0)), + ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16#7fffffff, 0)), + ok. @@ -110,7 +116,7 @@ match_float(Bin0, Fsz, I) -> <<_:I,F:Fsz/float,_:Tsz>> = Bin, F. -little_float(Config) when list(Config) -> +little_float(Config) when is_list(Config) -> F = f2(), G = f_one(), @@ -149,7 +155,7 @@ f2() -> f_one() -> 1.0. -sean(Config) when list(Config) -> +sean(Config) when is_list(Config) -> ?line small = sean1(<<>>), ?line small = sean1(<<1>>), ?line small = sean1(<<1,2>>), @@ -162,5 +168,414 @@ sean(Config) when list(Config) -> ?line {'EXIT',{function_clause,_}} = (catch sean1(<<4,5,6,7>>)), ok. -sean1(<<B/binary>>) when size(B) < 4 -> small; +sean1(<<B/binary>>) when byte_size(B) < 4 -> small; sean1(<<1, _B/binary>>) -> large. + +kenneth(Config) when is_list(Config) -> + {ok,[145,148,113,129,0,0,0,0]} = + msisdn_internal_storage(<<145,148,113,129,0,0,0,0>>, []). + +msisdn_internal_storage(<<>>,MSISDN) -> + {ok,lists:reverse(MSISDN)}; +msisdn_internal_storage(<<2#11111111:8,_Rest/binary>>,MSISDN) -> + {ok,lists:reverse(MSISDN)}; +msisdn_internal_storage(<<2#1111:4,DigitN:4,_Rest/binary>>,MSISDN) when + DigitN < 10 -> + {ok,lists:reverse([(DigitN bor 2#11110000)|MSISDN])}; +msisdn_internal_storage(<<DigitNplus1:4,DigitN:4,Rest/binary>>,MSISDN) when + DigitNplus1 < 10, + DigitN < 10 -> + NewMSISDN=[((DigitNplus1 bsl 4) bor DigitN)|MSISDN], + msisdn_internal_storage(Rest,NewMSISDN); +msisdn_internal_storage(_Rest,_MSISDN) -> + {fault}. %% Mandatory IE incorrect + +encode_binary(Config) when is_list(Config) -> + "C2J2QiSc" = encodeBinary(<<11,98,118,66,36,156>>, []), + ok. + +encodeBinary(<<>>, Output) -> + lists:reverse(Output); +encodeBinary(<<Data:1/binary>>, Output) -> + <<DChar1:6, DChar2:2>> = Data, + Char1 = getBase64Char(DChar1), + Char2 = getBase64Char(DChar2), + Char3 = "=", + Char4 = "=", + NewOutput = Char4 ++ Char3 ++ Char2 ++ Char1 ++ Output, + encodeBinary(<<>>, NewOutput); +encodeBinary(<<Data:2/binary>>, Output) -> + <<DChar1:6, DChar2:6, DChar3:4>> = Data, + Char1 = getBase64Char(DChar1), + Char2 = getBase64Char(DChar2), + Char3 = getBase64Char(DChar3), + Char4 = "=", + NewOutput = Char4 ++ Char3 ++ Char2 ++ Char1 ++ Output, + encodeBinary(<<>>, NewOutput); +encodeBinary(<<Data:3/binary, Rest/binary>>, Output) -> + <<DChar1:6, DChar2:6, DChar3:6, DChar4:6>> = Data, + Char1 = getBase64Char(DChar1), + Char2 = getBase64Char(DChar2), + Char3 = getBase64Char(DChar3), + Char4 = getBase64Char(DChar4), + NewOutput = Char4 ++ Char3 ++ Char2 ++ Char1 ++ Output, + encodeBinary(Rest, NewOutput); +encodeBinary(_Data, _) -> + error. + +getBase64Char(0) -> "A"; +getBase64Char(1) -> "B"; +getBase64Char(2) -> "C"; +getBase64Char(3) -> "D"; +getBase64Char(4) -> "E"; +getBase64Char(5) -> "F"; +getBase64Char(6) -> "G"; +getBase64Char(7) -> "H"; +getBase64Char(8) -> "I"; +getBase64Char(9) -> "J"; +getBase64Char(10) -> "K"; +getBase64Char(11) -> "L"; +getBase64Char(12) -> "M"; +getBase64Char(13) -> "N"; +getBase64Char(14) -> "O"; +getBase64Char(15) -> "P"; +getBase64Char(16) -> "Q"; +getBase64Char(17) -> "R"; +getBase64Char(18) -> "S"; +getBase64Char(19) -> "T"; +getBase64Char(20) -> "U"; +getBase64Char(21) -> "V"; +getBase64Char(22) -> "W"; +getBase64Char(23) -> "X"; +getBase64Char(24) -> "Y"; +getBase64Char(25) -> "Z"; +getBase64Char(26) -> "a"; +getBase64Char(27) -> "b"; +getBase64Char(28) -> "c"; +getBase64Char(29) -> "d"; +getBase64Char(30) -> "e"; +getBase64Char(31) -> "f"; +getBase64Char(32) -> "g"; +getBase64Char(33) -> "h"; +getBase64Char(34) -> "i"; +getBase64Char(35) -> "j"; +getBase64Char(36) -> "k"; +getBase64Char(37) -> "l"; +getBase64Char(38) -> "m"; +getBase64Char(39) -> "n"; +getBase64Char(40) -> "o"; +getBase64Char(41) -> "p"; +getBase64Char(42) -> "q"; +getBase64Char(43) -> "r"; +getBase64Char(44) -> "s"; +getBase64Char(45) -> "t"; +getBase64Char(46) -> "u"; +getBase64Char(47) -> "v"; +getBase64Char(48) -> "w"; +getBase64Char(49) -> "x"; +getBase64Char(50) -> "y"; +getBase64Char(51) -> "z"; +getBase64Char(52) -> "0"; +getBase64Char(53) -> "1"; +getBase64Char(54) -> "2"; +getBase64Char(55) -> "3"; +getBase64Char(56) -> "4"; +getBase64Char(57) -> "5"; +getBase64Char(58) -> "6"; +getBase64Char(59) -> "7"; +getBase64Char(60) -> "8"; +getBase64Char(61) -> "9"; +getBase64Char(62) -> "+"; +getBase64Char(63) -> "/"; +getBase64Char(_Else) -> + %% This is an illegal input. +% cgLogEM:log(error, ?MODULE, getBase64Char, [Else], +% "illegal input", +% ?LINE, version()), + "**". + +-define(M(F), <<F>> = <<F>>). + +native(Config) when is_list(Config) -> + ?line ?M(3.14:64/native-float), + ?line ?M(333:16/native), + ?line ?M(38658345:32/native), + case <<1:16/native>> of + <<0,1>> -> native_big(); + <<1,0>> -> native_little() + end. + +native_big() -> + ?line <<37.33:64/native-float>> = <<37.33:64/big-float>>, + ?line <<3974:16/native-integer>> = <<3974:16/big-integer>>, + {comment,"Big endian"}. + +native_little() -> + ?line <<37869.32343:64/native-float>> = <<37869.32343:64/little-float>>, + ?line <<7974:16/native-integer>> = <<7974:16/little-integer>>, + {comment,"Little endian"}. + +happi(Config) when is_list(Config) -> + Bin = <<".123">>, + ?line <<"123">> = lex_digits1(Bin, 1, []), + ?line <<"123">> = lex_digits2(Bin, 1, []), + ok. + +lex_digits1(<<$., Rest/binary>>,_Val,_Acc) -> + Rest; +lex_digits1(<<N, Rest/binary>>,Val, Acc) when N >= $0 , N =< $9 -> + lex_digits1(Rest,Val*10+dec(N),Acc); +lex_digits1(_Other,_Val,_Acc) -> + not_ok. + +lex_digits2(<<N, Rest/binary>>,Val, Acc) when N >= $0 , N =< $9 -> + lex_digits2(Rest,Val*10+dec(N),Acc); +lex_digits2(<<$., Rest/binary>>,_Val,_Acc) -> + Rest; +lex_digits2(_Other,_Val,_Acc) -> + not_ok. + +dec(A) -> + A-$0. + +size_var(Config) when is_list(Config) -> + ?line {<<45>>,<<>>} = split(<<1:16,45>>), + ?line {<<45>>,<<46,47>>} = split(<<1:16,45,46,47>>), + ?line {<<45,46>>,<<47>>} = split(<<2:16,45,46,47>>), + + ?line {<<45,46,47>>,<<48>>} = split_2(<<16:8,3:16,45,46,47,48>>), + + ?line {<<45,46>>,<<47>>} = split(2, <<2:16,45,46,47>>), + ?line {'EXIT',{function_clause,_}} = (catch split(42, <<2:16,45,46,47>>)), + + ?line <<"cdef">> = skip(<<2:8,"abcdef">>), + + ok. + +split(<<N:16,B:N/binary,T/binary>>) -> + {B,T}. + +split(N, <<N:16,B:N/binary,T/binary>>) -> + {B,T}. + +split_2(<<N0:8,N:N0,B:N/binary,T/binary>>) -> + {B,T}. + +skip(<<N:8,_:N/binary,T/binary>>) -> T. + +wiger(Config) when is_list(Config) -> + ?line ok1 = wcheck(<<3>>), + ?line ok2 = wcheck(<<1,2,3>>), + ?line ok3 = wcheck(<<4>>), + ?line {error,<<1,2,3,4>>} = wcheck(<<1,2,3,4>>), + ?line {error,<<>>} = wcheck(<<>>), + ok. + +wcheck(<<A>>) when A==3-> + ok1; +wcheck(<<_,_:2/binary>>) -> + ok2; +wcheck(<<_>>) -> + ok3; +wcheck(Other) -> + {error,Other}. + +%% Test that having the match context in x(0) works. + +x0_context(Config) when is_list(Config) -> + x0_0([], <<3.0:64/float,42:16,123456:32>>). + +x0_0(_, Bin) -> + <<3.0:64/float,42:16,_/binary>> = Bin, + x0_1([], Bin, 64, 16, 2). + +x0_1(_, Bin, FloatSz, IntSz, BinSz) -> + <<_:FloatSz/float,42:IntSz,B:BinSz/binary,C:1/binary,D/binary>> = Bin, + id({B,C,D}), + <<_:FloatSz/float,42:IntSz,B:BinSz/binary,_/binary>> = Bin, + x0_2([], Bin). + +x0_2(_, Bin) -> + <<_:64,0:7,42:9,_/binary>> = Bin, + x0_3([], Bin). + +x0_3(_, Bin) -> + case Bin of + <<_:72,7:8,_/binary>> -> + ?line ?t:fail(); + <<_:64,0:16,_/binary>> -> + ?line ?t:fail(); + <<_:64,42:16,123456:32,_/binary>> -> + ok + end. + + +huge_float_field(Config) when is_list(Config) -> + Sz = 1 bsl 27, + ?line Bin = <<0:Sz>>, + + ?line nomatch = overflow_huge_float_skip_32(Bin), + ?line nomatch = overflow_huge_float_32(Bin), + + ?line ok = overflow_huge_float(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ?line ok = overflow_huge_float_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok. + +overflow_huge_float_skip_32(<<_:4294967296/float,0,_/binary>>) -> 1; % 1 bsl 32 +overflow_huge_float_skip_32(<<_:33554432/float-unit:128,0,_/binary>>) -> 2; % 1 bsl 25 +overflow_huge_float_skip_32(<<_:67108864/float-unit:64,0,_/binary>>) -> 3; % 1 bsl 26 +overflow_huge_float_skip_32(<<_:134217728/float-unit:32,0,_/binary>>) -> 4; % 1 bsl 27 +overflow_huge_float_skip_32(<<_:268435456/float-unit:16,0,_/binary>>) -> 5; % 1 bsl 28 +overflow_huge_float_skip_32(<<_:536870912/float-unit:8,0,_/binary>>) -> 6; % 1 bsl 29 +overflow_huge_float_skip_32(<<_:1073741824/float-unit:8,0,_/binary>>) -> 7; % 1 bsl 30 +overflow_huge_float_skip_32(<<_:2147483648/float-unit:8,0,_/binary>>) -> 8; % 1 bsl 31 +overflow_huge_float_skip_32(_) -> nomatch. + +overflow_huge_float_32(<<F:4294967296/float,_/binary>>) -> {1,F}; % 1 bsl 32 +overflow_huge_float_32(<<F:33554432/float-unit:128,0,_/binary>>) -> {2,F}; % 1 bsl 25 +overflow_huge_float_32(<<F:67108864/float-unit:128,0,_/binary>>) -> {3,F}; % 1 bsl 26 +overflow_huge_float_32(<<F:134217728/float-unit:128,0,_/binary>>) -> {4,F}; % 1 bsl 27 +overflow_huge_float_32(<<F:268435456/float-unit:128,0,_/binary>>) -> {5,F}; % 1 bsl 28 +overflow_huge_float_32(<<F:536870912/float-unit:128,0,_/binary>>) -> {6,F}; % 1 bsl 29 +overflow_huge_float_32(<<F:1073741824/float-unit:128,0,_/binary>>) -> {7,F}; % 1 bsl 30 +overflow_huge_float_32(<<F:2147483648/float-unit:128,0,_/binary>>) -> {8,F}; % 1 bsl 31 +overflow_huge_float_32(_) -> nomatch. + + +overflow_huge_float(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/float-unit:8,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <<Var:Sz/float-unit:8,0,_/binary>> -> + {error,Sz,Var}; + _ -> + overflow_huge_float(Bin, Sizes) + end + end; +overflow_huge_float(_, []) -> ok. + +overflow_huge_float_unit128(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/float-unit:128,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <<Var:Sz/float-unit:128,0,_/binary>> -> + {error,Sz,Var}; + _ -> + overflow_huge_float_unit128(Bin, Sizes) + end + end; +overflow_huge_float_unit128(_, []) -> ok. + + +%% +%% Test that a writable binary can be safely matched. +%% + +writable_binary_matched(Config) when is_list(Config) -> + ?line WritableBin = create_writeable_binary(), + ?line writable_binary_matched(WritableBin, WritableBin, 500). + +writable_binary_matched(<<0>>, _, N) -> + if + N =:= 0 -> ok; + true -> + put(grow_heap, [N|get(grow_heap)]), + ?line WritableBin = create_writeable_binary(), + ?line writable_binary_matched(WritableBin, WritableBin, N-1) + end; +writable_binary_matched(<<B:8,T/binary>>, WritableBin0, N) -> + ?line WritableBin = writable_binary(WritableBin0, B), + writable_binary_matched(T, WritableBin, N). + +writable_binary(WritableBin0, B) when is_binary(WritableBin0) -> + %% Heavy append to force the binary to move. + ?line WritableBin = <<WritableBin0/binary,0:(size(WritableBin0))/unit:8,B>>, + ?line id(<<(id(0)):128/unit:8>>), + WritableBin. + +create_writeable_binary() -> + <<(id(<<>>))/binary,1,2,3,4,5,6,0>>. + +otp_7198(Config) when is_list(Config) -> + %% When a match context was reused, and grown at the same time to + %% increase the number of saved positions, the thing word was not updated + %% to account for the new size. Therefore, if there was a garbage collection, + %% the new slots would be included in the garbage collection. + ?line [do_otp_7198(FillerSize) || FillerSize <- lists:seq(0, 256)], + ok. + +do_otp_7198(FillerSize) -> + Filler = erlang:make_tuple(FillerSize, 42), + {Pid,Ref} = spawn_monitor(fun() -> do_otp_7198_test(Filler) end), + receive + {'DOWN',Ref,process,Pid,normal} -> + ok; + {'DOWN',Ref,process,Pid,Reason} -> + io:format("unexpected: ~p", [Reason]), + ?line ?t:fail() + end. + +do_otp_7198_test(_) -> + [{'KEYWORD',114}, + {'KEYWORD',101}, + {'KEYWORD',103}, + {'KEYWORD',105}, + {'KEYWORD',111}, + {'FIELD',110}, + {'KEYWORD',119}, + {'KEYWORD',104}, + {'KEYWORD',97}, + {'KEYWORD',116}, + {'KEYWORD',101}, + {'KEYWORD',118}, + {'KEYWORD',101}, + {'KEYWORD',114}, + '$thats_all_folks$'] = otp_7198_scan(<<"region:whatever">>, []). + + +otp_7198_scan(<<>>, TokAcc) -> + lists:reverse(['$thats_all_folks$' | TokAcc]); + +otp_7198_scan(<<D, Z, Rest/binary>>, TokAcc) when + (D =:= $D orelse D =:= $d) and + ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> + otp_7198_scan(<<Z, Rest/binary>>, ['AND' | TokAcc]); + +otp_7198_scan(<<D>>, TokAcc) when + (D =:= $D) or (D =:= $d) -> + otp_7198_scan(<<>>, ['AND' | TokAcc]); + +otp_7198_scan(<<N, Z, Rest/binary>>, TokAcc) when + (N =:= $N orelse N =:= $n) and + ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> + otp_7198_scan(<<Z, Rest/binary>>, ['NOT' | TokAcc]); + +otp_7198_scan(<<C, Rest/binary>>, TokAcc) when + (C >= $A) and (C =< $Z); + (C >= $a) and (C =< $z); + (C >= $0) and (C =< $9) -> + case Rest of + <<$:, R/binary>> -> + otp_7198_scan(R, [{'FIELD', C} | TokAcc]); + _ -> + otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc]) + end. + +unordered_bindings(Config) when is_list(Config) -> + {<<1,2,3,4>>,<<42,42>>,<<3,3,3>>} = + unordered_bindings(4, 2, 3, <<1,2,3,4, 42,42, 3,3,3, 3>>), + ok. + +unordered_bindings(CompressedLength, HashSize, PadLength, T) -> + <<Content:CompressedLength/binary,Mac:HashSize/binary, + Padding:PadLength/binary,PadLength>> = T, + {Content,Mac,Padding}. + + +id(I) -> I. diff --git a/lib/debugger/test/bs_match_tail_SUITE.erl b/lib/debugger/test/bs_match_tail_SUITE.erl index 961ccbb599..9f7519cf3a 100644 --- a/lib/debugger/test/bs_match_tail_SUITE.erl +++ b/lib/debugger/test/bs_match_tail_SUITE.erl @@ -64,7 +64,7 @@ end_per_suite(Config) when is_list(Config) -> ok. aligned(doc) -> "Test aligned tails."; -aligned(Config) when list(Config) -> +aligned(Config) when is_list(Config) -> ?line Tail1 = mkbin([]), ?line {258,Tail1} = al_get_tail_used(mkbin([1,2])), ?line Tail2 = mkbin(lists:seq(1, 127)), @@ -84,10 +84,10 @@ aligned(Config) when list(Config) -> ok. al_get_tail_used(<<A:16,T/binary>>) -> {A,T}. -al_get_tail_unused(<<A:16,_T/binary>>) -> A. +al_get_tail_unused(<<A:16,_/binary>>) -> A. unaligned(doc) -> "Test that an non-aligned tail cannot be matched out."; -unaligned(Config) when list(Config) -> +unaligned(Config) when is_list(Config) -> ?line {'EXIT',{function_clause,_}} = (catch get_tail_used(mkbin([42]))), ?line {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_used(mkbin([137]), 3)), ?line {'EXIT',{function_clause,_}} = (catch get_tail_unused(mkbin([42,33]))), @@ -103,11 +103,11 @@ get_dyn_tail_used(Bin, Sz) -> {A,T}. get_dyn_tail_unused(Bin, Sz) -> - <<A:Sz,_T/binary>> = Bin, + <<A:Sz,_/binary>> = Bin, A. zero_tail(doc) -> "Test that zero tails are tested correctly."; -zero_tail(Config) when list(Config) -> +zero_tail(Config) when is_list(Config) -> ?line 7 = (catch test_zero_tail(mkbin([7]))), ?line {'EXIT',{function_clause,_}} = (catch test_zero_tail(mkbin([1,2]))), ?line {'EXIT',{function_clause,_}} = (catch test_zero_tail2(mkbin([1,2,3]))), @@ -117,4 +117,4 @@ test_zero_tail(<<A:8>>) -> A. test_zero_tail2(<<_A:4,_B:4>>) -> ok. -mkbin(L) when list(L) -> list_to_binary(L). +mkbin(L) when is_list(L) -> list_to_binary(L). diff --git a/lib/debugger/test/bug_SUITE.erl b/lib/debugger/test/bug_SUITE.erl index a831897dfb..1a7e876329 100644 --- a/lib/debugger/test/bug_SUITE.erl +++ b/lib/debugger/test/bug_SUITE.erl @@ -51,7 +51,7 @@ end_per_group(_GroupName, Config) -> otp2163(doc) -> ["BIF exit reason"]; otp2163(suite) -> []; -otp2163(Config) when list(Config) -> +otp2163(Config) when is_list(Config) -> ?line DataDir = ?config(data_dir, Config), %% First compile and get the expected results: @@ -74,7 +74,7 @@ otp2163(Config) when list(Config) -> otp4845(doc) -> ["BIF not loading and not bug compatible, OTP-4845 OTP-4859"]; otp4845(suite) -> []; -otp4845(Config) when list(Config) -> +otp4845(Config) when is_list(Config) -> ?line DataDir = ?config(data_dir, Config), %% First compile and get the expected results: diff --git a/lib/debugger/test/exception_SUITE.erl b/lib/debugger/test/exception_SUITE.erl index 8c864e4b5f..86554ab2d4 100644 --- a/lib/debugger/test/exception_SUITE.erl +++ b/lib/debugger/test/exception_SUITE.erl @@ -23,7 +23,8 @@ -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, - badmatch/1,pending_errors/1,nil_arith/1]). + badmatch/1,pending_errors/1,nil_arith/1, + stacktrace/1,nested_stacktrace/1,raise/1,gunilla/1,per/1]). -export([bad_guy/2]). @@ -31,6 +32,19 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. +%% Filler. +%% +%% +%% +%% +%% This is line 40. +even(N) when is_integer(N), N > 1, (N rem 2) == 0 -> + odd(N-1)++[N]. + +odd(N) when is_integer(N), N > 1, (N rem 2) == 1 -> + even(N-1)++[N]. + + all() -> cases(). @@ -45,7 +59,8 @@ end_per_group(_GroupName, Config) -> cases() -> - [badmatch, pending_errors, nil_arith]. + [badmatch, pending_errors, nil_arith, stacktrace, + nested_stacktrace, raise, gunilla, per]. -define(try_match(E), catch ?MODULE:bar(), @@ -69,9 +84,9 @@ init_per_suite(Config) when is_list(Config) -> end_per_suite(Config) when is_list(Config) -> ok. -badmatch(doc) -> "Test that deliberately bad matches are reported correctly."; -badmatch(suite) -> []; -badmatch(Config) when list(Config) -> +%% Test that deliberately bad matches are reported correctly. + +badmatch(Config) when is_list(Config) -> ?line ?try_match(a), ?line ?try_match(42), ?line ?try_match({a, b, c}), @@ -79,11 +94,9 @@ badmatch(Config) when list(Config) -> ?line ?try_match(1.0), ok. -pending_errors(doc) -> - ["Test various exceptions, in the presence of a previous error suppressed ", - "in a guard."]; -pending_errors(suite) -> []; -pending_errors(Config) when list(Config) -> +%% Test various exceptions, in the presence of a previous error suppressed +%% in a guard. +pending_errors(Config) when is_list(Config) -> ?line pending(e_badmatch, {badmatch, b}), ?line pending(x, function_clause), ?line pending(e_case, {case_clause, xxx}), @@ -100,7 +113,7 @@ bad_guy(pe_badarith, Other) when Other+1 == 0 -> % badarith (suppressed) bad_guy(pe_badarg, Other) when length(Other) > 0 -> % badarg (suppressed) ok; bad_guy(_, e_case) -> - case xxx of + case id(xxx) of ok -> ok end; % case_clause bad_guy(_, e_if) -> @@ -121,7 +134,7 @@ bad_guy(_, e_badarg) -> bad_guy(_, e_badarg_spawn) -> spawn({}, {}, {}); % badarg bad_guy(_, e_badmatch) -> - a = b. % badmatch + a = id(b). % badmatch pending(Arg, Expected) -> pending(pe_badarith, Arg, Expected), @@ -155,28 +168,23 @@ pending_exit_message(Args, Expected) -> end, process_flag(trap_exit, false). -pending({badarg,[{erlang,Bif,BifArgs},{?MODULE,Func,Arity}|_]}, Func, Args, _Code) - when atom(Bif), list(BifArgs), length(Args) == Arity -> %Threaded code. - ok; -pending({badarg,[{erlang,Bif,BifArgs},{?MODULE,Func,Args}|_]}, Func, Args, _Code) - when atom(Bif), list(BifArgs) -> %From interpreted code. +pending({badarg, [{erlang,Bif,BifArgs,_},{?MODULE,Func,Arity,_}|_]}, + Func, Args, _Code) + when is_atom(Bif), is_list(BifArgs), length(Args) == Arity -> ok; -pending({undef,[{non_existing_module,foo,[]}|_]}, _, _, _) -> +pending({undef,[{non_existing_module,foo,[],_}|_]}, _, _, _) -> ok; -pending({function_clause,[{?MODULE,Func,Args}|_]}, Func, Args, _Code) -> +pending({function_clause,[{?MODULE,Func,Args,_}|_]}, Func, Args, _Code) -> ok; -pending({Code,[{?MODULE,Func,Arity}|_]}, Func, Args, Code) when length(Args) == Arity -> %Threaded code +pending({Code,[{?MODULE,Func,Arity,_}|_]}, Func, Args, Code) + when length(Args) == Arity -> ok; -pending({Code,[{?MODULE,Func,Args}|_]}, Func, Args, Code) -> %From interpreted code. - ok; -pending(Reason, Func, Args, Code) -> - test_server:fail({bad_exit_reason,Reason,{Func,Args,Code}}). - -nil_arith(doc) -> - "Test that doing arithmetics on [] gives a badarith EXIT and not a crash."; -nil_arith(suite) -> - []; -nil_arith(Config) when list(Config) -> +pending(Reason, _Function, _Args, _Code) -> + test_server:fail({bad_exit_reason,Reason}). + +%% Test that doing arithmetics on [] gives a badarith EXIT and not a crash. + +nil_arith(Config) when is_list(Config) -> ?line ba_plus_minus_times([], []), ?line ba_plus_minus_times([], 0), @@ -268,3 +276,199 @@ ba_shift(A, B) -> ba_bnot(A) -> io:format("bnot ~p", [A]), {'EXIT', {badarith, _}} = (catch bnot A). + +stacktrace(Conf) when is_list(Conf) -> + Tag = make_ref(), + ?line {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end), + ?line {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end, + V = [make_ref()|self()], + ?line {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} = + stacktrace_1({'abs',V}, error, {value,V}), + ?line St1 = erase(stacktrace1), + ?line St1 = erase(stacktrace2), + ?line St1 = erlang:get_stacktrace(), + ?line {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} = + stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}), + ?line [{?MODULE,my_div,2,_}|_] = erase(stacktrace1), + ?line St2 = erase(stacktrace2), + ?line St2 = erlang:get_stacktrace(), + ?line {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} = + stacktrace_1({value,V}, error, {value,V}), + ?line St3 = erase(stacktrace1), + ?line St3 = erase(stacktrace2), + ?line St3 = erlang:get_stacktrace(), + ?line {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} = + stacktrace_1({value,V}, error, {throw,V}), + ?line [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1), + ?line St4 = erase(stacktrace2), + ?line St4 = erlang:get_stacktrace(), + ok. + +stacktrace_1(X, C1, Y) -> + erase(stacktrace1), + erase(stacktrace2), + try try foo(X) of + C1 -> value1 + catch + C1:D1 -> {caught1,D1,erlang:get_stacktrace()} + after + put(stacktrace1, erlang:get_stacktrace()), + foo(Y) + end of + V2 -> {value2,V2} + catch + C2:D2 -> {caught2,{C2,D2},erlang:get_stacktrace()} + after + put(stacktrace2, erlang:get_stacktrace()) + end. + + + +nested_stacktrace(Conf) when is_list(Conf) -> + V = [{make_ref()}|[self()]], + ?line value1 = + nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, + {void,void,void}), + ?line {caught1, + [{?MODULE,my_add,2,_}|_], + value2, + [{?MODULE,my_add,2,_}|_]} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{value,{V,x2}},void,{V,x2}}), + ?line {caught1, + [{?MODULE,my_add,2,_}|_], + {caught2,[{erlang,abs,[V],_}|_]}, + [{erlang,abs,[V],_}|_]} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{'abs',V},error,badarg}), + ok. + +nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> + try foo(X1) of + V1 -> value1 + catch + C1:V1 -> + S1 = erlang:get_stacktrace(), + T2 = + try foo(X2) of + V2 -> value2 + catch + C2:V2 -> {caught2,erlang:get_stacktrace()} + end, + {caught1,S1,T2,erlang:get_stacktrace()} + end. + + + +raise(Conf) when is_list(Conf) -> + ?line erase(raise), + ?line A = + try + ?line try foo({'div',{1,0}}) + catch + error:badarith -> + put(raise, A0 = erlang:get_stacktrace()), + ?line erlang:raise(error, badarith, A0) + end + catch + error:badarith -> + ?line A1 = erlang:get_stacktrace(), + ?line A1 = get(raise) + end, + ?line A = erlang:get_stacktrace(), + ?line A = get(raise), + ?line [{?MODULE,my_div,2,_}|_] = A, + %% + N = 8, % Must be even + ?line N = erlang:system_flag(backtrace_depth, N), + ?line try even(N) + catch error:function_clause -> ok + end, + ?line B = odd_even(N, []), + ?line B = erlang:get_stacktrace(), + %% + ?line C0 = odd_even(N+1, []), + ?line C = lists:sublist(C0, N), + ?line try odd(N+1) + catch error:function_clause -> ok + end, + ?line C = erlang:get_stacktrace(), + ?line try erlang:raise(error, function_clause, C0) + catch error:function_clause -> ok + end, + ?line C = erlang:get_stacktrace(), + ok. + +odd_even(N, R) when is_integer(N), N > 1 -> + odd_even(N-1, + [if (N rem 2) == 0 -> + {?MODULE,even,1,[{file,?MODULE_STRING++".erl"}, + {line,42}]}; + true -> + {?MODULE,odd,1,[{file,?MODULE_STRING++".erl"}, + {line,45}]} + end|R]); +odd_even(1, R) -> + [{?MODULE,odd,[1],[{file,?MODULE_STRING++".erl"}, + {line,44}]}|R]. + +foo({value,Value}) -> Value; +foo({'div',{A,B}}) -> + my_div(A, B); +foo({'add',{A,B}}) -> + my_add(A, B); +foo({'abs',X}) -> + my_abs(X); +foo({error,Error}) -> + erlang:error(Error); +foo({throw,Throw}) -> + erlang:throw(Throw); +foo({exit,Exit}) -> + erlang:exit(Exit); +foo({raise,{Class,Reason,Stacktrace}}) -> + erlang:raise(Class, Reason, Stacktrace). +%%foo(function_clause) -> % must not be defined! + +my_div(A, B) -> + A div B. + +my_add(A, B) -> + A + B. + +my_abs(X) -> abs(X). + +gunilla(Config) when is_list(Config) -> + ?line {throw,kalle} = gunilla_1(), + ?line [] = erlang:get_stacktrace(), + ok. + +gunilla_1() -> + try try arne() + after + pelle + end + catch + C:R -> + {C,R} + end. + +arne() -> + %% Empty stack trace used to cause change the error class to 'error'. + erlang:raise(throw, kalle, []). + +per(Config) when is_list(Config) -> + try + t1(0,pad,0), + t2(0,pad,0) + catch + error:badarith -> + ok + end. + +t1(_,X,_) -> + (1 bsl X) + 1. + +t2(_,X,_) -> + (X bsl 1) + 1. + +id(I) -> I. diff --git a/lib/debugger/test/fun_SUITE.erl b/lib/debugger/test/fun_SUITE.erl index 8103d9c692..a06cdc7165 100644 --- a/lib/debugger/test/fun_SUITE.erl +++ b/lib/debugger/test/fun_SUITE.erl @@ -24,8 +24,10 @@ init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, good_call/1,bad_apply/1,bad_fun_call/1,badarity/1, - ext_badarity/1,otp_6061/1]). --export([nothing/0]). + ext_badarity/1,otp_6061/1,external/1]). + +%% Internal exports. +-export([nothing/0,call_me/1]). -include_lib("test_server/include/test_server.hrl"). @@ -46,7 +48,7 @@ end_per_group(_GroupName, Config) -> cases() -> [good_call, bad_apply, bad_fun_call, badarity, - ext_badarity, otp_6061]. + ext_badarity, otp_6061, external]. init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), @@ -244,3 +246,47 @@ test_otp_6061(Starter) -> fun() -> Starter ! working end, fun() -> Starter ! not_working end], lists:foreach(fun(P)->(lists:nth(P,PassesF))() end,Passes). + +-define(APPLY(M, F, A), (fun(Fun) -> {ok,{a,b}} = Fun({a,b}) end)(fun M:F/A)). +-define(APPLY2(M, F, A), + (fun(Map) -> + Id = fun(I) -> I end, + List = [x,y], + List = Map(Id, List), + {type,external} = erlang:fun_info(Map, type) + end)(fun M:F/A)). + +external(Config) when is_list(Config) -> + Mod = id(?MODULE), + Func = id(call_me), + Arity = id(1), + + ?APPLY(?MODULE, call_me, 1), + ?APPLY(?MODULE, call_me, Arity), + ?APPLY(?MODULE, Func, 1), + ?APPLY(?MODULE, Func, Arity), + ?APPLY(Mod, call_me, 1), + ?APPLY(Mod, call_me, Arity), + ?APPLY(Mod, Func, 1), + ?APPLY(Mod, Func, Arity), + + ListsMod = id(lists), + ListsMap = id(map), + ListsArity = id(2), + + ?APPLY2(lists, map, 2), + ?APPLY2(lists, map, ListsArity), + ?APPLY2(lists, ListsMap, 2), + ?APPLY2(lists, ListsMap, ListsArity), + ?APPLY2(ListsMod, map, 2), + ?APPLY2(ListsMod, map, ListsArity), + ?APPLY2(ListsMod, ListsMap, 2), + ?APPLY2(ListsMod, ListsMap, ListsArity), + + ok. + +call_me(I) -> + {ok,I}. + +id(I) -> + I. diff --git a/lib/debugger/test/guard_SUITE.erl b/lib/debugger/test/guard_SUITE.erl index 611dcb4dff..bf5fa82749 100644 --- a/lib/debugger/test/guard_SUITE.erl +++ b/lib/debugger/test/guard_SUITE.erl @@ -35,7 +35,8 @@ t_is_boolean/1,is_function_2/1, tricky/1,rel_ops/1, basic_andalso_orelse/1,traverse_dcd/1, - check_qlc_hrl/1]). + check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, + bad_constants/1]). -include_lib("test_server/include/test_server.hrl"). @@ -65,7 +66,8 @@ cases() -> xor_guard, more_xor_guards, build_in_guard, old_guard_tests, gbif, t_is_boolean, is_function_2, tricky, rel_ops, basic_andalso_orelse, traverse_dcd, - check_qlc_hrl]. + check_qlc_hrl, andalso_semi, t_tuple_size, binary_part, + bad_constants]. init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), @@ -294,9 +296,7 @@ try_gbif(Id, X, Y) -> try_fail_gbif(Id, X, Y) -> case catch guard_bif(Id, X, Y) of - {'EXIT', {function_clause,{?MODULE,guard_bif,[Id,X,Y]}}} -> %Jam - io:format("guard_bif(~p, ~p, ~p) -- ok", [Id,X,Y]); - {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y]}|_]}} -> %Beam + {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y],_}|_]}} -> io:format("guard_bif(~p, ~p, ~p) -- ok", [Id,X,Y]); Other -> ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", @@ -367,9 +367,8 @@ type_tests(Test, [Type|T], Allowed) -> end; false -> case catch type_test(Test, Value) of - {'EXIT', {function_clause, {?MODULE, type_test, [Test, Value]}}} -> - ok; - {'EXIT', {function_clause,[{?MODULE,type_test,[Test,Value]}|_]}} -> + {'EXIT',{function_clause, + [{?MODULE,type_test,[Test,Value],_}|_]}} -> ok; {'EXIT',Other} -> ?line test_server:fail({unexpected_error_reason,Other}); @@ -1477,7 +1476,207 @@ cqlc(M, F, As, St) -> St end. +%% OTP-7679: Thanks to Hunter Morris. +andalso_semi(Config) when is_list(Config) -> + ?line ok = andalso_semi_foo(0), + ?line ok = andalso_semi_foo(1), + ?line fc(catch andalso_semi_foo(2)), + + ?line ok = andalso_semi_bar([a,b,c]), + ?line ok = andalso_semi_bar(1), + ?line fc(catch andalso_semi_bar([a,b])), + ok. + +andalso_semi_foo(Bar) when is_integer(Bar) andalso Bar =:= 0; Bar =:= 1 -> + ok. + +andalso_semi_bar(Bar) when is_list(Bar) andalso length(Bar) =:= 3; Bar =:= 1 -> + ok. + + +t_tuple_size(Config) when is_list(Config) -> + ?line 10 = do_tuple_size({1,2,3,4}), + ?line fc(catch do_tuple_size({1,2,3})), + ?line fc(catch do_tuple_size(42)), + ?line error = ludicrous_tuple_size({a,b,c}), + ?line error = ludicrous_tuple_size([a,b,c]), + + ok. + +do_tuple_size(T) when tuple_size(T) =:= 4 -> + {A,B,C,D} = T, + A+B+C+D. + +ludicrous_tuple_size(T) + when tuple_size(T) =:= 16#7777777777777777777777777777777777 -> ok; +ludicrous_tuple_size(T) + when tuple_size(T) =:= 16#10000000000000000 -> ok; +ludicrous_tuple_size(T) + when tuple_size(T) =:= (1 bsl 64) - 1 -> ok; +ludicrous_tuple_size(T) + when tuple_size(T) =:= 16#FFFFFFFFFFFFFFFF -> ok; +ludicrous_tuple_size(_) -> error. + +%% +%% The binary_part/2,3 guard BIFs +%% +-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))). +mask_error({'EXIT',{Err,_}}) -> + Err; +mask_error(Else) -> + Else. + +binary_part(doc) -> + ["Tests the binary_part/2,3 guard (GC) bif's"]; +binary_part(Config) when is_list(Config) -> + %% This is more or less a copy of what the guard_SUITE in emulator + %% does to cover the guard bif's + ?line 1 = bptest(<<1,2,3>>), + ?line 2 = bptest(<<2,1,3>>), + ?line error = bptest(<<1>>), + ?line error = bptest(<<>>), + ?line error = bptest(apa), + ?line 3 = bptest(<<2,3,3>>), + % With one variable (pos) + ?line 1 = bptest(<<1,2,3>>,1), + ?line 2 = bptest(<<2,1,3>>,1), + ?line error = bptest(<<1>>,1), + ?line error = bptest(<<>>,1), + ?line error = bptest(apa,1), + ?line 3 = bptest(<<2,3,3>>,1), + % With one variable (length) + ?line 1 = bptesty(<<1,2,3>>,1), + ?line 2 = bptesty(<<2,1,3>>,1), + ?line error = bptesty(<<1>>,1), + ?line error = bptesty(<<>>,1), + ?line error = bptesty(apa,1), + ?line 3 = bptesty(<<2,3,3>>,2), + % With one variable (whole tuple) + ?line 1 = bptestx(<<1,2,3>>,{1,1}), + ?line 2 = bptestx(<<2,1,3>>,{1,1}), + ?line error = bptestx(<<1>>,{1,1}), + ?line error = bptestx(<<>>,{1,1}), + ?line error = bptestx(apa,{1,1}), + ?line 3 = bptestx(<<2,3,3>>,{1,2}), + % With two variables + ?line 1 = bptest(<<1,2,3>>,1,1), + ?line 2 = bptest(<<2,1,3>>,1,1), + ?line error = bptest(<<1>>,1,1), + ?line error = bptest(<<>>,1,1), + ?line error = bptest(apa,1,1), + ?line 3 = bptest(<<2,3,3>>,1,2), + % Direct (autoimported) call, these will be evaluated by the compiler... + ?line <<2>> = binary_part(<<1,2,3>>,1,1), + ?line <<1>> = binary_part(<<2,1,3>>,1,1), + % Compiler warnings due to constant evaluation expected (3) + ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)), + ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)), + ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)), + ?line <<3,3>> = binary_part(<<2,3,3>>,1,2), + % Direct call through apply + ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]), + ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]), + % Compiler warnings due to constant evaluation expected (3) + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])), + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])), + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])), + ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]), + % Constant propagation + ?line Bin = <<1,2,3>>, + ?line ok = if + binary_part(Bin,1,1) =:= <<2>> -> + ok; + %% Compiler warning, clause cannot match (expected) + true -> + error + end, + ?line ok = if + binary_part(Bin,{1,1}) =:= <<2>> -> + ok; + %% Compiler warning, clause cannot match (expected) + true -> + error + end, + ok. + + +bptest(B) when length(B) =:= 1337 -> + 1; +bptest(B) when binary_part(B,{1,1}) =:= <<2>> -> + 1; +bptest(B) when erlang:binary_part(B,1,1) =:= <<1>> -> + 2; +bptest(B) when erlang:binary_part(B,{1,2}) =:= <<3,3>> -> + 3; +bptest(_) -> + error. + +bptest(B,A) when length(B) =:= A -> + 1; +bptest(B,A) when binary_part(B,{A,1}) =:= <<2>> -> + 1; +bptest(B,A) when erlang:binary_part(B,A,1) =:= <<1>> -> + 2; +bptest(B,A) when erlang:binary_part(B,{A,2}) =:= <<3,3>> -> + 3; +bptest(_,_) -> + error. + +bptestx(B,A) when length(B) =:= A -> + 1; +bptestx(B,A) when binary_part(B,A) =:= <<2>> -> + 1; +bptestx(B,A) when erlang:binary_part(B,A) =:= <<1>> -> + 2; +bptestx(B,A) when erlang:binary_part(B,A) =:= <<3,3>> -> + 3; +bptestx(_,_) -> + error. + +bptesty(B,A) when length(B) =:= A -> + 1; +bptesty(B,A) when binary_part(B,{1,A}) =:= <<2>> -> + 1; +bptesty(B,A) when erlang:binary_part(B,1,A) =:= <<1>> -> + 2; +bptesty(B,A) when erlang:binary_part(B,{1,A}) =:= <<3,3>> -> + 3; +bptesty(_,_) -> + error. + +bptest(B,A,_C) when length(B) =:= A -> + 1; +bptest(B,A,C) when binary_part(B,{A,C}) =:= <<2>> -> + 1; +bptest(B,A,C) when erlang:binary_part(B,A,C) =:= <<1>> -> + 2; +bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> -> + 3; +bptest(_,_,_) -> + error. + +-define(FAILING(C), + if + C -> ?t:fail(should_fail); + true -> ok + end, + if + true, C -> ?t:fail(should_fail); + true -> ok + end). + +bad_constants(Config) when is_list(Config) -> + ?line ?FAILING(false), + ?line ?FAILING([]), + ?line ?FAILING([a]), + ?line ?FAILING([Config]), + ?line ?FAILING({a,b}), + ?line ?FAILING({a,Config}), + ?line ?FAILING(<<1>>), + ?line ?FAILING(42), + ?line ?FAILING(3.14), + ok. %% Call this function to turn off constant propagation. id(I) -> I. @@ -1490,3 +1689,5 @@ check(F, Result) -> io:format(" Got: ~p\n", [Other]), test_server:fail() end. + +fc({'EXIT',{function_clause,_}}) -> ok. diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl index f36ed213d1..4ffcf7888e 100644 --- a/lib/debugger/test/int_eval_SUITE.erl +++ b/lib/debugger/test/int_eval_SUITE.erl @@ -28,7 +28,7 @@ bifs_outside_erlang/1, spawning/1, applying/1, catch_and_throw/1, external_call/1, test_module_info/1, apply_interpreted_fun/1, apply_uninterpreted_fun/1, - interpreted_exit/1, otp_8310/1]). + interpreted_exit/1, otp_8310/1, stacktrace/1]). %% Helpers. -export([applier/3]). @@ -44,7 +44,7 @@ all() -> [bifs_outside_erlang, spawning, applying, catch_and_throw, external_call, test_module_info, apply_interpreted_fun, apply_uninterpreted_fun, - interpreted_exit, otp_8310]. + interpreted_exit, otp_8310, stacktrace]. groups() -> []. @@ -191,23 +191,23 @@ apply_interpreted_fun(Config) when is_list(Config) -> ?line {ok,ATerm} = spawn_eval(fun() -> F2() end), %% Called from uninterpreted code, badarity - ?line {'EXIT',{{badarity,{F1,[snape]}},[{?MODULE,_,_}|_]}} = + ?line {'EXIT',{{badarity,{F1,[snape]}},[{?MODULE,_,_,_}|_]}} = spawn_eval(fun() -> F1(snape) end), %% Called from uninterpreted code, error in fun ?line F3 = spawn_eval(fun() -> ?IM:give_me_a_bad_fun() end), - ?line {'EXIT',{snape,[{?IM,_FunName,_}|_]}} = + ?line {'EXIT',{snape,[{?IM,_FunName,_,_}|_]}} = spawn_eval(fun() -> F3(snape) end), %% Called from within interpreted code ?line perfectly_alright = spawn_eval(fun() -> ?IM:do_apply(F1) end), %% Called from within interpreted code, badarity - ?line {'EXIT',{{badarity,{F1,[snape]}},[{?IM,do_apply,_}|_]}} = + ?line {'EXIT',{{badarity,{F1,[snape]}},[{?IM,do_apply,_,_}|_]}} = spawn_eval(fun() -> ?IM:do_apply(F1, snape) end), %% Called from within interpreted code, error in fun - ?line {'EXIT',{snape,[{?IM,_FunName,_}|_]}} = + ?line {'EXIT',{snape,[{?IM,_FunName,_,_}|_]}} = spawn_eval(fun() -> ?IM:do_apply(F3, snape) end), %% Try some more complex funs. @@ -239,11 +239,11 @@ apply_uninterpreted_fun(Config) when is_list(Config) -> spawn_eval(fun() -> ?IM:do_apply(F1, any_arg) end), %% Badarity (evaluated in dbg_debugged, which calls erlang:apply/2) - ?line {'EXIT',{{badarity,{F1,[]}},[{erlang,apply,_}|_]}} = + ?line {'EXIT',{{badarity,{F1,[]}},[{erlang,apply,_,_}|_]}} = spawn_eval(fun() -> ?IM:do_apply(F1) end), %% Error in fun - ?line {'EXIT',{snape,[{?MODULE,_FunName,_}|_]}} = + ?line {'EXIT',{snape,[{?MODULE,_FunName,_,_}|_]}} = spawn_eval(fun() -> ?IM:do_apply(F1, snape) end), ok. @@ -277,6 +277,37 @@ applier(M, F, A) -> io:format("~p:~p(~p) => ~p\n", [M,F,A,Res]), Res. +stacktrace(Config) when is_list(Config) -> + ?line {done,Stk} = do_eval(Config, stacktrace), + ?line 13 = length(Stk), + ?line OldStackTraceFlag = int:stack_trace(), + ?line int:stack_trace(no_tail), + try + ?line Res = spawn_eval(fun() -> stacktrace:stacktrace() end), + ?line io:format("\nInterpreted (no_tail):\n~p", [Res]), + ?line {done,Stk} = Res + after + ?line int:stack_trace(OldStackTraceFlag) + end, + ok. + + +do_eval(Config, Mod) -> + ?line DataDir = ?config(data_dir, Config), + ?line ok = file:set_cwd(DataDir), + + ?line {ok,Mod} = compile:file(Mod, [report,debug_info]), + ?line {module,Mod} = code:load_file(Mod), + ?line CompiledRes = Mod:Mod(), + ?line ok = io:format("Compiled:\n~p", [CompiledRes]), + io:nl(), + + ?line {module,Mod} = int:i(Mod), + ?line IntRes = Mod:Mod(), + ?line ok = io:format("Interpreted:\n~p", [IntRes]), + + ?line CompiledRes = IntRes. + %% %% Evaluate in another process, to prevent the test_case process to become %% interpreted. diff --git a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl index 997ee6e17d..90f83e80e8 100644 --- a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl +++ b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl @@ -117,7 +117,7 @@ more_nocatch(Fun) -> %% External calls. external_call_test(Data) -> - {'EXIT',{undef,[{?MODULE,not_exported,[42,Data]}|_]}} = + {'EXIT',{undef,[{?MODULE,not_exported,[42,Data],_}|_]}} = (catch ?MODULE:not_exported(42, Data)), {yes,Data} = i_am_exported(Data), {yes,Data} = ?MODULE:i_am_exported(Data), @@ -127,7 +127,7 @@ external_call_test(Data) -> {ok,Data,[a,b]} = not_exported(Data, [a,b]), {yes,Data} = i_am_exported(Data), {ok,Data,[a,b]} = not_exported(Data, [a,b]), - {'EXIT',{undef,[{?MODULE,not_exported,[7,Data]}|_]}} = + {'EXIT',{undef,[{?MODULE,not_exported,[7,Data],_}|_]}} = (catch ?MODULE:not_exported(7, Data)), {yes,Data} = ?MODULE:i_am_exported(Data), ok. diff --git a/lib/debugger/test/int_eval_SUITE_data/stacktrace.erl b/lib/debugger/test/int_eval_SUITE_data/stacktrace.erl new file mode 100644 index 0000000000..3380178fdc --- /dev/null +++ b/lib/debugger/test/int_eval_SUITE_data/stacktrace.erl @@ -0,0 +1,130 @@ +-module(stacktrace). +-export([?MODULE/0]). + +?MODULE() -> + OldDepth = erlang:system_flag(backtrace_depth, 32), + done = (catch do_try()), + Stk = trim(erlang:get_stacktrace()), + erlang:system_flag(backtrace_depth, OldDepth), + {done,Stk}. + +trim([{int_eval_SUITE,_,_,_}|_]) -> + []; +trim([H|T]) -> + [H|trim(T)]; +trim([]) -> []. + +do_try() -> + try + 0 = id(42) + catch + error:{badmatch,42} -> + do_try2() %Tail-recursive + end. + +do_try2() -> + try + 0 = id(42) + catch + error:{badmatch,42} -> + do_try3() %Not tail-recursive + end, + ?LINE. + +do_try3() -> + try id(42) of + 42 -> do_try4() %Tail-recursive + catch + error:ignore -> %Should never catch + ?LINE + end. + +do_try4() -> + try + do_recv() %Not tail-recursive + catch + error:ignore -> %Should never catch + ?LINE + end. + +do_recv() -> + self() ! x, + receive + x -> do_recv2() %Not tail-recursive + end, + ?LINE. + +do_recv2() -> + self() ! y, + receive + y -> do_recv3() %Tail-recursive + end. + +do_recv3() -> + receive + after 0 -> do_recv4() %Tail-recursive + end. + +do_recv4() -> + receive + after 0 -> do_if(true) %Not tail-recursive + end, + ?LINE. + +do_if(Bool) -> + if + Bool -> do_if2(Bool) %Tail-recursive + end. + +do_if2(Bool) -> + if + Bool -> do_case(Bool) %Not tail-recursive + end, + ?LINE. + + +do_case(Bool) -> + case Bool of + true -> do_case2(Bool) %Tail-recursive + end. + +do_case2(Bool) -> + case Bool of + true -> do_fun(Bool) %Not tail-recursive + end, + ?LINE. + +do_fun(Bool) -> + F = fun(true) -> + do_fun2(Bool) %Tail-recursive + end, + F(Bool). %Tail-recursive + +do_fun2(Bool) -> + F = fun(true) -> + cons(Bool) %Tail-recursive + end, + F(Bool), %Not tail-recursive + ?LINE. + +cons(Bool) -> + [Bool|tuple()]. + +tuple() -> + {ok,op()}. + +op() -> + 1 + lc(). + +lc() -> + [done() || true]. + +done() -> + tail(100), + throw(done). + +tail(0) -> ok; +tail(N) -> tail(N-1). + +id(I) -> + I. diff --git a/lib/debugger/test/lc_SUITE.erl b/lib/debugger/test/lc_SUITE.erl index 92a03ef58e..2f05eb7fca 100644 --- a/lib/debugger/test/lc_SUITE.erl +++ b/lib/debugger/test/lc_SUITE.erl @@ -17,21 +17,22 @@ %% %CopyrightEnd% %% -%% -module(lc_SUITE). --author('[email protected]'). +%% Copied from lc_SUITE in the compiler application. + -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, - basic/1]). + basic/1,deeply_nested/1,no_generator/1, + empty_generator/1]). -include_lib("test_server/include/test_server.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - cases(). + [basic, deeply_nested, no_generator, empty_generator]. groups() -> []. @@ -42,10 +43,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - -cases() -> - [basic]. - init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), Dog = test_server:timetrap(?t:minutes(1)), @@ -64,7 +61,7 @@ init_per_suite(Config) when is_list(Config) -> end_per_suite(Config) when is_list(Config) -> ok. -basic(Config) when list(Config) -> +basic(Config) when is_list(Config) -> ?line L0 = lists:seq(1, 10), ?line L1 = my_map(fun(X) -> {x,X} end, L0), ?line L1 = [{x,X} || X <- L0], @@ -73,16 +70,116 @@ basic(Config) when list(Config) -> ?line [4,5,6] = [X || X <- L0, X > 3, X < 7], ?line [] = [X || X <- L0, X > 32, X < 7], ?line [1,3,5,7,9] = [X || X <- L0, odd(X)], + ?line [2,4,6,8,10] = [X || X <- L0, not odd(X)], + ?line [1,3,5,9] = [X || X <- L0, odd(X), X =/= 7], + ?line [2,4,8,10] = [X || X <- L0, not odd(X), X =/= 6], + + %% Append is specially handled. + ?line [1,3,5,9,2,4,8,10] = [X || X <- L0, odd(X), X =/= 7] ++ + [X || X <- L0, not odd(X), X =/= 6], + + %% Guards BIFs are evaluated in guard context. Weird, but true. + ?line [{a,b,true},{x,y,true,true}] = [X || X <- tuple_list(), element(3, X)], + + %% Filter expressions with andalso/orelse. + ?line "abc123" = alphanum("?abc123.;"), %% Error cases. - ?line [] = [X || X <- L1, X+1 < 2], ?line [] = [{xx,X} || X <- L0, element(2, X) == no_no_no], - ?line {'EXIT',_} = (catch [X || X <- L1, odd(X)]), + ?line {'EXIT',_} = (catch [X || X <- L1, list_to_atom(X) == dum]), + ?line [] = [X || X <- L1, X+1 < 2], + ?line {'EXIT',_} = (catch [X || X <- L1, odd(X)]), + %% A bad generator has a different exception compared to BEAM. + ?line {'EXIT',{{bad_generator,x},_}} = (catch [E || E <- id(x)]), ok. +tuple_list() -> + [{a,b,true},[a,b,c],glurf,{a,b,false,xx},{a,b},{x,y,true,true},{a,b,d,ddd}]. + my_map(F, L) -> [F(X) || X <- L]. odd(X) -> X rem 2 == 1. + +alphanum(Str) -> + [C || C <- Str, ((C >= $0) andalso (C =< $9)) + orelse ((C >= $a) andalso (C =< $z)) + orelse ((C >= $A) andalso (C =< $Z))]. + +deeply_nested(Config) when is_list(Config) -> + [[99,98,97,96,42,17,1764,12,11,10,9,8,7,6,5,4,3,7,2,1]] = deeply_nested_1(), + ok. + +deeply_nested_1() -> + %% This used to compile really, really SLOW before R11B-1... + [[X1,X2,X3,X4,X5,X6,X7(),X8,X9,X10,X11,X12,X13,X14,X15,X16,X17,X18(),X19,X20] || + X1 <- [99],X2 <- [98],X3 <- [97],X4 <- [96],X5 <- [42],X6 <- [17], + X7 <- [fun() -> X5*X5 end],X8 <- [12],X9 <- [11],X10 <- [10], + X11 <- [9],X12 <- [8],X13 <- [7],X14 <- [6],X15 <- [5], + X16 <- [4],X17 <- [3],X18 <- [fun() -> X16+X17 end],X19 <- [2],X20 <- [1]]. + +no_generator(Config) when is_list(Config) -> + ?line Seq = lists:seq(-10, 17), + ?line [no_gen_verify(no_gen(A, B), A, B) || A <- Seq, B <- Seq], + + %% Literal expression, for coverage. + ?line [a] = [a || true], + ?line [a,b,c] = [a || true] ++ [b,c], + ok. + +no_gen(A, B) -> + [{A,B} || A+B =:= 0] ++ + [{A,B} || A*B =:= 0] ++ + [{A,B} || A rem B =:= 3] ++ + [{A,B} || A =:= B] ++ + [{one_more,A,B} || no_gen_one_more(A, B)] ++ + [A || A =:= 1] ++ + [A || A =:= 2] ++ + [A || A =:= 3] ++ + [A || A =:= 4] ++ + [A || A =:= 5] ++ + [A || A =:= 6] ++ + [A || A =:= 7] ++ + [A || A =:= 8] ++ + [A || A =:= 9] ++ + [B || B =:= 1] ++ + [B || B =:= 2] ++ + [B || B =:= 3] ++ + [B || B =:= 4] ++ + [B || B =:= 5] ++ + [B || B =:= 6] ++ + [B || B =:= 7] ++ + [B || B =:= 8] ++ + [B || B =:= 9]. + +no_gen_verify(Res, A, B) -> + Pair = {A,B}, + ShouldBe = no_gen_eval(fun() -> A+B =:= 0 end, Pair) ++ + no_gen_eval(fun() -> A*B =:= 0 end, Pair) ++ + no_gen_eval(fun() -> B =/= 0 andalso A rem B =:= 3 end, Pair) ++ + no_gen_eval(fun() -> A =:= B end, Pair) ++ + no_gen_eval(fun() -> A + 1 =:= B end, {one_more,A,B}) ++ + no_gen_eval(fun() -> 1 =< A andalso A =< 9 end, A) ++ + no_gen_eval(fun() -> 1 =< B andalso B =< 9 end, B), + case Res of + ShouldBe -> ok; + _ -> + io:format("A = ~p; B = ~p; Expected = ~p, actual = ~p", [A,B,ShouldBe,Res]), + ?t:fail() + end. + +no_gen_eval(Fun, Res) -> + case Fun() of + true -> [Res]; + false -> [] + end. + +no_gen_one_more(A, B) -> A + 1 =:= B. + +empty_generator(Config) when is_list(Config) -> + ?line [] = [X || {X} <- [], (false or (X/0 > 3))], + ok. + +id(I) -> I. diff --git a/lib/debugger/test/line_number_SUITE.erl b/lib/debugger/test/line_number_SUITE.erl new file mode 100644 index 0000000000..d1f56d3493 --- /dev/null +++ b/lib/debugger/test/line_number_SUITE.erl @@ -0,0 +1,220 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-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% +%% + +-module(line_number_SUITE). + +-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, + init_per_suite/1,end_per_suite/1, + line_numbers/1]). +-export([crash/1]). + +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + cases(). + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +cases() -> + [line_numbers]. + +init_per_testcase(_Case, Config) -> + test_lib:interpret(?MODULE), + Dog = test_server:timetrap(?t:minutes(1)), + [{watchdog,Dog}|Config]. + +end_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +init_per_suite(Config) when is_list(Config) -> + ?line test_lib:interpret(?MODULE), + ?line true = lists:member(?MODULE, int:interpreted()), + Config. + +end_per_suite(Config) when is_list(Config) -> + ok. + + + + + +%% +%% === Make sure that this is always line 70 === +%% +line1(Tag, X) -> %Line 72 + case Tag of %Line 73 + a -> + Y = X + 1, %Line 75 + Res = id({ok,Y}), %Line 76 + ?MODULE:crash({ok,42} = Res); %Line 77 + b -> + x = id(x), %Line 79 + ok %Line 80 + end. %Line 81 + +crash(_) -> %Line 83 + erlang:error(crash). %Line 84 + +close_calls(Where) -> %Line 86 + put(where_to_crash, Where), %Line 87 + try + call1(), %Line 89 + call2(), %Line 90 + call3(), %Line 91 + no_crash %Line 92 + catch error:crash -> + erlang:get_stacktrace() %Line 94 + end. %Line 95 + +call1() -> %Line 97 + maybe_crash(call1), %Line 98 + ok. %Line 99 + +call2() -> %Line 101 + maybe_crash(call2), %Line 102 + ok. %Line 103 + +call3() -> %Line 105 + maybe_crash(call3), %Line 106 + ok. %Line 107 + +maybe_crash(Name) -> %Line 109 + case get(where_to_crash) of %Line 110 + Name -> + erlang:error(crash); %Line 112 + _ -> + ok %Line 114 + end. %Line 115 + +build_binary1(Size) -> %Line 117 + id(42), %Line 118 + <<0:Size>>. %Line 119 + +build_binary2(Size, Bin) -> %Line 121 + id(0), %Line 122 + <<7:Size,Bin/binary>>. %Line 123 + +do_call_abs(x, Arg) -> %Line 125 + abs(Arg). %Line 126 + +do_call_unsafe_bif(x, Arg) -> %Line 128 + link(Arg). %Line 129 + + +line_numbers(Config) when is_list(Config) -> + File = ?MODULE_STRING ++ ".erl", + {'EXIT',{{case_clause,bad_tag}, + [{?MODULE,line1,2, + [{file,File},{line,73}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(bad_tag, 0)), + {'EXIT',{badarith, + [{?MODULE,line1,2, + [{file,File},{line,75}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, not_an_integer)), + {'EXIT',{{badmatch,{ok,1}}, + [{?MODULE,line1,2, + [{file,File},{line,77}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, 0)), + {'EXIT',{crash, + [{?MODULE,crash,1, + [{file,File},{line,84}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, 41)), + + [{?MODULE,maybe_crash,1,[{file,File},{line,112}]}, + {?MODULE,call1,0,[{file,File},{line,98}]}, + {?MODULE,close_calls,1,[{file,File},{line,89}]}, + {?MODULE,line_numbers,1,[{file,File},{line,_}]}|_] = + close_calls(call1), + [{?MODULE,maybe_crash,1,[{file,File},{line,112}]}, + {?MODULE,call2,0,[{file,File},{line,102}]}, + {?MODULE,close_calls,1,[{file,File},{line,90}]}, + {?MODULE,line_numbers,1,[{file,File},{line,_}]}|_] = + close_calls(call2), + [{?MODULE,maybe_crash,1,[{file,File},{line,112}]}, + {?MODULE,call3,0,[{file,File},{line,106}]}, + {?MODULE,close_calls,1,[{file,File},{line,91}]}, + {?MODULE,line_numbers,1,[{file,File},{line,_}]}|_] = + close_calls(call3), + no_crash = close_calls(other), + + <<0,0>> = build_binary1(16), + {'EXIT',{badarg, + [{?MODULE,build_binary1,1, + [{file,File},{line,119}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary1(bad_size)), + + <<7,1,2,3>> = build_binary2(8, <<1,2,3>>), + {'EXIT',{badarg, + [{?MODULE,build_binary2,2, + [{file,File},{line,123}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary2(bad_size, <<>>)), + {'EXIT',{badarg, + [%% Beam has an extra here: + %% {erlang,bit_size,[bad_binary],[]} + %% Since this is an artifact of the implementation, + %% we don't attempt to mimic it in the debugger. + {?MODULE,build_binary2,2, + [{file,File},{line,123}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary2(8, bad_binary)), + + {'EXIT',{function_clause, + [{?MODULE,do_call_abs,[y,y], + [{file,File},{line,125}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch do_call_abs(y, y)), + {'EXIT',{badarg, + [{erlang,abs,[[]],[]}, + {?MODULE,do_call_abs,2, + [{file,File},{line,126}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch do_call_abs(x, [])), + + {'EXIT',{badarg, + [{erlang,link,[[]],[]}, + {?MODULE,do_call_unsafe_bif,2, + [{file,File},{line,129}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch do_call_unsafe_bif(x, [])), + + ok. + +id(I) -> + I. diff --git a/lib/debugger/test/test_lib.erl b/lib/debugger/test/test_lib.erl index 541375e64a..5e4ac7f164 100644 --- a/lib/debugger/test/test_lib.erl +++ b/lib/debugger/test/test_lib.erl @@ -22,7 +22,7 @@ -export([interpret/1]). -interpret(Mod) when atom(Mod) -> +interpret(Mod) when is_atom(Mod) -> case lists:member(Mod, int:interpreted()) of true -> ok; false -> {module,Mod} = i:ii(Mod) diff --git a/lib/debugger/test/trycatch_SUITE.erl b/lib/debugger/test/trycatch_SUITE.erl index a87c5db138..470d46d915 100644 --- a/lib/debugger/test/trycatch_SUITE.erl +++ b/lib/debugger/test/trycatch_SUITE.erl @@ -318,17 +318,18 @@ eclectic(Conf) when is_list(Conf) -> V = {make_ref(),3.1415926535,[[]|{}]}, ?line {{value,{value,V},V},V} = eclectic_1({foo,{value,{value,V}}}, undefined, {value,V}), - ?line {{'EXIT',{V,[{?MODULE,foo,_}|_]}},V} = + ?line {{'EXIT',{V,[{?MODULE,foo,_,_}|_]}},V} = eclectic_1({catch_foo,{error,V}}, undefined, {value,V}), ?line {{error,{exit,V},{'EXIT',V}},V} = eclectic_1({foo,{error,{exit,V}}}, error, {value,V}), - ?line {{value,{value,V},V},{'EXIT',{badarith,[{?MODULE,my_add,_}|_]}}} = + ?line {{value,{value,V},V},{'EXIT',{badarith,[{?MODULE,my_add,_,_}|_]}}} = eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}), ?line {{'EXIT',V},V} = eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}), - ?line {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,_}|_]}}}, {'EXIT',V}} = + ?line {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,_,_}|_]}}}, + {'EXIT',V}} = eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}), - ?line {{{error,V},{'EXIT',{V,[{?MODULE,foo,_}|_]}}},{'EXIT',V}} = + ?line {{{error,V},{'EXIT',{V,[{?MODULE,foo,_,_}|_]}}},{'EXIT',V}} = eclectic_1({catch_foo,{throw,{error,V}}}, undefined, {exit,V}), %% ?line {{value,{value,{value,V},V}},V} = @@ -337,15 +338,15 @@ eclectic(Conf) when is_list(Conf) -> eclectic_2({throw,{value,V}}, throw, {value,V}), ?line {{caught,{'EXIT',V}},undefined} = eclectic_2({value,{value,V}}, undefined, {exit,V}), - ?line {{caught,{'EXIT',{V,[{?MODULE,foo,_}|_]}}},undefined} = + ?line {{caught,{'EXIT',{V,[{?MODULE,foo,_,_}|_]}}},undefined} = eclectic_2({error,{value,V}}, throw, {error,V}), - ?line {{caught,{'EXIT',{badarg,[{erlang,abs,[V]}|_]}}},V} = + ?line {{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} = eclectic_2({value,{'abs',V}}, undefined, {value,V}), - ?line {{caught,{'EXIT',{badarith,[{?MODULE,my_add,_}|_]}}},V} = + ?line {{caught,{'EXIT',{badarith,[{?MODULE,my_add,_,_}|_]}}},V} = eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}), ?line {{caught,{'EXIT',V}},undefined} = eclectic_2({value,{error,V}}, undefined, {exit,V}), - ?line {{caught,{'EXIT',{V,[{?MODULE,foo,_}|_]}}},undefined} = + ?line {{caught,{'EXIT',{V,[{?MODULE,foo,_,_}|_]}}},undefined} = eclectic_2({throw,{'div',{1,0}}}, throw, {error,V}), ok. diff --git a/lib/dialyzer/doc/src/Makefile b/lib/dialyzer/doc/src/Makefile index 45b0ffa5ff..45b0ffa5ff 100755..100644 --- a/lib/dialyzer/doc/src/Makefile +++ b/lib/dialyzer/doc/src/Makefile diff --git a/lib/dialyzer/doc/src/book.xml b/lib/dialyzer/doc/src/book.xml index 0b4e1cb617..0b4e1cb617 100755..100644 --- a/lib/dialyzer/doc/src/book.xml +++ b/lib/dialyzer/doc/src/book.xml diff --git a/lib/dialyzer/doc/src/fascicules.xml b/lib/dialyzer/doc/src/fascicules.xml index 0678195e07..0678195e07 100755..100644 --- a/lib/dialyzer/doc/src/fascicules.xml +++ b/lib/dialyzer/doc/src/fascicules.xml diff --git a/lib/dialyzer/doc/src/make.dep b/lib/dialyzer/doc/src/make.dep deleted file mode 100755 index f8177cd419..0000000000 --- a/lib/dialyzer/doc/src/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex dialyzer.tex dialyzer_chapter.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/dialyzer/doc/src/notes.xml b/lib/dialyzer/doc/src/notes.xml index 17291b24f7..17291b24f7 100755..100644 --- a/lib/dialyzer/doc/src/notes.xml +++ b/lib/dialyzer/doc/src/notes.xml diff --git a/lib/dialyzer/doc/src/part.xml b/lib/dialyzer/doc/src/part.xml index 4410840660..4410840660 100755..100644 --- a/lib/dialyzer/doc/src/part.xml +++ b/lib/dialyzer/doc/src/part.xml diff --git a/lib/dialyzer/doc/src/part_notes.xml b/lib/dialyzer/doc/src/part_notes.xml index cb048d55dd..cb048d55dd 100755..100644 --- a/lib/dialyzer/doc/src/part_notes.xml +++ b/lib/dialyzer/doc/src/part_notes.xml diff --git a/lib/dialyzer/doc/src/ref_man.xml b/lib/dialyzer/doc/src/ref_man.xml index ca5410f6b8..ca5410f6b8 100755..100644 --- a/lib/dialyzer/doc/src/ref_man.xml +++ b/lib/dialyzer/doc/src/ref_man.xml diff --git a/lib/dialyzer/info b/lib/dialyzer/info index 9fba4b54ad..9fba4b54ad 100755..100644 --- a/lib/dialyzer/info +++ b/lib/dialyzer/info diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index bcdcf2685d..84b926a17a 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -480,7 +480,7 @@ invalid_contract_warning({M, F, A}, FileLine, SuccType, RecDict) -> extra_range_warning({M, F, A}, FileLine, ExtraRanges, STRange) -> ERangesStr = erl_types:t_to_string(ExtraRanges), STRangeStr = erl_types:t_to_string(STRange), - {?WARN_CONTRACT_TYPES, FileLine, + {?WARN_CONTRACT_SUPERTYPE, FileLine, {extra_range, [M, F, A, ERangesStr, STRangeStr]}}. picky_contract_check(CSig0, Sig0, MFA, FileLine, Contract, RecDict, Acc) -> diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 30aec59d22..92868b6878 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -2161,13 +2161,21 @@ get_apply_constr(FunLabels, Dst, ArgTypes, #state{callgraph = CG} = State) -> case lists:member(error, MFAs) of true -> error; false -> - Constrs = [begin - State1 = state__new_constraint_context(State), - State2 = get_plt_constr(MFA, Dst, ArgTypes, State1), - state__cs(State2) - end || {ok, MFA} <- MFAs], - ApplyConstr = mk_disj_constraint_list(Constrs), - {ok, state__store_conj(ApplyConstr, State)} + Constrs0 = + [begin + State1 = state__new_constraint_context(State), + try get_plt_constr(MFA, Dst, ArgTypes, State1) of + State2 -> state__cs(State2) + catch + throw:error -> error + end + end || {ok, MFA} <- MFAs], + case [C || C <- Constrs0, C =/= error] of + [] -> throw(error); + Constrs -> + ApplyConstr = mk_disj_constraint_list(Constrs), + {ok, state__store_conj(ApplyConstr, State)} + end end. state__scc(#state{scc = SCC}) -> diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/crash b/lib/dialyzer/test/opaque_SUITE_data/results/crash index 6bdd934169..1ddae5149f 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/crash +++ b/lib/dialyzer/test/opaque_SUITE_data/results/crash @@ -1,5 +1,4 @@ -crash_1.erl:42: The specification for crash_1:empty/0 states that the function might also return crash_1:targetlist() but the inferred return is none() crash_1.erl:45: Record construction #targetlist{list::[]} violates the declared type of field list::'undefined' | crash_1:target() crash_1.erl:48: The call crash_1:get_using_branch2(Branch::maybe_improper_list(),L::'undefined' | crash_1:target()) contains an opaque term as 2nd argument when terms of different types are expected in these positions crash_1.erl:50: The pattern <_Branch, []> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()> diff --git a/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy b/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy new file mode 100644 index 0000000000..7ce440a60d --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy @@ -0,0 +1,4 @@ + +higher_order_discrepancy.erl:11: The call higher_order_discrepancy:g('foo') will never return since it differs in the 1st argument from the success typing arguments: ('bar') +higher_order_discrepancy.erl:14: Function g/1 has no local return +higher_order_discrepancy.erl:14: The pattern 'bar' can never match the type 'foo' diff --git a/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy_2 b/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy_2 new file mode 100644 index 0000000000..c1c7dbbfcc --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy_2 @@ -0,0 +1,8 @@ + +higher_order_discrepancy_2.erl:11: The call higher_order_discrepancy_2:f('foo') will never return since it differs in the 1st argument from the success typing arguments: ('bar') +higher_order_discrepancy_2.erl:11: The call higher_order_discrepancy_2:g('foo') will never return since it differs in the 1st argument from the success typing arguments: ('baz') +higher_order_discrepancy_2.erl:13: Function f/1 has no local return +higher_order_discrepancy_2.erl:13: The pattern 'bar' can never match the type 'foo' +higher_order_discrepancy_2.erl:14: Function g/1 has no local return +higher_order_discrepancy_2.erl:14: The pattern 'baz' can never match the type 'foo' +higher_order_discrepancy_2.erl:5: Function test/1 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash b/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash index 191d3d4173..8c9df56a4b 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash +++ b/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash @@ -12,4 +12,3 @@ tuple_set_crash.erl:179: The pattern <<AudioVolume:16/integer-little-unit:1,Rest tuple_set_crash.erl:182: The pattern <<Delay:16/integer-little-unit:1,_Padding/binary-unit:8>> can never match the type <<_:8>> tuple_set_crash.erl:62: The pattern {'play_list', _Playlist} can never match the type 'ok' | {'device_properties',[{atom(),_}]} | {'error',[{atom(),_}]} tuple_set_crash.erl:64: The pattern {'error', 17} can never match the type 'ok' | {'device_properties',[{atom(),_}]} | {'error',[{atom(),_}]} -tuple_set_crash.erl:83: The specification for tuple_set_crash:parse_message/1 states that the function might also return {'media_item_url_reply',integer(),binary()} but the inferred return is 'ok' | {'audio_device_info' | 'audio_output_info' | 'audio_target_info' | 'device_properties' | 'error' | 'video_device_info' | 'video_output_info' | 'video_target_info',[{'address' | 'audio_volume' | 'controller_description' | 'controller_name' | 'controller_status' | 'device_id' | 'display_type' | 'fw_version' | 'master_volume' | 'model' | 'output_id' | 'status' | 'target_id',binary() | non_neg_integer()}] | 1..255} diff --git a/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy.erl b/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy.erl new file mode 100644 index 0000000000..ff5ee6bac4 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy.erl @@ -0,0 +1,14 @@ +-module(higher_order_discrepancy). + +-export([test/1]). + +test(X) -> + F = + case X of + 1 -> fun f/1; + 2 -> fun g/1 + end, + F(foo). + +f(foo) -> ok. +g(bar) -> ok. diff --git a/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy_2.erl b/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy_2.erl new file mode 100644 index 0000000000..4b0d4f6b45 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy_2.erl @@ -0,0 +1,14 @@ +-module(higher_order_discrepancy_2). + +-export([test/1]). + +test(X) -> + F = + case X of + 1 -> fun f/1; + 2 -> fun g/1 + end, + F(foo). + +f(bar) -> ok. +g(baz) -> ok. diff --git a/lib/diameter/bin/diameterc b/lib/diameter/bin/diameterc index f5cf3ebc10..c0e83ea1a4 100755 --- a/lib/diameter/bin/diameterc +++ b/lib/diameter/bin/diameterc @@ -33,19 +33,24 @@ usage() -> io:format( - "~w [options] file~n" + "~w [options] dict~n" "~n" " Compile a diameter dictionary file (.dia) to Erlang source (.erl)~n" " and/or header (.hrl) files.~n" "~n" " options:~n" - " -h = print this message~n" - " -v = verbose output~n" - " -o dir = set the output directory (default .)~n" - " -i dir = set an include directory for inherited beams~n" - " -E = no .erl output~n" - " -H = no .hrl output~n" - " -d = write intermediate files (.spec and .forms)~n", + "~n" + " --name name = set @name~n" + " --prefix prefix = set @prefix~n" + " --inherits dict|- = set/clear @inherits~n" + "~n" + " -h = print this message~n" + " -v = verbose output~n" + " -o dir = set the output directory (default .)~n" + " -i dir = set an include directory for inherited beams~n" + " -E = no .erl output~n" + " -H = no .hrl output~n" + " -d = write intermediate files (.spec and .forms)~n", [?MODULE]). main(Args) -> @@ -109,9 +114,17 @@ arg(["-o", Dir | Args], #argv{options = Opts} = A) -> arg(Args, A#argv{options = [{outdir, Dir} | Opts]}); arg(["-i", Dir | Args], #argv{options = Opts} = A) -> - true = dir_exists(Dir), arg(Args, A#argv{options = Opts ++ [{include, Dir}]}); +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}]}); + arg(["-E" | Args], #argv{output = Output} = A) -> arg(Args, A#argv{output = lists:delete(erl, Output)}); @@ -120,10 +133,10 @@ arg(["-H" | Args], #argv{output = Output} = A) -> arg(["-d" | Args], #argv{options = Opts, output = Output} = A) -> arg(Args, A#argv{options = [debug | Opts], - output = [spec | Output]}); + output = [spec | Output]}); arg([[$- = M, C, H | T] | Args], A) %% clustered options - when C /= $i, C /= $o -> + when C /= $i, C /= $o, C /= $- -> arg([[M,C], [M,H|T] | Args], A); arg([File], A) -> diff --git a/lib/diameter/configure.in b/lib/diameter/configure.in index 9aca3859c5..8acfb28fed 100644 --- a/lib/diameter/configure.in +++ b/lib/diameter/configure.in @@ -132,7 +132,6 @@ dnl </STANDALONE DIAMETER> AC_OUTPUT( Makefile:Makefile.in - src/app/diameter.mk:src/app/diameter.mk.in make/$host/rules.mk:make/rules.mk.in ) diff --git a/lib/diameter/doc/src/Makefile b/lib/diameter/doc/src/Makefile index 1453138cb6..bc3e649e6b 100644 --- a/lib/diameter/doc/src/Makefile +++ b/lib/diameter/doc/src/Makefile @@ -126,8 +126,6 @@ debug opt: info: @echo "->Makefile<-" @echo "" - @echo "DOCSUPPORT = $(DOCSUPPORT)" - @echo "" @echo "INDEX_FILE = $(INDEX_FILE)" @echo "INDEX_SRC = $(INDEX_SRC)" @echo "INDEX_TARGET = $(INDEX_TARGET)" @@ -141,10 +139,6 @@ info: @echo "" @echo "GIF_FILES = $(GIF_FILES)" @echo "" - @echo "TEX_FILES_USERS_GUIDE = $(TEX_FILES_USERS_GUIDE)" - @echo "TEX_FILES_REF_MAN = $(TEX_FILES_REF_MAN)" - @echo "TEX_FILES_BOOK = $(TEX_FILES_BOOK)" - @echo "" @echo "MAN1_FILES = $(MAN1_FILES)" @echo "MAN3_FILES = $(MAN3_FILES)" @echo "MAN4_FILES = $(MAN4_FILES)" diff --git a/lib/diameter/doc/src/depend.sed b/lib/diameter/doc/src/depend.sed index 5973c4586e..42de597f15 100644 --- a/lib/diameter/doc/src/depend.sed +++ b/lib/diameter/doc/src/depend.sed @@ -21,14 +21,18 @@ # massaged in Makefile. # -/^<com>\([^<]*\)<\/com>/b rf -/^<module>\([^<]*\)<\/module>/b rf +/^<com>/b c +/^<module>/b c /^<chapter>/!d +# Chapter: html basename is same as xml. s@@$(HTMLDIR)/%FILE%.html: %FILE%.xml@ q -:rf -s@@$(HTMLDIR)/\1.html: %FILE%.xml@ +# Reference: html basename is from contents of com/module element. +:c +s@^[^>]*>@@ +s@<.*@@ +s@.*@$(HTMLDIR)/&.html: %FILE%.xml@ q diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 2cad70e3bc..2d8edb1301 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -367,6 +367,19 @@ capabilities exchange message. Optional, defaults to the empty list.</p> </item> +<tag><c>{'Inband-Security-Id', [Unsigned32()]}</c></tag> +<item> +<p> +Values of Inband-Security-Id AVPs sent in an outgoing +capabilities exchange message. +Optional, defaults to the empty list, which is equivalent to a +list containing only 0 (= NO_INBAND_SECURITY).</p> + +<p> +If 1 (= TLS) is specified then TLS is selected if the CER/CEA received +from the peer offers it.</p> +</item> + <tag><c>{'Acct-Application-Id', [Unsigned32()]}</c></tag> <item> <p> @@ -418,7 +431,7 @@ eval(F) -> </code> <p> -Evaluating an evaluable() <c>E</c> on an argument list <c>A</c> +Applying an evaluable() <c>E</c> to an argument list <c>A</c> is meant in the sense of <c>eval([E|A])</c>.</p> <p> @@ -552,7 +565,7 @@ Pkt = #diameter_packet{} </code> <p> -Reports that the RFC 3539 watchdog state machine has +The RFC 3539 watchdog state machine has transitioned into (<c>up</c>) or out of (<c>down</c>) the open state. If a <c>diameter_packet</c> record is present in an <c>up</c> tuple @@ -563,9 +576,9 @@ connectivity.</p> <p> Note that a single up/down event for a given peer corresponds to -as many peer_up/down callbacks as there are Diameter -applications shared by the peer, as determined during capablilities -exchange. +as many <seealso marker="diameter_app#peer_up">peer_up/peer_down</seealso> +callbacks as there are Diameter applications shared by the peer, +as determined during capablilities exchange. That is, the event communicates connectivity with the peer as a whole while the callbacks communicate connectivity with respect to individual Diameter applications.</p> @@ -584,12 +597,96 @@ transport connection with a peer following <c>reconnect_timer</c> or <c>watchdog_timer</c> expiry.</p> </item> +<tag><c>{closed, Ref, Reason, Config}</c></tag> +<item> +<code> +Ref = transport_ref() +Config = {connect|listen, [transport_opt()]} +</code> + +<p> +Capabilities exchange has failed. <c>Reason</c> can be one of +the following.</p> + +<taglist> + +<tag><c>{'CER', Result, Caps, Pkt}</c></tag> +<item> +<code> +Result = ResultCode | {capabilities_cb, CB, ResultCode|discard} +Caps = #diameter_caps{} +Pkt = #diameter_packet{} +ResultCode = integer() +CB = evaluable() +</code> + +<p> +An incoming CER has been answered with the indicated result code or +discarded. +The capabilities record contains pairs of values for the the local +node and remote peer. +The packet record contains the CER in question. +In the case of rejection by a capabilities callback, the tuple +indicates the rejecting callback.</p> +</item> + +<tag><c>{'CER', Caps, {ResultCode, Pkt}}</c></tag> +<item> +<code> +ResultCode = integer() +Caps = #diameter_caps{} +Pkt = #diameter_packet{} +</code> + +<p> +An incoming CER contained errors and has been answered with the +indicated result code. +The capabilities record contains only values for the the local +node. +The packet record contains the CER in question.</p> +</item> + +<tag><c>{'CEA', Result, Caps, Pkt}</c></tag> +<item> +<code> +Result = integer() | atom() | {capabilities_cb, CB, ResultCode|discard} +Caps = #diameter_caps{} +Pkt = #diameter_packet{} +ResultCode = integer() +</code> + +<p> +An incoming CEA has been rejected for the indicated reason. +An integer-valued <c>Result</c> indicates the result code sent +by the peer. +The capabilities record contains pairs of values for the the local +node and remote peer. +The packet record contains the CEA in question. +In the case of rejection by a capabilities callback, the tuple +indicates the rejecting callback.</p> +</item> + +<tag><c>{'CEA', Caps, Pkt}</c></tag> +<item> +<code> +Caps = #diameter_caps{} +Pkt = #diameter_packet{} +</code> + +<p> +An incoming CER contained errors and has been rejected. +The capabilities record contains only values for the the local node. +The packet record contains the CEA in question.</p> +</item> + +</taglist> +</item> + </taglist> <p> For forward compatibility, a subscriber should be prepared to receive -<c>diameter_event.info</c> of forms other than those documented -above.</p> +info fields of forms other than the above.</p> <marker id="service_name"/> </item> @@ -683,6 +780,39 @@ in question.</p> AVP's used to construct outgoing CER/CEA messages. Any AVP specified takes precedence over a corresponding value specified for the service in question.</p> + +<p> +Specifying a capability as a transport option +may be particularly appropriate for Inband-Security-Id in case +TLS is desired over TCP as implemented by +<seealso marker="diameter_tcp">diameter_tcp(3)</seealso> but +not over SCTP as implemented by +<seealso marker="diameter_sctp">diameter_sctp(3)</seealso>.</p> +</item> + +<tag><c>{capabilities_cb, evaluable()}</c></tag> +<item> +<p> +A callback invoked upon reception of CER/CEA during capabilities +exchange in order to ask whether or not the connection should +be accepted. +Applied to the transport reference (as returned by <seealso +marker="#add_transport">add_transport/2</seealso>) and +<c>diameter_caps</c> record of the connection. +Returning <c>ok</c> accepts the connection. +Returning <c>integer()</c> causes an incoming +CER to be answered with the specified Result-Code. +Returning <c>discard</c> causes an incoming CER to +be discarded. +Returning <c>unknown</c> is equivalent to returning <c>3010</c>, +DIAMETER_UNKNOWN_PEER. +Returning anything but <c>ok</c> or a 2xxx series result +code causes the transport connection to be broken.</p> + +<p> +Multiple <c>capabilities_cb</c> options can be specified, in which +case the corresponding callbacks are applied until either all return +<c>ok</c> or one does not.</p> </item> <tag><c>{watchdog_timer, TwInit}</c></tag> diff --git a/lib/diameter/doc/src/diameter_compile.xml b/lib/diameter/doc/src/diameter_compile.xml index 72bac30709..60e08d41da 100644 --- a/lib/diameter/doc/src/diameter_compile.xml +++ b/lib/diameter/doc/src/diameter_compile.xml @@ -64,9 +64,10 @@ Defaults to the current working directory.</p> <item> <p> Specifies a directory to add to the code path. -Typically used to point at beam files corresponding to dictionaries -included by the one being compiled (using the <c>@includes</c> directive): -inclusion is a beam dependency, not an erl/hrl dependency.</p> +Use to point at beam files corresponding to dictionaries +inherited by the one being compiled using <c>@inherits</c> or +<c>--inherits</c>. +Inheritance is a beam dependency, not an erl/hrl dependency.</p> <p> Multiple <c>-i</c> options can be specified.</p> @@ -84,6 +85,31 @@ Supresses erl generation.</p> Supresses hrl generation.</p> </item> +<tag><![CDATA[--name <name>]]></tag> +<item> +<p> +Set <c>@name</c> in the dictionary file. +Overrides any setting in the file itself.</p> +</item> + +<tag><![CDATA[--prefix <prefix>]]></tag> +<item> +<p> +Set <c>@prefix</c> in the dictionary file. +Overrides any setting in the file itself.</p> +</item> + +<tag><![CDATA[--inherits <dict>]]></tag> +<item> +<p> +Append an <c>@inherits</c> to the dictionary file. +Specifying <c>'-'</c> as the dictionary has the effect of clearing +any previous inherits, effectively ignoring previous inherits.</p> + +<p> +Multiple <c>--inherits</c> options can be specified.</p> +</item> + </taglist> </item> diff --git a/lib/diameter/doc/src/diameter_soc.xml b/lib/diameter/doc/src/diameter_soc.xml index 4f8581a904..6b9ef9f756 100644 --- a/lib/diameter/doc/src/diameter_soc.xml +++ b/lib/diameter/doc/src/diameter_soc.xml @@ -57,9 +57,13 @@ including the P Flag in the AVP header.</p> <item> <p> -There is no TLS support. -It's unclear (aka uninvestigated) how TLS would impact -diameter but IPsec can be used without it needing to know.</p> +There is no TLS support over SCTP. +RFC 3588 requires that a Diameter server support TLS but in +practise this seems to mean TLS over SCTP since there are limitations +with running over SCTP: see RFC 6083 (DTLS over SCTP), which is a +response to RFC 3436 (TLS over SCTP). +The current RFC 3588 draft acknowledges this by equating +TLS with TLS/TCP and DTLS/SCTP but we do not yet support DTLS.</p> </item> <item> diff --git a/lib/diameter/doc/src/diameter_tcp.xml b/lib/diameter/doc/src/diameter_tcp.xml index a502e53972..e6b53383c0 100644 --- a/lib/diameter/doc/src/diameter_tcp.xml +++ b/lib/diameter/doc/src/diameter_tcp.xml @@ -43,7 +43,14 @@ It can be specified as the value of a transport_module option to <seealso marker="diameter#add_transport">diameter:add_transport/2</seealso> and implements the behaviour documented in -<seealso marker="diameter_transport">diameter_transport(3)</seealso>.</p> +<seealso marker="diameter_transport">diameter_transport(3)</seealso>. +TLS security is supported, both as an upgrade following +capabilities exchange as specified by RFC 3588 and +at connection establishment as in the current draft standard.</p> + +<p> +Note that the ssl application is required for TLS and must be started +before configuring TLS capability on diameter transports.</p> <marker id="start"/> </description> @@ -60,10 +67,15 @@ and implements the behaviour documented in <v>Type = connect | accept</v> <v>Ref = reference()</v> <v>Svc = #diameter_service{}</v> -<v>Opt = {raddr, ip_address()} | {rport, integer()} | term()</v> +<v>Opt = OwnOpt | SslOpt | OtherOpt</v> <v>Pid = pid()</v> <v>LAddr = ip_address()</v> <v>Reason = term()</v> +<v>OwnOpt = {raddr, ip_address()} + | {rport, integer()} + | {port, integer()}</v> +<v>SslOpt = {ssl_options, true | list()}</v> +<v>OtherOpt = term()</v> </type> <desc> @@ -74,17 +86,42 @@ marker="diameter_transport#start">diameter_transport(3)</seealso>.</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 not valid for a listening +and port for a connecting transport and are not valid for a listening transport. -Remaining options are any accepted by gen_tcp:connect/3 for -a connecting transport, or gen_tcp:listen/2 for a listening transport, -with the exception of <c>binary</c>, <c>packet</c> and <c>active</c>. +Option <c>ssl_options</c> must be specified for a transport +that must be able to support TLS: a value of <c>true</c> results in a +TLS handshake immediately upon connection establishment while +list() specifies options to be passed to ssl:connect/2 of ssl:ssl_accept/2 +after capabilities exchange if TLS is negotiated. +Remaining options are any accepted by ssl:connect/3 or gen_tcp:connect/3 for +a connecting transport, or ssl:listen/3 or gen_tcp:listen/2 for +a listening transport, depending on whether or not <c>{ssl_options, true}</c> +has been specified. +Options <c>binary</c>, <c>packet</c> and <c>active</c> cannot be specified. Also, option <c>port</c> can be specified for a listening transport to specify the local listening port, the default being the standardized 3868 if unspecified. Note that option <c>ip</c> specifies the local address.</p> <p> +An <c>ssl_options</c> list must be specified if and only if +the transport in question has specified an Inband-Security-Id +AVP with value TLS on the relevant call to +<seealso +marker="diameter#start_service">start_service/2</seealso> or +<seealso +marker="diameter#add_transport">add_transport/2</seealso>, +so that the transport process will receive notification of +whether or not to commence with a TLS handshake following capabilities +exchange. +Failing to specify an options list on a TLS-capable transport +for which TLS is negotiated will cause TLS handshake to fail. +Failing to specify TLS capability when <c>ssl_options</c> has been +specified will cause the transport process to wait for a notification +that will not be forthcoming, which will eventually cause the RFC 3539 +watchdog to take down the connection.</p> + +<p> If the service specifies more than one Host-IP-Address and option <c>ip</c> is unspecified then then the first of the service's addresses is used as the local address.</p> @@ -104,6 +141,7 @@ The returned local address list has length one.</p> <title>SEE ALSO</title> <p> +<seealso marker="diameter">diameter(3)</seealso>, <seealso marker="diameter_transport">diameter_transport(3)</seealso></p> </section> diff --git a/lib/diameter/doc/src/diameter_transport.xml b/lib/diameter/doc/src/diameter_transport.xml index 37cc871e75..087a90b099 100644 --- a/lib/diameter/doc/src/diameter_transport.xml +++ b/lib/diameter/doc/src/diameter_transport.xml @@ -143,6 +143,34 @@ connection. Pid is the pid() of the parent process.</p> </item> +<tag><c>{diameter, {tls, Ref, Type, Bool}}</c></tag> +<item> +<p> +Indication of whether or not capabilities exchange has selected +inband security using TLS. +Ref is a reference() that must be included in the +<c>{diameter, {tls, Ref}}</c> reply message to the transport's +parent process (see below). +Type is either <c>connect</c> or <c>accept</c> depending on +whether the process has been started for a connecting or listening +transport respectively. +Bool is a boolean() indicating whether or not the transport connection +should be upgraded to TLS.</p> + +<p> +If TLS is requested (Bool = true) then a connecting process should +initiate a TLS handshake with the peer and an accepting process should +prepare to accept a handshake. +A successful handshake should be followed by a <c>{diameter, {tls, Ref}}</c> +message to the parent process. +A failed handshake should cause the process to exit.</p> + +<p> +This message is only sent to a transport process over whose +<c>Inband-Security-Id</c> configuration has indicated support for +TLS.</p> +</item> + </taglist> <p> @@ -184,6 +212,16 @@ How the <c>transport_data</c> is used/interpreted is up to the transport module.</p> </item> +<tag><c>{diameter, {tls, Ref}}</c></tag> +<item> +<p> +Acknowledgment of a successful TLS handshake. +Ref is the reference() received in the +<c>{diameter, {tls, Ref, Type, Bool}}</c> message in response +to which the reply is sent. +A transport must exit if a handshake is not successful.</p> +</item> + </taglist> </section> diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl index d037e1044a..13a6c462af 100644 --- a/lib/diameter/include/diameter_gen.hrl +++ b/lib/diameter/include/diameter_gen.hrl @@ -40,14 +40,14 @@ encode_avps(Name, Rec) -> list_to_binary(encode(Name, Rec)) catch throw: {?MODULE, Reason} -> - diameter_dbg:log({encode, error}, + diameter_lib:log({encode, error}, ?MODULE, ?LINE, {Reason, Name, Rec}), erlang:error(list_to_tuple(Reason ++ [Name])); error: Reason -> Stack = erlang:get_stacktrace(), - diameter_dbg:log({encode, failure}, + diameter_lib:log({encode, failure}, ?MODULE, ?LINE, {Reason, Name, Rec, Stack}), @@ -159,7 +159,7 @@ d_rc(Name, {Avps, {Rec, [] = Failed}}) -> {Rec, Avps, Failed} catch throw: {?MODULE, {AvpName, Reason}} -> - diameter_dbg:log({decode, error}, + diameter_lib:log({decode, error}, ?MODULE, ?LINE, {AvpName, Reason, Rec}), @@ -260,7 +260,7 @@ d(Name, Avp, {Avps, Acc}) -> %% respond sensibly to. Log the occurence for traceability, %% but the peer will also receive info in the resulting %% answer-message. - diameter_dbg:log({decode, failure}, + diameter_lib:log({decode, failure}, ?MODULE, ?LINE, {Reason, Avp, erlang:get_stacktrace()}), diff --git a/lib/diameter/make/rules.mk.in b/lib/diameter/make/rules.mk.in index 6318f2bc9c..cd3c297d75 100644 --- a/lib/diameter/make/rules.mk.in +++ b/lib/diameter/make/rules.mk.in @@ -112,8 +112,6 @@ $(EBIN)/%.beam: $(ESRC)/%.erl # ---------------------------------------------------- # export VSN -# DOCSUPPORT = 1 - # TOPDOCDIR=../../../../doc DOCDIR = .. diff --git a/lib/diameter/src/compiler/.gitignore b/lib/diameter/src/.gitignore index d9f072e262..feeb378fd8 100644 --- a/lib/diameter/src/compiler/.gitignore +++ b/lib/diameter/src/.gitignore @@ -1,3 +1,2 @@ /depend.mk - diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index 6935eb053e..eea2aa894d 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -16,28 +16,225 @@ # # %CopyrightEnd% -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk -else +ifeq ($(ERL_TOP),) include $(DIAMETER_TOP)/make/target.mk include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk +else +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk endif # ---------------------------------------------------- -# Common Macros +# Application version # ---------------------------------------------------- -include subdirs.mk +include ../vsn.mk -SPECIAL_TARGETS = +VSN = $(DIAMETER_VSN) # ---------------------------------------------------- -# Default Subdir Targets +# Release directory specification # ---------------------------------------------------- -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/otp_subdir.mk + +RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) + +# Where to put/find things. +EBIN = ../ebin +INCDIR = ../include + +# Dumbed down to make 3.80. In 3.81 and later it's just $(realpath $(EBIN)). +ABS_EBIN := $(shell cd $(EBIN) && pwd) + +# Where make should look for dependencies. +VPATH = .:base:compiler:transport:gen + +# ---------------------------------------------------- +# Target specs +# ---------------------------------------------------- + +include modules.mk + +DICT_MODULES = $(DICTS:%=gen/diameter_gen_%) +DICT_ERLS = $(DICT_MODULES:%=%.erl) +DICT_HRLS = $(DICT_MODULES:%=%.hrl) + +# Modules to build before compiling dictionaries. +COMPILER_MODULES = $(filter compiler/%, $(CT_MODULES)) + +# All handwritten modules. +MODULES = \ + $(RT_MODULES) \ + $(CT_MODULES) + +# Modules whose names are inserted into the app file. +APP_MODULES = \ + $(RT_MODULES) \ + $(DICT_MODULES) + +# Modules for which to build beams. +TARGET_MODULES = \ + $(APP_MODULES) \ + $(CT_MODULES) + +# What to build for the 'opt' target. +TARGET_FILES = \ + $(patsubst %,$(EBIN)/%.$(EMULATOR),$(notdir $(TARGET_MODULES))) \ + $(APP_TARGET) \ + $(APPUP_TARGET) + +# Subdirectories of src to release modules into. +TARGET_DIRS = $(sort $(dir $(TARGET_MODULES))) + +APP_FILE = diameter.app +APP_SRC = $(APP_FILE).src +APP_TARGET = $(EBIN)/$(APP_FILE) + +APPUP_FILE = diameter.appup +APPUP_SRC = $(APPUP_FILE).src +APPUP_TARGET = $(EBIN)/$(APPUP_FILE) + +# ---------------------------------------------------- +# Flags +# ---------------------------------------------------- + +ifeq ($(TYPE),debug) +ERL_COMPILE_FLAGS += -Ddebug +endif + +ERL_COMPILE_FLAGS += \ + +'{parse_transform,sys_pre_attributes}' \ + +'{attribute,insert,app_vsn,$(APP_VSN)}' \ + +warn_export_vars \ + +warn_unused_vars \ + -pa $(ABS_EBIN) \ + -I $(INCDIR) \ + -I gen +# -pa is to be able to include_lib from the include directory: the +# path must contain the application name. + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +# erl/hrl from dictionary file. +gen/diameter_gen_%.erl gen/diameter_gen_%.hrl: dict/%.dia + ../bin/diameterc -o gen -i $(EBIN) $< + +opt: $(TARGET_FILES) + +debug: + @$(MAKE) TYPE=debug opt + +# Generate the app file. +$(APP_TARGET): $(APP_SRC) ../vsn.mk modules.mk + M=`echo $(notdir $(APP_MODULES)) | tr ' ' ,`; \ + sed -e 's;%VSN%;$(VSN);' \ + -e "s;%MODULES%;$$M;" \ + $< > $@ + +$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +app: $(APP_TARGET) $(APPUP_TARGET) +dict: $(DICT_ERLS) + +docs: + +list = echo $(1):; echo $($(1)) | tr ' ' '\n' | sort | sed 's@^@ @' + +info: + @echo ======================================== + @$(call list,DICTS) + @echo + @$(call list,RT_MODULES) + @echo + @$(call list,CT_MODULES) + @echo + @$(call list,TARGET_MODULES) + @echo + @$(call list,TARGET_DIRS) + @echo + @$(call list,EXTERNAL_HRLS) + @echo + @$(call list,INTERNAL_HRLS) + @echo + @$(call list,EXAMPLES) + @echo + @$(call list,BINS) + @echo ======================================== + +clean: + rm -f $(TARGET_FILES) $(DICT_ERLS) $(DICT_HRLS) + rm -f depend.mk + +# ---------------------------------------------------- +# Release targets +# ---------------------------------------------------- + +ifeq ($(ERL_TOP),) +include $(DIAMETER_TOP)/make/release_targets.mk else -include $(DIAMETER_TOP)/make/subdir.mk +include $(ERL_TOP)/make/otp_release_targets.mk endif -#include ../make/subdir.mk + +# Can't $(INSTALL_DIR) more than one directory at a time on Solaris. + +release_spec: opt + for d in bin ebin examples include src/dict $(TARGET_DIRS:%/=src/%); do \ + $(INSTALL_DIR) $(RELSYSDIR)/$$d; \ + done + $(INSTALL_SCRIPT) $(BINS:%=../bin/%) $(RELSYSDIR)/bin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(EXAMPLES:%=../examples/%) $(RELSYSDIR)/examples + $(INSTALL_DATA) $(EXTERNAL_HRLS:%=../include/%) $(DICT_HRLS) \ + $(RELSYSDIR)/include + $(INSTALL_DATA) $(DICTS:%=dict/%.dia) $(RELSYSDIR)/src/dict + $(MAKE) $(TARGET_DIRS:%/=release_src_%) + +$(TARGET_DIRS:%/=release_src_%): release_src_%: + $(INSTALL_DATA) $(filter $*/%,$(TARGET_MODULES:%=%.erl) \ + $(INTERNAL_HRLS)) \ + $(RELSYSDIR)/src/$* + +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: \ + $(EBIN)/diameter_gen_base_rfc3588.$(EMULATOR) + +gen/diameter_gen_base_rfc3588.erl gen/diameter_gen_base_rfc3588.hrl: \ + $(COMPILER_MODULES:compiler/%=$(EBIN)/%.$(EMULATOR)) + +$(DICT_MODULES:gen/%=$(EBIN)/%.$(EMULATOR)): \ + $(INCDIR)/diameter.hrl \ + $(INCDIR)/diameter_gen.hrl + +depend: depend.mk + +# Generate dependencies makefile. +depend.mk: depend.sed $(MODULES:%=%.erl) Makefile + (for f in $(MODULES); do \ + (echo $$f; cat $$f.erl) | sed -f $<; \ + done) \ + > $@ + +-include depend.mk + +.PRECIOUS: $(DICT_ERLS) $(DICT_HRLS) +.PHONY: app clean depend dict info release_subdir +.PHONY: debug opt release_docs_spec release_spec +.PHONY: $(TARGET_DIRS:%/=%) $(TARGET_DIRS:%/=release_src_%) + +# ---------------------------------------------------- +# Targets using secondary expansion (make >= 3.81) +# ---------------------------------------------------- + +.SECONDEXPANSION: + +# Make beams from a subdirectory. +$(TARGET_DIRS:%/=%): \ + $$(patsubst $$@/%,$(EBIN)/%.$(EMULATOR),$$(filter $$@/%,$(TARGET_MODULES))) diff --git a/lib/diameter/src/app/.gitignore b/lib/diameter/src/app/.gitignore deleted file mode 100644 index d388e61877..0000000000 --- a/lib/diameter/src/app/.gitignore +++ /dev/null @@ -1,6 +0,0 @@ - -/diameter_gen_*.erl -/diameter_gen_*.hrl -/depend.mk -/diameter.mk - diff --git a/lib/diameter/src/app/Makefile b/lib/diameter/src/app/Makefile deleted file mode 100644 index a75c70d71c..0000000000 --- a/lib/diameter/src/app/Makefile +++ /dev/null @@ -1,212 +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% -# -# - -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/target.mk -EBIN = ../../ebin -include $(ERL_TOP)/make/$(TARGET)/otp.mk -else -include $(DIAMETER_TOP)/make/target.mk -EBIN = ../../ebin -include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk -endif - - - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- - -include ../../vsn.mk - -VSN=$(DIAMETER_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- - -RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) - -INCDIR = ../../include - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -include modules.mk - -SPEC_MODULES = \ - $(SPEC_FILES:%.dia=%) - -SPEC_ERL_FILES = \ - $(SPEC_FILES:%.dia=%.erl) - -SPEC_HRL_FILES = \ - $(SPEC_FILES:%.dia=%.hrl) - -MODULES = \ - $(RUNTIME_MODULES) \ - $(HELP_MODULES) - -APP_MODULES = \ - $(RUNTIME_MODULES) \ - $(SPEC_MODULES) - -TARGET_MODULES = \ - $(APP_MODULES) \ - $(HELP_MODULES) - -TARGET_FILES = \ - $(TARGET_MODULES:%=$(EBIN)/%.$(EMULATOR)) \ - $(APP_TARGET) \ - $(APPUP_TARGET) - -ESCRIPT_FILES = \ - ../../bin/diameterc - -APP_FILE = diameter.app -APP_SRC = $(APP_FILE).src -APP_TARGET = $(EBIN)/$(APP_FILE) - -APPUP_FILE = diameter.appup -APPUP_SRC = $(APPUP_FILE).src -APPUP_TARGET = $(EBIN)/$(APPUP_FILE) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ifeq ($(TYPE),debug) -ERL_COMPILE_FLAGS += -Ddebug -endif - -include diameter.mk - -ERL_COMPILE_FLAGS += \ - $(DIAMETER_ERL_COMPILE_FLAGS) \ - -I$(INCDIR) - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug: - @$(MAKE) TYPE=debug opt - -opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) $(SPEC_ERL_FILES) $(SPEC_HRL_FILES) - rm -f $(APP_TARGET) $(APPUP_TARGET) - rm -f errs core *~ diameter_gen_*.forms diameter_gen_*.spec - rm -f depend.mk - -docs: - -info: - @echo "" - @echo "SPEC_FILES = $(FILES)" - @echo "MODULES = $(MODULES)" - @echo "" - @echo "EXTERNAL_HRL_FILES = $(EXTERNAL_HRL_FILES)" - @echo "INTERNAL_HRL_FILES = $(INTERNAL_HRL_FILES)" - @echo "" - @echo "EXAMPLE_FILES = $(EXAMPLE_FILES)" - @echo "" - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -# Generate the app file and then modules into in. This shouldn't know -# about ../transport but good enough for now. -$(APP_TARGET): $(APP_SRC) \ - ../../vsn.mk \ - modules.mk \ - ../transport/modules.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ - M=`echo $(APP_MODULES) | sed -e 's/^ *//' -e 's/ *$$//' -e 'y/ /,/'`; \ - echo "/%APP_MODULES%/s//$$M/;w;q" | tr ';' '\n' \ - | ed -s $@ - $(MAKE) -C ../transport $(APP_TARGET) APP_TARGET=$(APP_TARGET) - -$(APPUP_TARGET): $(APPUP_SRC) ../../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ - -compiler: - $(MAKE) -C ../$@ - -app: $(APP_TARGET) $(APPUP_TARGET) - -# erl/hrl from application spec -diameter_gen_%.erl diameter_gen_%.hrl: diameter_gen_%.dia - ../../bin/diameterc -i $(EBIN) -o $(@D) $< - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- - -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/otp_release_targets.mk -else -include $(DIAMETER_TOP)/make/release_targets.mk -endif - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/bin - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DIR) $(RELSYSDIR)/src/app - $(INSTALL_DIR) $(RELSYSDIR)/include - $(INSTALL_DIR) $(RELSYSDIR)/examples - $(INSTALL_SCRIPT) $(ESCRIPT_FILES) $(RELSYSDIR)/bin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(MODULES:%=%.erl) $(SPEC_ERL_FILES) $(RELSYSDIR)/src/app - $(INSTALL_DATA) $(SPEC_FILES) $(RELSYSDIR)/src/app - $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src/app - $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(SPEC_HRL_FILES) $(RELSYSDIR)/include - $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples - -release_docs_spec: - -# ---------------------------------------------------- -# Dependencies -# ---------------------------------------------------- - -$(SPEC_MODULES:%=$(EBIN)/%.$(EMULATOR)): \ - $(EBIN)/diameter_exprecs.$(EMULATOR) \ - $(DIAMETER_TOP)/include/diameter.hrl \ - $(DIAMETER_TOP)/include/diameter_gen.hrl - -depend: depend.mk - -# Generate dependencies makefile. It's assumed that the compile target -# has already been made since it's currently not smart enough to not -# force a rebuild of those beams dependent on generated hrls, and this -# is a no-no at make release. -depend.mk: depend.sed $(MODULES:%=%.erl) Makefile - (for f in $(MODULES); do \ - sed -f $< $$f.erl | sed "s@/@/$$f@"; \ - done) \ - > $@ - --include depend.mk - -.PRECIOUS: $(SPEC_ERL_FILES) $(SPEC_HRL_FILES) -.PHONY: app clean debug depend info opt compiler release_spec release_docs_spec diff --git a/lib/diameter/src/app/diameter.mk.in b/lib/diameter/src/app/diameter.mk.in deleted file mode 100644 index c161064303..0000000000 --- a/lib/diameter/src/app/diameter.mk.in +++ /dev/null @@ -1,47 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %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% - -DIAMETER_TOP = @DIAMETER_TOP@ - -# ifneq ($(PREFIX),) -# ifeq ($(TESTROOT),) -# TESTROOT = $(PREFIX) -# endif -# endif - -ifeq ($(USE_DIAMETER_TEST_CODE), true) -ERL_COMPILE_FLAGS += -DDIAMETER_TEST_CODE=mona_lisa_spelar_doom -endif - -ifeq ($(USE_DIAMETER_HIPE), true) -ERL_COMPILE_FLAGS += +native -endif - -ifeq ($(WARN_UNUSED_WARS), true) -ERL_COMPILE_FLAGS += +warn_unused_vars -endif - -DIAMETER_APP_VSN_COMPILE_FLAGS = \ - +'{parse_transform,sys_pre_attributes}' \ - +'{attribute,insert,app_vsn,$(APP_VSN)}' - -DIAMETER_ERL_COMPILE_FLAGS += \ - -pa $(DIAMETER_TOP)/ebin \ - $(DIAMETER_APP_VSN_COMPILE_FLAGS) - diff --git a/lib/diameter/src/app/diameter_gen_base_accounting.dia b/lib/diameter/src/app/diameter_gen_base_accounting.dia deleted file mode 100644 index 64e95dddb5..0000000000 --- a/lib/diameter/src/app/diameter_gen_base_accounting.dia +++ /dev/null @@ -1,68 +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% -;; - -@id 3 -@prefix diameter_base_accounting -@vendor 0 IETF - -@inherits diameter_gen_base_rfc3588 - -@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 ] - [ 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-Reporting-Host ] - [ Acct-Interim-Interval ] - [ Accounting-Realtime-Required ] - [ Origin-State-Id ] - [ Event-Timestamp ] - * [ Proxy-Info ] - * [ AVP ] diff --git a/lib/diameter/src/app/diameter_gen_base_rfc3588.dia b/lib/diameter/src/app/diameter_gen_base_rfc3588.dia deleted file mode 100644 index 4a12e21acd..0000000000 --- a/lib/diameter/src/app/diameter_gen_base_rfc3588.dia +++ /dev/null @@ -1,413 +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% -;; - -@id 0 -@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 - E2E-Sequence 300 Grouped 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 } - - DPA ::= < Diameter Header: 282 > - { Result-Code } - { Origin-Host } - { Origin-Realm } - [ Error-Message ] - * [ Failed-AVP ] - - DWR ::= < Diameter Header: 280, REQ > - { Origin-Host } - { Origin-Realm } - [ Origin-State-Id ] - - DWA ::= < Diameter Header: 280 > - { Result-Code } - { Origin-Host } - { Origin-Realm } - [ Error-Message ] - * [ Failed-AVP ] - [ Origin-State-Id ] - - answer-message ::= < Diameter Header: code, ERR [PXY] > - 0*1< Session-Id > - { Origin-Host } - { Origin-Realm } - { Result-Code } - [ Origin-State-Id ] - [ Error-Reporting-Host ] - [ 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 ] - [ 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-Reporting-Host ] - [ 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 - - DIAMETER_LOGOUT 1 - DIAMETER_SERVICE_NOT_PROVIDED 2 - DIAMETER_BAD_ANSWER 3 - DIAMETER_ADMINISTRATIVE 4 - DIAMETER_LINK_BROKEN 5 - DIAMETER_AUTH_EXPIRED 6 - DIAMETER_USER_MOVED 7 - DIAMETER_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 - -@result_code Result-Code - -;; 7.1.1. Informational - DIAMETER_MULTI_ROUND_AUTH 1001 - -;; 7.1.2. Success - DIAMETER_SUCCESS 2001 - DIAMETER_LIMITED_SUCCESS 2002 - -;; 7.1.3. Protocol Errors - DIAMETER_COMMAND_UNSUPPORTED 3001 - DIAMETER_UNABLE_TO_DELIVER 3002 - DIAMETER_REALM_NOT_SERVED 3003 - DIAMETER_TOO_BUSY 3004 - DIAMETER_LOOP_DETECTED 3005 - DIAMETER_REDIRECT_INDICATION 3006 - DIAMETER_APPLICATION_UNSUPPORTED 3007 - DIAMETER_INVALID_HDR_BITS 3008 - DIAMETER_INVALID_AVP_BITS 3009 - DIAMETER_UNKNOWN_PEER 3010 - -;; 7.1.4. Transient Failures - DIAMETER_AUTHENTICATION_REJECTED 4001 - DIAMETER_OUT_OF_SPACE 4002 - ELECTION_LOST 4003 - -;; 7.1.5. Permanent Failures - DIAMETER_AVP_UNSUPPORTED 5001 - DIAMETER_UNKNOWN_SESSION_ID 5002 - DIAMETER_AUTHORIZATION_REJECTED 5003 - DIAMETER_INVALID_AVP_VALUE 5004 - DIAMETER_MISSING_AVP 5005 - DIAMETER_RESOURCES_EXCEEDED 5006 - DIAMETER_CONTRADICTING_AVPS 5007 - DIAMETER_AVP_NOT_ALLOWED 5008 - DIAMETER_AVP_OCCURS_TOO_MANY_TIMES 5009 - DIAMETER_NO_COMMON_APPLICATION 5010 - DIAMETER_UNSUPPORTED_VERSION 5011 - DIAMETER_UNABLE_TO_COMPLY 5012 - DIAMETER_INVALID_BIT_IN_HEADER 5013 - DIAMETER_INVALID_AVP_LENGTH 5014 - DIAMETER_INVALID_MESSAGE_LENGTH 5015 - DIAMETER_INVALID_AVP_BIT_COMBO 5016 - DIAMETER_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 > - 1* { Vendor-Id } - [ Auth-Application-Id ] - [ Acct-Application-Id ] - -;; The E2E-Sequence AVP is defined in RFC 3588 as Grouped, but -;; there is no definition of the group - only an informal text stating -;; that there should be a nonce (an OctetString) and a counter -;; (integer) -;; - E2E-Sequence ::= <AVP Header: 300 > - 2* { AVP } diff --git a/lib/diameter/src/app/modules.mk b/lib/diameter/src/app/modules.mk deleted file mode 100644 index c133e6f64e..0000000000 --- a/lib/diameter/src/app/modules.mk +++ /dev/null @@ -1,70 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %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% - -SPEC_FILES = \ - diameter_gen_base_rfc3588.dia \ - diameter_gen_base_accounting.dia \ - diameter_gen_relay.dia - -RUNTIME_MODULES = \ - diameter \ - diameter_app \ - diameter_capx \ - diameter_config \ - diameter_codec \ - diameter_dict \ - diameter_lib \ - diameter_misc_sup \ - diameter_peer \ - diameter_peer_fsm \ - diameter_peer_fsm_sup \ - diameter_reg \ - diameter_service \ - diameter_service_sup \ - diameter_session \ - diameter_stats \ - diameter_sup \ - diameter_sync \ - diameter_types \ - diameter_watchdog \ - diameter_watchdog_sup - -HELP_MODULES = \ - diameter_callback \ - diameter_exprecs \ - diameter_dbg \ - diameter_info - -INTERNAL_HRL_FILES = \ - diameter_internal.hrl \ - diameter_types.hrl - -EXTERNAL_HRL_FILES = \ - ../../include/diameter.hrl \ - ../../include/diameter_gen.hrl - -EXAMPLE_FILES = \ - ../../examples/GNUmakefile \ - ../../examples/peer.erl \ - ../../examples/client.erl \ - ../../examples/client_cb.erl \ - ../../examples/server.erl \ - ../../examples/server_cb.erl \ - ../../examples/relay.erl \ - ../../examples/relay_cb.erl diff --git a/lib/diameter/src/app/diameter.app.src b/lib/diameter/src/base/diameter.app.src index a806b5c78a..c092fdb022 100644 --- a/lib/diameter/src/app/diameter.app.src +++ b/lib/diameter/src/base/diameter.app.src @@ -20,7 +20,7 @@ {application, diameter, [{description, "Diameter protocol"}, {vsn, "%VSN%"}, - {modules, [%APP_MODULES%,%TRANSPORT_MODULES%]}, + {modules, [%MODULES%]}, {registered, []}, {applications, [stdlib, kernel]}, {env, []}, diff --git a/lib/diameter/src/app/diameter.appup.src b/lib/diameter/src/base/diameter.appup.src index 6d8ceadb92..6d8ceadb92 100644 --- a/lib/diameter/src/app/diameter.appup.src +++ b/lib/diameter/src/base/diameter.appup.src diff --git a/lib/diameter/src/app/diameter.erl b/lib/diameter/src/base/diameter.erl index 2f721421d8..2f721421d8 100644 --- a/lib/diameter/src/app/diameter.erl +++ b/lib/diameter/src/base/diameter.erl diff --git a/lib/diameter/src/app/diameter_app.erl b/lib/diameter/src/base/diameter_app.erl index 600f7ff04d..600f7ff04d 100644 --- a/lib/diameter/src/app/diameter_app.erl +++ b/lib/diameter/src/base/diameter_app.erl diff --git a/lib/diameter/src/app/diameter_callback.erl b/lib/diameter/src/base/diameter_callback.erl index 6d5c8cdca1..6d5c8cdca1 100644 --- a/lib/diameter/src/app/diameter_callback.erl +++ b/lib/diameter/src/base/diameter_callback.erl diff --git a/lib/diameter/src/app/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl index aa5318e79d..842a9e6103 100644 --- a/lib/diameter/src/app/diameter_capx.erl +++ b/lib/diameter/src/base/diameter_capx.erl @@ -57,11 +57,12 @@ -include("diameter_types.hrl"). -include("diameter_gen_base_rfc3588.hrl"). --define(SUCCESS, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). --define(NOAPP, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_APPLICATION'). --define(NOSECURITY, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_SECURITY'). +-define(SUCCESS, 2001). %% DIAMETER_SUCCESS +-define(NOAPP, 5010). %% DIAMETER_NO_COMMON_APPLICATION +-define(NOSECURITY, 5017). %% DIAMETER_NO_COMMON_SECURITY -define(NO_INBAND_SECURITY, 0). +-define(TLS, 1). %% =========================================================================== @@ -80,7 +81,7 @@ recv_CER(CER, Svc) -> try_it([fun rCER/2, CER, Svc]). -spec recv_CEA(#diameter_base_CEA{}, #diameter_service{}) - -> tried({['Unsigned32'()], #diameter_caps{}}). + -> tried({['Unsigned32'()], ['Unsigned32'()], #diameter_caps{}}). recv_CEA(CEA, Svc) -> try_it([fun rCEA/2, CEA, Svc]). @@ -95,7 +96,7 @@ try_it([Fun | Args]) -> try apply(Fun, Args) of T -> {ok, T} catch - throw: ?FAILURE(Reason) -> {error, {Reason, Args}} + throw: ?FAILURE(Reason) -> {error, Reason} end. %% mk_caps/2 @@ -126,10 +127,11 @@ mk_caps(Caps0, Opts) -> set_cap({Key, _}, _) -> ?THROW({duplicate, Key}). -cap(K, V) when K == 'Origin-Host'; - K == 'Origin-Realm'; - K == 'Vendor-Id'; - K == 'Product-Name' -> +cap(K, V) + when K == 'Origin-Host'; + K == 'Origin-Realm'; + K == 'Vendor-Id'; + K == 'Product-Name' -> V; cap('Host-IP-Address', Vs) @@ -139,11 +141,8 @@ cap('Host-IP-Address', Vs) cap('Firmware-Revision', V) -> [V]; -%% Not documented but accept it as long as it's what we support. -cap('Inband-Security-Id', [0] = Vs) -> %% NO_INBAND_SECURITY - Vs; - -cap(K, Vs) when K /= 'Inband-Security-Id', is_list(Vs) -> +cap(_, Vs) + when is_list(Vs) -> Vs; cap(K, V) -> @@ -161,28 +160,10 @@ ipaddr(A) -> %% %% Build a CER record to send to a remote peer. -bCER(#diameter_caps{origin_host = Host, - origin_realm = Realm, - host_ip_address = Addrs, - vendor_id = Vid, - product_name = Name, - origin_state_id = OSI, - supported_vendor_id = SVid, - auth_application_id = AuId, - acct_application_id = AcId, - vendor_specific_application_id = VSA, - firmware_revision = Rev}) -> - #diameter_base_CER{'Origin-Host' = Host, - 'Origin-Realm' = Realm, - 'Host-IP-Address' = Addrs, - 'Vendor-Id' = Vid, - 'Product-Name' = Name, - 'Origin-State-Id' = OSI, - 'Supported-Vendor-Id' = SVid, - 'Auth-Application-Id' = AuId, - 'Acct-Application-Id' = AcId, - 'Vendor-Specific-Application-Id' = VSA, - 'Firmware-Revision' = Rev}. +%% 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))]). %% rCER/2 %% @@ -219,19 +200,16 @@ bCER(#diameter_caps{origin_host = Host, %% That is, each side sends all of its capabilities and is responsible for %% not sending commands that the peer doesn't support. -%% TODO: Make it an option to send only common applications in CEA to -%% allow backwards compatibility, and also because there are likely -%% servers that expect this. Or maybe a callback. - %% 6.10. Inband-Security-Id AVP %% %% NO_INBAND_SECURITY 0 %% This peer does not support TLS. This is the default value, if the %% AVP is omitted. +%% +%% TLS 1 +%% This node supports TLS security, as defined by [TLS]. rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> - #diameter_base_CER{'Inband-Security-Id' = RIS} - = CER, #diameter_base_CEA{} = CEA = cea_from_cer(bCER(LCaps)), @@ -241,59 +219,81 @@ rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> {SApps, RCaps, - build_CEA([] == SApps, - RIS, - lists:member(?NO_INBAND_SECURITY, RIS), - CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS, - 'Inband-Security-Id' = []})}. - -%% TODO: 5.3 of RFC3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION -%% in the CEA and SHOULD disconnect the transport. However, we have -%% no way to guarantee the send before disconnecting. + build_CEA(SApps, + LCaps, + RCaps, + CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}. -build_CEA(true, _, _, CEA) -> +build_CEA([], _, _, CEA) -> CEA#diameter_base_CEA{'Result-Code' = ?NOAPP}; -build_CEA(false, [_|_], false, CEA) -> - CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY}; -build_CEA(false, [_|_], true, CEA) -> - CEA#diameter_base_CEA{'Inband-Security-Id' = [?NO_INBAND_SECURITY]}; -build_CEA(false, [], false, CEA) -> - CEA. + +build_CEA(_, LCaps, RCaps, CEA) -> + case common_security(LCaps, RCaps) of + [] -> + CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY}; + [_] = IS -> + CEA#diameter_base_CEA{'Inband-Security-Id' = IS} + end. + +%% common_security/2 + +common_security(#diameter_caps{inband_security_id = LS}, + #diameter_caps{inband_security_id = RS}) -> + cs(LS, RS). + +%% Unspecified is equivalent to NO_INBAND_SECURITY. +cs([], RS) -> + cs([?NO_INBAND_SECURITY], RS); +cs(LS, []) -> + cs(LS, [?NO_INBAND_SECURITY]); + +%% Agree on TLS if both parties support it. When sending CEA, this is +%% to ensure the peer is clear that we will be expecting a TLS +%% handshake since there is no ssl:maybe_accept that would allow the +%% peer to choose between TLS or not upon reception of our CEA. When +%% receiving CEA it deals with a server that isn't explicit about its choice. +%% TODO: Make the choice configurable. +cs(LS, RS) -> + Is = ordsets:to_list(ordsets:intersection(ordsets:from_list(LS), + ordsets:from_list(RS))), + case lists:member(?TLS, Is) of + true -> + [?TLS]; + false when [] == Is -> + Is; + false -> + [hd(Is)] %% probably NO_INBAND_SECURITY + end. +%% The only two values defined by RFC 3588 are NO_INBAND_SECURITY and +%% TLS but don't enforce this. In theory this allows some other +%% security mechanism we don't have to know about, although in +%% practice something there may be a need for more synchronization +%% than notification by way of an event subscription offers. %% cea_from_cer/1 +%% 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:'#info-'(diameter_base_CEA, {index, Field}) of - N -> - setelement(N, CEA, ?BASE:'#get-'(Field, CER)) + try ?BASE:'#get-'(Field, CER) of + V -> ?BASE:'#set-'({Field, V}, CEA) catch - error: _ -> - CEA + error: _ -> CEA end. - + %% rCEA/2 -rCEA(CEA, #diameter_service{capabilities = LCaps} = Svc) - when is_record(CEA, diameter_base_CEA) -> - #diameter_base_CEA{'Result-Code' = RC} - = CEA, - - RC == ?SUCCESS orelse ?THROW({'Result-Code', RC}), - +rCEA(CEA, #diameter_service{capabilities = LCaps} = Svc) -> RCaps = capx_to_caps(CEA), SApps = common_applications(LCaps, RCaps, Svc), + IS = common_security(LCaps, RCaps), - [] == SApps andalso ?THROW({no_common_apps, LCaps, RCaps}), - - {SApps, RCaps}; - -rCEA(CEA, _Svc) -> - ?THROW({invalid, CEA}). + {SApps, IS, RCaps}. %% capx_to_caps/1 diff --git a/lib/diameter/src/app/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl index d88f42fb7c..fe1212b7e0 100644 --- a/lib/diameter/src/app/diameter_codec.erl +++ b/lib/diameter/src/base/diameter_codec.erl @@ -190,26 +190,13 @@ encode_avps(Avps) -> %% msg_header/3 -msg_header(Mod, MsgName, Header) -> - {Code, Flags, ApplId} = h(Mod, MsgName, Header), - {Code, p(Flags, Header), ApplId}. - -%% 6.2 of 3588 requires the same 'P' bit on an answer as on the -%% request. - -p(Flags, #diameter_header{is_request = true, - is_proxiable = P}) -> - Flags band (2#10110000 bor choose(P, 2#01000000, 0)); -p(Flags, _) -> - Flags. - -h(Mod, 'answer-message' = MsgName, Header) -> +msg_header(Mod, 'answer-message' = MsgName, Header) -> ?BASE = Mod, #diameter_header{cmd_code = Code} = Header, {_, Flags, ApplId} = ?BASE:msg_header(MsgName), {Code, Flags, ApplId}; -h(Mod, MsgName, _) -> +msg_header(Mod, MsgName, _) -> Mod:msg_header(MsgName). %% rec2msg/2 @@ -554,8 +541,3 @@ pack_avp(Code, Flags, Vid, Sz, Bin) -> pack_avp(Code, Flags, Sz, Bin) -> Length = Sz + 8, <<Code:32, Flags:8, Length:24, Bin/binary>>. - -%% =========================================================================== - -choose(true, X, _) -> X; -choose(false, _, X) -> X. diff --git a/lib/diameter/src/app/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl index a6b48fe65b..a6b48fe65b 100644 --- a/lib/diameter/src/app/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl diff --git a/lib/diameter/src/app/diameter_dbg.erl b/lib/diameter/src/base/diameter_dbg.erl index 5b0ac3a3b6..5b0ac3a3b6 100644 --- a/lib/diameter/src/app/diameter_dbg.erl +++ b/lib/diameter/src/base/diameter_dbg.erl diff --git a/lib/diameter/src/app/diameter_dict.erl b/lib/diameter/src/base/diameter_dict.erl index 3b9ba00a3f..3b9ba00a3f 100644 --- a/lib/diameter/src/app/diameter_dict.erl +++ b/lib/diameter/src/base/diameter_dict.erl diff --git a/lib/diameter/src/app/diameter_info.erl b/lib/diameter/src/base/diameter_info.erl index 39d32d07cd..39d32d07cd 100644 --- a/lib/diameter/src/app/diameter_info.erl +++ b/lib/diameter/src/base/diameter_info.erl diff --git a/lib/diameter/src/app/diameter_internal.hrl b/lib/diameter/src/base/diameter_internal.hrl index 63b35550a8..63b35550a8 100644 --- a/lib/diameter/src/app/diameter_internal.hrl +++ b/lib/diameter/src/base/diameter_internal.hrl diff --git a/lib/diameter/src/app/diameter_lib.erl b/lib/diameter/src/base/diameter_lib.erl index 362d593b24..362d593b24 100644 --- a/lib/diameter/src/app/diameter_lib.erl +++ b/lib/diameter/src/base/diameter_lib.erl diff --git a/lib/diameter/src/app/diameter_misc_sup.erl b/lib/diameter/src/base/diameter_misc_sup.erl index 4e40476f14..4e40476f14 100644 --- a/lib/diameter/src/app/diameter_misc_sup.erl +++ b/lib/diameter/src/base/diameter_misc_sup.erl diff --git a/lib/diameter/src/app/diameter_peer.erl b/lib/diameter/src/base/diameter_peer.erl index 3e78c4caef..3e78c4caef 100644 --- a/lib/diameter/src/app/diameter_peer.erl +++ b/lib/diameter/src/base/diameter_peer.erl diff --git a/lib/diameter/src/app/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index 0252fb3809..fae5d763dc 100644 --- a/lib/diameter/src/app/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -52,7 +52,11 @@ -define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU'). -define(REBOOT, ?'DIAMETER_BASE_DISCONNECT-CAUSE_REBOOTING'). --define(LOOP_TIMEOUT, 2000). +-define(NO_INBAND_SECURITY, 0). +-define(TLS, 1). + +%% A 2xxx series Result-Code. Not necessarily 2001. +-define(IS_SUCCESS(N), 2 == (N) div 1000). %% RFC 3588: %% @@ -139,9 +143,12 @@ init(T) -> proc_lib:init_ack({ok, self()}), gen_server:enter_loop(?MODULE, [], i(T)). -i({WPid, {M, _} = T, Opts, #diameter_service{capabilities = Caps} = Svc0}) -> +i({WPid, T, Opts, #diameter_service{capabilities = Caps} = Svc0}) -> putr(dwa, dwa(Caps)), - {ok, TPid, Svc} = start_transport(T, Opts, Svc0), + {M, Ref} = T, + {[Ts], Rest} = proplists:split(Opts, [capabilities_cb]), + putr(capabilities_cb, {Ref, [F || {_,F} <- Ts]}), + {ok, TPid, Svc} = start_transport(T, Rest, Svc0), erlang:monitor(process, TPid), erlang:monitor(process, WPid), #state{parent = WPid, @@ -195,12 +202,13 @@ handle_info(T, #state{} = State) -> ?LOG(stop, T), x(T, State) catch - throw: {?MODULE, close = C, Reason} -> - ?LOG(C, {Reason, T}), - x(Reason, State); - throw: {?MODULE, abort, Reason} -> + {?MODULE, Tag, Reason} -> + ?LOG(Tag, {Reason, T}), {stop, {shutdown, Reason}, State} end. +%% The form of the exception caught here is historical. It's +%% significant that it's not a 2-tuple, as in ?FAILURE(Reason), +%% since these are caught elsewhere. x(Reason, #state{} = S) -> close_wd(Reason, S), @@ -225,6 +233,9 @@ putr(Key, Val) -> getr(Key) -> get({?MODULE, Key}). +eraser(Key) -> + erase({?MODULE, Key}). + %% transition/2 %% Connection to peer. @@ -281,10 +292,9 @@ transition(shutdown, _) -> %% DPR already send: ensure expected timeout %% Request to close the transport connection. transition({close = T, Pid}, #state{parent = Pid, - transport = TPid} - = S) -> + transport = TPid}) -> diameter_peer:close(TPid), - close(T,S); + {stop, T}; %% DPA reception has timed out. transition(dpa_timeout, _) -> @@ -316,9 +326,10 @@ send_CER(#state{mode = {connect, Remote}, service = #diameter_service{capabilities = Caps}, transport = TPid} = S) -> - req_send_CER(Caps#diameter_caps.origin_host, Remote) + OH = Caps#diameter_caps.origin_host, + req_send_CER(OH, Remote) orelse - close(connected, S), + close({already_connected, Remote, Caps}, S), CER = build_CER(S), ?LOG(send, 'CER'), send(TPid, encode(CER)), @@ -418,11 +429,11 @@ rcv('CER' = N, Pkt, #state{state = recv_CER} = S) -> %% Anything but CER/CEA in a non-Open state is an error, as is %% CER/CEA in anything but recv_CER/Wait-CEA. -rcv(Name, _, #state{state = PS} = S) +rcv(Name, _, #state{state = PS}) when PS /= 'Open'; Name == 'CER'; Name == 'CEA' -> - close({Name, PS}, S); + {stop, {Name, PS}}; rcv(N, Pkt, S) when N == 'DWR'; @@ -460,20 +471,20 @@ handle_request(Type, #diameter_packet{} = Pkt, S) -> %% send_answer/3 send_answer(Type, ReqPkt, #state{transport = TPid} = S) -> - #diameter_packet{header = #diameter_header{version = V, - end_to_end_id = Eid, - hop_by_hop_id = Hid, - is_proxiable = P}, + #diameter_packet{header = H, transport_data = TD} = ReqPkt, - {Answer, PostF} = build_answer(Type, V, ReqPkt, S), + {Msg, PostF} = build_answer(Type, ReqPkt, S), - Pkt = #diameter_packet{header = #diameter_header{version = V, - end_to_end_id = Eid, - hop_by_hop_id = Hid, - is_proxiable = P}, - msg = Answer, + %% An answer message clears the R and T flags and retains the P + %% flag. The E flag is set at encode. + Pkt = #diameter_packet{header + = H#diameter_header{version = ?DIAMETER_VERSION, + is_request = false, + is_error = undefined, + is_retransmitted = false}, + msg = Msg, transport_data = TD}, send(TPid, diameter_codec:encode(?BASE, Pkt)), @@ -484,51 +495,104 @@ eval([F|A], S) -> eval(ok, S) -> S. -%% build_answer/4 +%% build_answer/3 build_answer('CER', - ?DIAMETER_VERSION, #diameter_packet{msg = CER, - header = #diameter_header{is_error = false}, + header = #diameter_header{version + = ?DIAMETER_VERSION, + is_error = false}, errors = []} = Pkt, - #state{service = Svc} - = S) -> - #diameter_service{capabilities = #diameter_caps{origin_host = OH}} - = Svc, - - {SupportedApps, #diameter_caps{origin_host = DH} = RCaps, CEA} + S) -> + {SupportedApps, RCaps, #diameter_base_CEA{'Result-Code' = RC, + 'Inband-Security-Id' = IS} + = CEA} = recv_CER(CER, S), + #diameter_caps{origin_host = {OH, DH}} + = Caps + = capz(caps(S), RCaps), + try - [] == SupportedApps - andalso ?THROW({no_common_application, 5010}), + 2001 == RC %% DIAMETER_SUCCESS + orelse ?THROW(RC), register_everywhere({?MODULE, connection, OH, DH}) - orelse ?THROW({election_lost, 4003}), - {CEA, [fun open/4, Pkt, SupportedApps, RCaps]} + orelse ?THROW(4003), %% DIAMETER_ELECTION_LOST + caps_cb(Caps) + of + N -> {cea(CEA, N), [fun open/5, Pkt, + SupportedApps, + Caps, + {accept, hd([_] = IS)}]} catch - ?FAILURE({Reason, RC}) -> - {answer('CER', S) ++ [{'Result-Code', RC}], - [fun close/2, {'CER', Reason, DH}]} + ?FAILURE(Reason) -> + rejected(Reason, {'CER', Reason, Caps, Pkt}, S) end; %% The error checks below are similar to those in diameter_service for %% other messages. Should factor out the commonality. -build_answer(Type, V, #diameter_packet{header = H, errors = Es} = Pkt, S) -> - FailedAvp = failed_avp([A || {_,A} <- Es]), - Ans = answer(answer(Type, S), V, H, Es), - {set(Ans, FailedAvp), if 'CER' == Type -> - [fun close/2, {Type, V, Pkt}]; - true -> - ok - end}. +build_answer(Type, + #diameter_packet{header = H, + errors = Es} + = Pkt, + S) -> + RC = rc(H, Es), + {answer(Type, RC, Es, S), post(Type, RC, Pkt, S)}. + +cea(CEA, ok) -> + CEA; +cea(CEA, 2001) -> + CEA; +cea(CEA, RC) -> + CEA#diameter_base_CEA{'Result-Code' = RC}. + +post('CER' = T, RC, Pkt, S) -> + [fun close/2, {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({N, Es}, T, S) -> + {answer('CER', N, Es, S), [fun close/2, T]}; +rejected(N, T, S) -> + rejected({N, []}, T, S). + +answer(Type, RC, Es, S) -> + set(answer(Type, RC, S), failed_avp([A || {_,A} <- Es])). + +answer(Type, RC, S) -> + answer_message(answer(Type, S), RC). +%% answer_message/2 + +answer_message([_ | Avps], RC) + when 3000 =< RC, RC < 4000 -> + ['answer-message', {'Result-Code', RC} + | lists:filter(fun is_origin/1, Avps)]; + +answer_message(Msg, RC) -> + Msg ++ [{'Result-Code', RC}]. + +is_origin({N, _}) -> + N == 'Origin-Host' + orelse N == 'Origin-Realm' + orelse N == 'Origin-State-Id'. + +%% failed_avp/1 + failed_avp([] = No) -> No; failed_avp(Avps) -> [{'Failed-AVP', [[{'AVP', Avps}]]}]. +%% set/2 + set(Ans, []) -> Ans; set(['answer-message' | _] = Ans, FailedAvp) -> @@ -536,18 +600,22 @@ set(['answer-message' | _] = Ans, FailedAvp) -> set([_|_] = Ans, FailedAvp) -> Ans ++ FailedAvp. -answer([_, OH, OR | _], _, #diameter_header{is_error = true}, _) -> - ['answer-message', OH, OR, {'Result-Code', 3008}]; +%% rc/2 + +rc(#diameter_header{is_error = true}, _) -> + 3008; %% DIAMETER_INVALID_HDR_BITS -answer([_, OH, OR | _], _, _, [Bs|_]) +rc(_, [Bs|_]) when is_bitstring(Bs) -> - ['answer-message', OH, OR, {'Result-Code', 3009}]; + 3009; %% DIAMETER_INVALID_HDR_BITS -answer(Ans, ?DIAMETER_VERSION, _, Es) -> - Ans ++ [{'Result-Code', rc(Es)}]; +rc(#diameter_header{version = ?DIAMETER_VERSION}, Es) -> + rc(Es); -answer(Ans, _, _, _) -> - Ans ++ [{'Result-Code', 5011}]. %% DIAMETER_UNSUPPORTED_VERSION +rc(_, _) -> + 5011. %% DIAMETER_UNSUPPORTED_VERSION + +%% rc/1 rc([]) -> 2001; %% DIAMETER_SUCCESS @@ -590,12 +658,14 @@ a('CER', #diameter_caps{vendor_id = Vid, origin_host = Host, origin_realm = Realm, host_ip_address = Addrs, - product_name = Name}) -> + product_name = Name, + origin_state_id = OSI}) -> ['CEA', {'Origin-Host', Host}, {'Origin-Realm', Realm}, {'Host-IP-Address', Addrs}, {'Vendor-Id', Vid}, - {'Product-Name', Name}]; + {'Product-Name', Name}, + {'Origin-State-Id', OSI}]; a('DPR', #diameter_caps{origin_host = Host, origin_realm = Realm}) -> @@ -610,23 +680,25 @@ recv_CER(CER, #state{service = Svc}) -> %% handle_CEA/1 -handle_CEA(#diameter_packet{header = #diameter_header{version = V}, - bin = Bin} +handle_CEA(#diameter_packet{bin = Bin} = Pkt, - #state{service = Svc} + #state{service = #diameter_service{capabilities = LCaps}} = S) when is_binary(Bin) -> ?LOG(recv, 'CEA'), - ?DIAMETER_VERSION == V orelse close({version, V}, S), - - #diameter_packet{msg = CEA, errors = Errors} + #diameter_packet{msg = CEA} = DPkt = diameter_codec:decode(?BASE, Pkt), - [] == Errors orelse close({errors, Errors}, S), + {SApps, IS, RCaps} = recv_CEA(DPkt, S), + + #diameter_caps{origin_host = {OH, DH}} + = Caps + = capz(LCaps, RCaps), - {SApps, #diameter_caps{origin_host = DH} = RCaps} = recv_CEA(CEA, S), + #diameter_base_CEA{'Result-Code' = RC} + = 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 @@ -634,40 +706,103 @@ handle_CEA(#diameter_packet{header = #diameter_header{version = V}, %% receive a CER/CEA, the first that arrives wins the right to a %% connection with the peer. - #diameter_service{capabilities = #diameter_caps{origin_host = OH}} - = Svc, + try + ?IS_SUCCESS(RC) + orelse ?THROW(RC), + [] == SApps + andalso ?THROW(no_common_application), + [] == IS + andalso ?THROW(no_common_security), + register_everywhere({?MODULE, connection, OH, DH}) + orelse ?THROW(election_lost), + caps_cb(Caps) + of + _ -> open(DPkt, SApps, Caps, {connect, hd([_] = IS)}, S) + catch + ?FAILURE(Reason) -> close({'CEA', Reason, Caps, DPkt}, S) + 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 +%% required. It's not unimaginable that a peer agreeing to TLS after +%% capabilities exchange could send DIAMETER_LIMITED_SUCCESS = 2002, +%% even if this isn't required by RFC 3588. - register_everywhere({?MODULE, connection, OH, DH}) - orelse - close({'CEA', DH}, S), +%% recv_CEA/2 - open(DPkt, SApps, RCaps, S). +recv_CEA(#diameter_packet{header = #diameter_header{version + = ?DIAMETER_VERSION, + is_error = false}, + msg = CEA, + errors = []}, + #state{service = Svc}) -> + {ok, T} = diameter_capx:recv_CEA(CEA, Svc), + T; -%% recv_CEA/2 +recv_CEA(Pkt, S) -> + close({'CEA', caps(S), Pkt}, S). -recv_CEA(CEA, #state{service = Svc} = S) -> - case diameter_capx:recv_CEA(CEA, Svc) of - {ok, {[], _}} -> - close({'CEA', no_common_application}, S); - {ok, T} -> - T; - {error, Reason} -> - close({'CEA', Reason}, S) +caps(#diameter_service{capabilities = Caps}) -> + Caps; +caps(#state{service = Svc}) -> + caps(Svc). + +%% caps_cb/1 + +caps_cb(Caps) -> + {Ref, Ts} = eraser(capabilities_cb), + ccb(Ts, [Ref, Caps]). + +ccb([], _) -> + ok; +ccb([F | Rest], T) -> + case diameter_lib:eval([F|T]) of + ok -> + ccb(Rest, T); + N when ?IS_SUCCESS(N) -> %% 2xxx result code: accept immediately + N; + Res -> + ?THROW({capabilities_cb, F, rejected(Res)}) end. +%% Note that returning 2xxx causes the capabilities exchange to be +%% accepted directly, without further callbacks. + +rejected(discard = T) -> + T; +rejected(unknown) -> + 3010; %% DIAMETER_UNKNOWN_PEER +rejected(N) + when is_integer(N) -> + N. + +%% open/5 + +open(Pkt, SupportedApps, Caps, {Type, IS}, #state{parent = Pid} = S) -> + #diameter_caps{origin_host = {_,_} = H, + inband_security_id = {LS,_}} + = Caps, + + tls_ack(lists:member(?TLS, LS), Caps, Type, IS, S), + Pid ! {open, self(), H, {Caps, SupportedApps, Pkt}}, -%% open/4 - -open(Pkt, SupportedApps, RCaps, #state{parent = Pid, - service = Svc} - = S) -> - #diameter_service{capabilities = #diameter_caps{origin_host = OH} - = LCaps} - = Svc, - #diameter_caps{origin_host = DH} - = RCaps, - Pid ! {open, self(), {OH,DH}, {capz(LCaps, RCaps), SupportedApps, Pkt}}, S#state{state = 'Open'}. +%% 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) -> + 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) + end; + +%% Or not. Don't send anything to the transport so that transports +%% not supporting TLS work as before without modification. +tls_ack(false, _, _, _, _) -> + ok. + capz(#diameter_caps{} = L, #diameter_caps{} = R) -> #diameter_caps{} = list_to_tuple([diameter_caps | lists:zip(tl(tuple_to_list(L)), diff --git a/lib/diameter/src/app/diameter_peer_fsm_sup.erl b/lib/diameter/src/base/diameter_peer_fsm_sup.erl index 995eaf74d0..995eaf74d0 100644 --- a/lib/diameter/src/app/diameter_peer_fsm_sup.erl +++ b/lib/diameter/src/base/diameter_peer_fsm_sup.erl diff --git a/lib/diameter/src/app/diameter_reg.erl b/lib/diameter/src/base/diameter_reg.erl index 882b9da238..882b9da238 100644 --- a/lib/diameter/src/app/diameter_reg.erl +++ b/lib/diameter/src/base/diameter_reg.erl diff --git a/lib/diameter/src/app/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 421e36ccf5..7adcf1c265 100644 --- a/lib/diameter/src/app/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -983,7 +983,8 @@ peer_cb(MFA, Alias) -> connection_down(Pid, #state{peerT = PeerT, connT = ConnT} = S) -> - #peer{conn = TPid} + #peer{op_state = ?STATE_UP, %% assert + conn = TPid} = P = fetch(PeerT, Pid), @@ -993,6 +994,9 @@ connection_down(Pid, #state{peerT = PeerT, %% connection_down/3 +connection_down(#peer{op_state = ?STATE_DOWN}, _, S) -> + S; + connection_down(#peer{conn = TPid, op_state = ?STATE_UP} = P, @@ -1034,13 +1038,23 @@ down_conn(Id, Alias, TC, {SvcName, Apps}) -> %% Peer process has died. -peer_down(Pid, _Reason, #state{peerT = PeerT} = S) -> +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). -%% peer_down/2 +%% 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. %% The peer has never come up ... peer_down(#peer{conn = B}, S) @@ -1048,27 +1062,9 @@ peer_down(#peer{conn = B}, S) S; %% ... or it has. -peer_down(#peer{ref = Ref, - conn = TPid, - type = Type, - options = Opts} - = P, - #state{service_name = SvcName, - connT = ConnT} - = S) -> - #conn{caps = Caps} - = C - = fetch(ConnT, TPid), +peer_down(#peer{conn = TPid} = P, #state{connT = ConnT} = S) -> + #conn{} = C = fetch(ConnT, TPid), ets:delete_object(ConnT, C), - try - pd(P,C,S) - after - send_event(SvcName, {closed, Ref, {TPid, Caps}, {type(Type), Opts}}) - end. - -pd(#peer{op_state = ?STATE_DOWN}, _, S) -> - S; -pd(#peer{op_state = ?STATE_UP} = P, C, S) -> connection_down(P,C,S). %% restart/2 @@ -1259,11 +1255,11 @@ send_request({TPid, Caps, App}, Msg, Opts, Caller, SvcName) -> #diameter_app{module = ModX} = App, - Pkt = make_packet(Msg), + Pkt = make_request_packet(Msg), case cb(ModX, prepare_request, [Pkt, SvcName, {TPid, Caps}]) of {send, P} -> - send_request(make_packet(P, Pkt), + send_request(make_request_packet(P, Pkt), TPid, Caps, App, @@ -1278,70 +1274,73 @@ send_request({TPid, Caps, App}, Msg, Opts, Caller, SvcName) -> ?ERROR({invalid_return, prepare_request, App, T}) end. -%% make_packet/1 +%% make_request_packet/1 %% %% Turn an outgoing request as passed to call/4 into a diameter_packet %% record in preparation for a prepare_request callback. -make_packet(Bin) +make_request_packet(Bin) when is_binary(Bin) -> #diameter_packet{header = diameter_codec:decode_header(Bin), bin = Bin}; -make_packet(#diameter_packet{msg = [#diameter_header{} = Hdr | Avps]} = Pkt) -> - Pkt#diameter_packet{msg = [make_header(Hdr) | Avps]}; +make_request_packet(#diameter_packet{msg = [#diameter_header{} = Hdr | Avps]} + = Pkt) -> + Pkt#diameter_packet{msg = [make_request_header(Hdr) | Avps]}; -make_packet(#diameter_packet{header = Hdr} = Pkt) -> - Pkt#diameter_packet{header = make_header(Hdr)}; +make_request_packet(#diameter_packet{header = Hdr} = Pkt) -> + Pkt#diameter_packet{header = make_request_header(Hdr)}; -make_packet(Msg) -> - make_packet(#diameter_packet{msg = Msg}). +make_request_packet(Msg) -> + make_request_packet(#diameter_packet{msg = Msg}). -%% make_header/1 +%% make_request_header/1 -make_header(undefined) -> +make_request_header(undefined) -> Seq = diameter_session:sequence(), - make_header(#diameter_header{end_to_end_id = Seq, - hop_by_hop_id = Seq}); + make_request_header(#diameter_header{end_to_end_id = Seq, + hop_by_hop_id = Seq}); -make_header(#diameter_header{version = undefined} = Hdr) -> - make_header(Hdr#diameter_header{version = ?DIAMETER_VERSION}); +make_request_header(#diameter_header{version = undefined} = Hdr) -> + make_request_header(Hdr#diameter_header{version = ?DIAMETER_VERSION}); -make_header(#diameter_header{end_to_end_id = undefined} = H) -> +make_request_header(#diameter_header{end_to_end_id = undefined} = H) -> Seq = diameter_session:sequence(), - make_header(H#diameter_header{end_to_end_id = Seq}); + make_request_header(H#diameter_header{end_to_end_id = Seq}); -make_header(#diameter_header{hop_by_hop_id = undefined} = H) -> +make_request_header(#diameter_header{hop_by_hop_id = undefined} = H) -> Seq = diameter_session:sequence(), - make_header(H#diameter_header{hop_by_hop_id = Seq}); + make_request_header(H#diameter_header{hop_by_hop_id = Seq}); -make_header(#diameter_header{} = Hdr) -> +make_request_header(#diameter_header{} = Hdr) -> Hdr; -make_header(T) -> +make_request_header(T) -> ?ERROR({invalid_header, T}). -%% make_packet/2 +%% make_request_packet/2 %% %% Reconstruct a diameter_packet from the return value of %% prepare_request or prepare_retransmit callback. -make_packet(Bin, _) +make_request_packet(Bin, _) when is_binary(Bin) -> - make_packet(Bin); + make_request_packet(Bin); -make_packet(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) -> +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_packet(#diameter_packet{header = Hdr} = Pkt, +make_request_packet(#diameter_packet{header = Hdr} = Pkt, #diameter_packet{header = Hdr0}) -> Pkt#diameter_packet{header = fold_record(Hdr0, Hdr)}; -make_packet(Msg, Pkt) -> +make_request_packet(Msg, Pkt) -> Pkt#diameter_packet{msg = Msg}. %% fold_record/2 @@ -1533,7 +1532,7 @@ retransmit({TPid, Caps, #diameter_app{alias = Alias} = App}, case cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]) of {send, P} -> - retransmit(make_packet(P, Pkt), TPid, Caps, Req, Timeout); + retransmit(make_request_packet(P, Pkt), TPid, Caps, Req, Timeout); {discard, Reason} -> ?THROW(Reason); discard -> @@ -1946,7 +1945,7 @@ reply(Msg, Dict, TPid, #diameter_packet{errors = Es, = ReqPkt) when [] == Es; is_record(hd(Msg), diameter_header) -> - Pkt = diameter_codec:encode(Dict, make_reply_packet(Msg, ReqPkt)), + Pkt = diameter_codec:encode(Dict, make_answer_packet(Msg, ReqPkt)), incr(send, Pkt, Dict, TPid), %% count result codes in sent answers send(TPid, Pkt#diameter_packet{transport_data = TD}); @@ -1957,18 +1956,19 @@ reply(Msg, Dict, TPid, #diameter_packet{errors = [H|_] = Es} = Pkt) -> TPid, Pkt#diameter_packet{errors = []}). -%% make_reply_packet/2 +%% make_answer_packet/2 %% Binaries and header/avp lists are sent as-is. -make_reply_packet(Bin, _) +make_answer_packet(Bin, _) when is_binary(Bin) -> #diameter_packet{bin = Bin}; -make_reply_packet([#diameter_header{} | _] = Msg, _) -> +make_answer_packet([#diameter_header{} | _] = Msg, _) -> #diameter_packet{msg = Msg}; %% Otherwise a reply message clears the R and T flags and retains the -%% P flag. The E flag will be set at encode. -make_reply_packet(Msg, #diameter_packet{header = ReqHdr}) -> +%% 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. +make_answer_packet(Msg, #diameter_packet{header = ReqHdr}) -> Hdr = ReqHdr#diameter_header{version = ?DIAMETER_VERSION, is_request = false, is_error = undefined, diff --git a/lib/diameter/src/app/diameter_service_sup.erl b/lib/diameter/src/base/diameter_service_sup.erl index 153fff902f..153fff902f 100644 --- a/lib/diameter/src/app/diameter_service_sup.erl +++ b/lib/diameter/src/base/diameter_service_sup.erl diff --git a/lib/diameter/src/app/diameter_session.erl b/lib/diameter/src/base/diameter_session.erl index bb91e97f39..bb91e97f39 100644 --- a/lib/diameter/src/app/diameter_session.erl +++ b/lib/diameter/src/base/diameter_session.erl diff --git a/lib/diameter/src/app/diameter_stats.erl b/lib/diameter/src/base/diameter_stats.erl index 71479afa95..71479afa95 100644 --- a/lib/diameter/src/app/diameter_stats.erl +++ b/lib/diameter/src/base/diameter_stats.erl diff --git a/lib/diameter/src/app/diameter_sup.erl b/lib/diameter/src/base/diameter_sup.erl index e5afd23dcd..e5afd23dcd 100644 --- a/lib/diameter/src/app/diameter_sup.erl +++ b/lib/diameter/src/base/diameter_sup.erl diff --git a/lib/diameter/src/app/diameter_sync.erl b/lib/diameter/src/base/diameter_sync.erl index ce2db4b3a2..ce2db4b3a2 100644 --- a/lib/diameter/src/app/diameter_sync.erl +++ b/lib/diameter/src/base/diameter_sync.erl diff --git a/lib/diameter/src/app/diameter_types.erl b/lib/diameter/src/base/diameter_types.erl index 6b1b1b8d39..6b1b1b8d39 100644 --- a/lib/diameter/src/app/diameter_types.erl +++ b/lib/diameter/src/base/diameter_types.erl diff --git a/lib/diameter/src/app/diameter_types.hrl b/lib/diameter/src/base/diameter_types.hrl index 02bf8a74dd..02bf8a74dd 100644 --- a/lib/diameter/src/app/diameter_types.hrl +++ b/lib/diameter/src/base/diameter_types.hrl diff --git a/lib/diameter/src/app/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl index b7c1491f4b..6dc53d9f31 100644 --- a/lib/diameter/src/app/diameter_watchdog.erl +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -179,11 +179,11 @@ transition({close, TPid, _Reason}, #watchdog{transport = TPid}) -> %% state okay as the result of the Peer State Machine reaching the %% Open state. %% -%% If we're an acceptor then we may be resuming a connection that went -%% down in another acceptor process, in which case this is the -%% transition below, from down into reopen. That is, it's not until -%% we know the identity of the peer (ie. now) that we know that we're -%% in state down rather than initial. +%% If we're accepting then we may be resuming a connection that went +%% down in another watchdog process, in which case this is the +%% transition below, from down to reopen. That is, it's not until we +%% 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, #watchdog{transport = TPid, diff --git a/lib/diameter/src/app/diameter_watchdog_sup.erl b/lib/diameter/src/base/diameter_watchdog_sup.erl index fc837fe4ef..fc837fe4ef 100644 --- a/lib/diameter/src/app/diameter_watchdog_sup.erl +++ b/lib/diameter/src/base/diameter_watchdog_sup.erl diff --git a/lib/diameter/src/compiler/Makefile b/lib/diameter/src/compiler/Makefile deleted file mode 100644 index 779013bfbc..0000000000 --- a/lib/diameter/src/compiler/Makefile +++ /dev/null @@ -1,131 +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% -# -# - -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/target.mk -EBIN = ../../ebin -include $(ERL_TOP)/make/$(TARGET)/otp.mk -else -include $(DIAMETER_TOP)/make/target.mk -EBIN = ../../ebin -include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk -endif - - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(DIAMETER_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- - -RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) - -INCDIR = ../../include - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -include modules.mk - -ERL_FILES = \ - $(MODULES:%=%.erl) - -TARGET_FILES = \ - $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ifeq ($(TYPE),debug) -ERL_COMPILE_FLAGS += -Ddebug -endif - -include ../app/diameter.mk - -ERL_COMPILE_FLAGS += \ - $(DIAMETER_ERL_COMPILE_FLAGS) \ - -I$(INCDIR) - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug: - @${MAKE} TYPE=debug opt - -opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) - rm -f errs core *~ - rm -f depend.mk - -docs: - -info: - @echo "" - @echo "ERL_FILES = $(ERL_FILES)" - @echo "HRL_FILES = $(HRL_FILES)" - @echo "" - @echo "TARGET_FILES = $(TARGET_FILES)" - @echo "" - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/otp_release_targets.mk -else -include $(DIAMETER_TOP)/make/release_targets.mk -endif - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin - $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/src/compiler - $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/src/compiler - -release_docs_spec: - -force: - -# ---------------------------------------------------- -# Dependencies -# ---------------------------------------------------- - -depend: depend.mk - -# Generate dependencies makefile. -depend.mk: ../app/depend.sed $(ERL_FILES) Makefile - for f in $(MODULES); do \ - sed -f $< $$f.erl | sed "s@/@/$$f@"; \ - done \ - > $@ - --include depend.mk - -.PHONY: clean debug depend docs force info opt release_docs_spec release_spec diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl index a33b07a3d3..0fd4a0b301 100644 --- a/lib/diameter/src/compiler/diameter_codegen.erl +++ b/lib/diameter/src/compiler/diameter_codegen.erl @@ -707,9 +707,9 @@ gen_hrl(Path, Mod, Spec) -> write("ENUM Macros", Fd, m_enums(PREFIX, false, get_value(enums, Spec))), - write("RESULT CODE Macros", + write("DEFINE Macros", Fd, - m_enums(PREFIX, false, get_value(result_codes, Spec))), + m_enums(PREFIX, false, get_value(defines, Spec))), lists:foreach(fun({M,Es}) -> write("ENUM Macros from " ++ atom_to_list(M), diff --git a/lib/diameter/src/app/diameter_exprecs.erl b/lib/diameter/src/compiler/diameter_exprecs.erl index 5e120d6f44..5e120d6f44 100644 --- a/lib/diameter/src/app/diameter_exprecs.erl +++ b/lib/diameter/src/compiler/diameter_exprecs.erl diff --git a/lib/diameter/src/compiler/diameter_make.erl b/lib/diameter/src/compiler/diameter_make.erl index 4431b88c4d..5380ee56ca 100644 --- a/lib/diameter/src/compiler/diameter_make.erl +++ b/lib/diameter/src/compiler/diameter_make.erl @@ -18,103 +18,61 @@ %% %% -%% Driver for the encoder generator utility. +%% Module alternative to diameterc for dictionary compilation. +%% +%% Eg. 1> diameter_make:dict("mydict.dia"). +%% +%% $ erl -noshell \ +%% -boot start_clean \ +%% -s diameter_make dict mydict.dia \ +%% -s init stop %% -module(diameter_make). --export([spec/0, - hrl/0, - erl/0]). +-export([dict/1, + dict/2, + spec/1, + spec/2]). --spec spec() -> no_return(). --spec hrl() -> no_return(). --spec erl() -> no_return(). +-type opt() :: {outdir|include|name|prefix|inherits, string()} + | verbose + | debug. -spec() -> - make(spec). +%% dict/1-2 -hrl() -> - make(hrl). +-spec dict(string(), [opt()]) + -> ok. -erl() -> - make(erl). +dict(File, Opts) -> + make(File, + Opts, + spec(File, Opts), + [spec || _ <- [1], lists:member(debug, Opts)] ++ [erl, hrl]). -%% make/1 +dict(File) -> + dict(File, []). -make(Mode) -> - Args = init:get_plain_arguments(), - Opts = try options(Args) catch throw: help -> help(Mode) end, - Files = proplists:get_value(files, Opts, []), - lists:foreach(fun(F) -> from_file(F, Mode, Opts) end, Files), - halt(0). +%% spec/2 -%% from_file/3 - -from_file(F, Mode, Opts) -> - try to_spec(F, Mode, Opts) of - Spec -> - from_spec(F, Spec, Mode, Opts) - catch - error: Reason -> - io:format("==> ~p parse failure:~n~p~n", - [F, {Reason, erlang:get_stacktrace()}]), - halt(1) - end. +-spec spec(string(), [opt()]) + -> orddict:orddict(). -%% to_spec/2 +spec(File, Opts) -> + diameter_spec_util:parse(File, Opts). -%% Try to read the input as an already parsed file or else parse it. -to_spec(F, spec, Opts) -> - diameter_spec_util:parse(F, Opts); -to_spec(F, _, _) -> - {ok, [Spec]} = file:consult(F), - Spec. +spec(File) -> + spec(File, []). -%% from_spec/4 +%% =========================================================================== -from_spec(File, Spec, Mode, Opts) -> - try - diameter_codegen:from_spec(File, Spec, Opts, Mode) +make(_, _, _, []) -> + ok; +make(File, Opts, Spec, [Mode | Rest]) -> + try diameter_codegen:from_spec(File, Spec, Opts, Mode) of + ok -> + make(File, Opts, Spec, Rest) catch error: Reason -> - io:format("==> ~p codegen failure:~n~p~n~p~n", - [Mode, File, {Reason, erlang:get_stacktrace()}]), - halt(1) + {error, {Reason, Mode, erlang:get_stacktrace()}} end. - -%% options/1 - -options(["-v" | Rest]) -> - [verbose | options(Rest)]; - -options(["-o", Outdir | Rest]) -> - [{outdir, Outdir} | options(Rest)]; - -options(["-i", Incdir | Rest]) -> - [{include, Incdir} | options(Rest)]; - -options(["-h" | _]) -> - throw(help); - -options(["--" | Fs]) -> - [{files, Fs}]; - -options(["-" ++ _ = Opt | _]) -> - io:fwrite("==> unknown option: ~s~n", [Opt]), - throw(help); - -options(Fs) -> %% trailing arguments - options(["--" | Fs]). - -%% help/1 - -help(M) -> - io:fwrite("Usage: ~p ~p [Options] [--] File ...~n" - "Options:~n" - " -v verbose output~n" - " -h shows this help message~n" - " -o OutDir where to put the output files~n" - " -i IncludeDir where to search for beams to import~n", - [?MODULE, M]), - halt(1). diff --git a/lib/diameter/src/compiler/diameter_spec_util.erl b/lib/diameter/src/compiler/diameter_spec_util.erl index b60886b678..62536bf06d 100644 --- a/lib/diameter/src/compiler/diameter_spec_util.erl +++ b/lib/diameter/src/compiler/diameter_spec_util.erl @@ -34,19 +34,38 @@ %% %% Output: orddict() -parse(Path, Options) -> - put({?MODULE, verbose}, lists:member(verbose, Options)), +parse(Path, Opts) -> + put({?MODULE, verbose}, lists:member(verbose, Opts)), {ok, B} = file:read_file(Path), Chunks = chunk(B), - Spec = make_spec(Chunks), + Spec = reset(make_spec(Chunks), Opts, [name, prefix, inherits]), true = groups_defined(Spec), %% sanity checks true = customs_defined(Spec), %% - Full = import_enums(import_groups(import_avps(insert_codes(Spec), - Options))), + Full = import_enums(import_groups(import_avps(insert_codes(Spec), Opts))), true = enums_defined(Full), %% sanity checks true = v_flags_set(Spec), Full. +reset(Spec, Opts, Keys) -> + lists:foldl(fun(K,S) -> + reset([{A,?ATOM(V)} || {A,V} <- Opts, A == K], S) + end, + Spec, + Keys). + +reset(L, Spec) + when is_list(L) -> + lists:foldl(fun reset/2, Spec, L); + +reset({inherits = Key, '-'}, Spec) -> + orddict:erase(Key, Spec); +reset({inherits = Key, Dict}, Spec) -> + orddict:append(Key, Dict, Spec); +reset({Key, Atom}, Spec) -> + orddict:store(Key, Atom, Spec); +reset(_, Spec) -> + Spec. + %% Optional reports when running verbosely. report(What, Data) -> report(get({?MODULE, verbose}), What, Data). @@ -204,9 +223,11 @@ chunk({avp_vendor_id = T, [{number, I}], Body}, Dict) -> chunk({enum, [N], Str}, Dict) -> append(enums, {atomize(N), parse_enums(Str)}, Dict); -%% result_codes -> [{ResultName, [{Value, Name}, ...]}, ...] -chunk({result_code, [N], Str}, Dict) -> - append(result_codes, {atomize(N), parse_enums(Str)}, Dict); +%% defines -> [{DefineName, [{Value, Name}, ...]}, ...] +chunk({define, [N], Str}, Dict) -> + append(defines, {atomize(N), parse_enums(Str)}, Dict); +chunk({result_code, [_] = N, Str}, Dict) -> %% backwards compatibility + chunk({define, N, Str}, Dict); %% commands -> [{Name, Abbrev}, ...] chunk({commands = T, [], Body}, Dict) -> diff --git a/lib/diameter/src/compiler/modules.mk b/lib/diameter/src/compiler/modules.mk deleted file mode 100644 index 17a311dacf..0000000000 --- a/lib/diameter/src/compiler/modules.mk +++ /dev/null @@ -1,27 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %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% - -MODULES = \ - diameter_codegen \ - diameter_spec_scan \ - diameter_spec_util - -HRL_FILES = \ - diameter_forms.hrl - diff --git a/lib/diameter/src/depend.sed b/lib/diameter/src/depend.sed new file mode 100644 index 0000000000..8f999f646f --- /dev/null +++ b/lib/diameter/src/depend.sed @@ -0,0 +1,51 @@ +# +# %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% +# + +# +# Extract include dependencies from .erl files. First line of input +# is the path to the module in question (minus the .erl extension), +# the rest is the contents of the module. +# + +1{ + s@^[^/]*/@@ + h + d +} + +# Only interested in includes of diameter hrls. +/^-include/!d +/"diameter/!d + +# Extract the name of the included files in one of two forms: +# +# $(INCDIR)/diameter.hrl +# diameter_internal.hrl + +s@^-include_lib(".*/@$(INCDIR)/@ +s@^-include("@@ +s@".*@@ + +# Retrieve the path to our module from the hold space, morph it +# into a beam path and turn it into a dependency like this: +# +# $(EBIN)/diameter_service.$(EMULATOR): $(INCDIR)/diameter.hrl + +G +s@^\(.*\)\n\(.*\)@$(EBIN)/\2.$(EMULATOR): \1@ diff --git a/lib/diameter/src/dict/base_accounting.dia b/lib/diameter/src/dict/base_accounting.dia new file mode 100644 index 0000000000..ced324078c --- /dev/null +++ b/lib/diameter/src/dict/base_accounting.dia @@ -0,0 +1,69 @@ +;; +;; %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% +;; + +@id 3 +@name diameter_gen_base_accounting +@prefix diameter_base_accounting +@vendor 0 IETF + +@inherits diameter_gen_base_rfc3588 + +@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 ] + [ 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-Reporting-Host ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ AVP ] diff --git a/lib/diameter/src/dict/base_rfc3588.dia b/lib/diameter/src/dict/base_rfc3588.dia new file mode 100644 index 0000000000..f7a0b717cd --- /dev/null +++ b/lib/diameter/src/dict/base_rfc3588.dia @@ -0,0 +1,414 @@ +;; +;; %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% +;; + +@id 0 +@name diameter_gen_base_rfc3588 +@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 + E2E-Sequence 300 Grouped 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 } + + DPA ::= < Diameter Header: 282 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ Error-Message ] + * [ Failed-AVP ] + + DWR ::= < Diameter Header: 280, REQ > + { Origin-Host } + { Origin-Realm } + [ Origin-State-Id ] + + DWA ::= < Diameter Header: 280 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ Error-Message ] + * [ Failed-AVP ] + [ Origin-State-Id ] + + answer-message ::= < Diameter Header: code, ERR [PXY] > + 0*1 < Session-Id > + { Origin-Host } + { Origin-Realm } + { Result-Code } + [ Origin-State-Id ] + [ Error-Reporting-Host ] + [ 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 ] + [ 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-Reporting-Host ] + [ 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 + + DIAMETER_LOGOUT 1 + DIAMETER_SERVICE_NOT_PROVIDED 2 + DIAMETER_BAD_ANSWER 3 + DIAMETER_ADMINISTRATIVE 4 + DIAMETER_LINK_BROKEN 5 + DIAMETER_AUTH_EXPIRED 6 + DIAMETER_USER_MOVED 7 + DIAMETER_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 + DIAMETER_MULTI_ROUND_AUTH 1001 + +;; 7.1.2. Success + DIAMETER_SUCCESS 2001 + DIAMETER_LIMITED_SUCCESS 2002 + +;; 7.1.3. Protocol Errors + DIAMETER_COMMAND_UNSUPPORTED 3001 + DIAMETER_UNABLE_TO_DELIVER 3002 + DIAMETER_REALM_NOT_SERVED 3003 + DIAMETER_TOO_BUSY 3004 + DIAMETER_LOOP_DETECTED 3005 + DIAMETER_REDIRECT_INDICATION 3006 + DIAMETER_APPLICATION_UNSUPPORTED 3007 + DIAMETER_INVALID_HDR_BITS 3008 + DIAMETER_INVALID_AVP_BITS 3009 + DIAMETER_UNKNOWN_PEER 3010 + +;; 7.1.4. Transient Failures + DIAMETER_AUTHENTICATION_REJECTED 4001 + DIAMETER_OUT_OF_SPACE 4002 + ELECTION_LOST 4003 + +;; 7.1.5. Permanent Failures + DIAMETER_AVP_UNSUPPORTED 5001 + DIAMETER_UNKNOWN_SESSION_ID 5002 + DIAMETER_AUTHORIZATION_REJECTED 5003 + DIAMETER_INVALID_AVP_VALUE 5004 + DIAMETER_MISSING_AVP 5005 + DIAMETER_RESOURCES_EXCEEDED 5006 + DIAMETER_CONTRADICTING_AVPS 5007 + DIAMETER_AVP_NOT_ALLOWED 5008 + DIAMETER_AVP_OCCURS_TOO_MANY_TIMES 5009 + DIAMETER_NO_COMMON_APPLICATION 5010 + DIAMETER_UNSUPPORTED_VERSION 5011 + DIAMETER_UNABLE_TO_COMPLY 5012 + DIAMETER_INVALID_BIT_IN_HEADER 5013 + DIAMETER_INVALID_AVP_LENGTH 5014 + DIAMETER_INVALID_MESSAGE_LENGTH 5015 + DIAMETER_INVALID_AVP_BIT_COMBO 5016 + DIAMETER_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 > + 1* { Vendor-Id } + [ Auth-Application-Id ] + [ Acct-Application-Id ] + +;; The E2E-Sequence AVP is defined in RFC 3588 as Grouped, but +;; there is no definition of the group - only an informal text stating +;; that there should be a nonce (an OctetString) and a counter +;; (integer) +;; + E2E-Sequence ::= <AVP Header: 300 > + 2* { AVP } diff --git a/lib/diameter/src/app/diameter_gen_relay.dia b/lib/diameter/src/dict/relay.dia index d86446e368..c22293209b 100644 --- a/lib/diameter/src/app/diameter_gen_relay.dia +++ b/lib/diameter/src/dict/relay.dia @@ -18,6 +18,7 @@ ;; @id 0xFFFFFFFF +@name diameter_gen_relay @prefix diameter_relay @vendor 0 IETF diff --git a/lib/diameter/src/gen/.gitignore b/lib/diameter/src/gen/.gitignore new file mode 100644 index 0000000000..d490642eb7 --- /dev/null +++ b/lib/diameter/src/gen/.gitignore @@ -0,0 +1,2 @@ + +/diameter_gen*rl diff --git a/lib/diameter/src/modules.mk b/lib/diameter/src/modules.mk new file mode 100644 index 0000000000..c7cbe598af --- /dev/null +++ b/lib/diameter/src/modules.mk @@ -0,0 +1,93 @@ +#-*-makefile-*- ; force emacs to enter makefile-mode + +# %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% + +# Runtime dictionary files in ./dict. Modules will be generated from +# these are included in the app file. +DICTS = \ + base_rfc3588 \ + base_accounting \ + relay + +# Handwritten (runtime) modules included in the app file. +RT_MODULES = \ + base/diameter \ + base/diameter_app \ + base/diameter_capx \ + base/diameter_config \ + base/diameter_codec \ + base/diameter_dict \ + base/diameter_lib \ + base/diameter_misc_sup \ + base/diameter_peer \ + base/diameter_peer_fsm \ + base/diameter_peer_fsm_sup \ + base/diameter_reg \ + base/diameter_service \ + base/diameter_service_sup \ + base/diameter_session \ + base/diameter_stats \ + base/diameter_sup \ + base/diameter_sync \ + base/diameter_types \ + base/diameter_watchdog \ + base/diameter_watchdog_sup \ + transport/diameter_etcp \ + transport/diameter_etcp_sup \ + transport/diameter_tcp \ + transport/diameter_tcp_sup \ + transport/diameter_sctp \ + transport/diameter_sctp_sup \ + transport/diameter_transport_sup + +# Handwritten (compile time) modules not included in the app file. +CT_MODULES = \ + base/diameter_callback \ + base/diameter_dbg \ + base/diameter_info \ + compiler/diameter_codegen \ + compiler/diameter_exprecs \ + compiler/diameter_spec_scan \ + compiler/diameter_spec_util \ + compiler/diameter_make + +# Released hrl files in ../include intended for public consumption. +EXTERNAL_HRLS = \ + diameter.hrl \ + diameter_gen.hrl + +# Released hrl files intended for private use. +INTERNAL_HRLS = \ + base/diameter_internal.hrl \ + base/diameter_types.hrl \ + compiler/diameter_forms.hrl + +# Released files relative to ../bin. +BINS = \ + diameterc + +# Released files relative to ../examples. +EXAMPLES = \ + GNUmakefile \ + peer.erl \ + client.erl \ + client_cb.erl \ + server.erl \ + server_cb.erl \ + relay.erl \ + relay_cb.erl diff --git a/lib/diameter/src/subdirs.mk b/lib/diameter/src/subdirs.mk deleted file mode 100644 index 3e12d935bc..0000000000 --- a/lib/diameter/src/subdirs.mk +++ /dev/null @@ -1,21 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %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% - -SUB_DIRS = compiler app transport -SUB_DIRECTORIES = $(SUB_DIRS)
\ No newline at end of file diff --git a/lib/diameter/src/transport/.gitignore b/lib/diameter/src/transport/.gitignore deleted file mode 100644 index d9f072e262..0000000000 --- a/lib/diameter/src/transport/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ - -/depend.mk - diff --git a/lib/diameter/src/transport/Makefile b/lib/diameter/src/transport/Makefile deleted file mode 100644 index 4b53100fd2..0000000000 --- a/lib/diameter/src/transport/Makefile +++ /dev/null @@ -1,141 +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% -# -# - -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/target.mk -EBIN = ../../ebin -include $(ERL_TOP)/make/$(TARGET)/otp.mk -else -include $(DIAMETER_TOP)/make/target.mk -EBIN = ../../ebin -include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk -endif - - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- - -include ../../vsn.mk -VSN=$(DIAMETER_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- - -RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) - -INCDIR = ../../include - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -include modules.mk - -ERL_FILES = \ - $(MODULES:%=%.erl) - -TARGET_FILES = \ - $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ifeq ($(TYPE),debug) -ERL_COMPILE_FLAGS += -Ddebug -endif - -include ../app/diameter.mk - -ERL_COMPILE_FLAGS += \ - $(DIAMETER_ERL_COMPILE_FLAGS) \ - -I$(INCDIR) - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug: - @${MAKE} TYPE=debug opt - -opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) - rm -f errs core *~ - rm -f depend.mk - -docs: - -info: - @echo "" - @echo "ERL_FILES = $(ERL_FILES)" - @echo "HRL_FILES = $(HRL_FILES)" - @echo "" - @echo "TARGET_FILES = $(TARGET_FILES)" - @echo "" - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -# Invoked from ../app to add modules to the app file. -$(APP_TARGET): force - M=`echo $(MODULES) | sed -e 's/^ *//' -e 's/ *$$//' -e 'y/ /,/'`; \ - echo "/%TRANSPORT_MODULES%/s//$$M/;w;q" | tr ';' '\n' \ - | ed -s $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/otp_release_targets.mk -else -include $(DIAMETER_TOP)/make/release_targets.mk -endif - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin - $(INSTALL_DIR) $(RELSYSDIR)/src/transport - $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/src/transport - -release_docs_spec: - -force: - -# ---------------------------------------------------- -# Dependencies -# ---------------------------------------------------- - -depend: depend.mk - -# Generate dependencies makefile. -depend.mk: ../app/depend.sed $(ERL_FILES) Makefile - for f in $(MODULES); do \ - sed -f $< $$f.erl | sed "s@/@/$$f@"; \ - done \ - > $@ - --include depend.mk - -.PHONY: clean debug depend docs force info opt release_docs_spec release_spec diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index 46473e7bf1..209f8c01c1 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -37,6 +37,9 @@ code_change/3, terminate/2]). +-export([ports/0, + ports/1]). + -include_lib("kernel/include/inet_sctp.hrl"). -include_lib("diameter/include/diameter.hrl"). @@ -118,8 +121,8 @@ s({accept, Ref} = A, Addrs, Opts) -> %% gen_sctp in order to be able to accept a new association only %% *after* an accepting transport has been spawned. -s({connect = C, _}, Addrs, Opts) -> - diameter_sctp_sup:start_child({C, self(), Opts, Addrs}). +s({connect = C, Ref}, Addrs, Opts) -> + diameter_sctp_sup:start_child({C, self(), Opts, Addrs, Ref}). %% start_link/1 @@ -149,28 +152,36 @@ i({listen, Ref, {Opts, Addrs}}) -> socket = Sock}); %% A connecting transport. -i({connect, Pid, Opts, Addrs}) -> +i({connect, Pid, Opts, Addrs, Ref}) -> {[As, Ps], Rest} = proplists:split(Opts, [raddr, rport]), RAs = [diameter_lib:ipaddr(A) || {raddr, A} <- As], [RP] = [P || {rport, P} <- Ps] ++ [P || P <- [?DEFAULT_PORT], [] == Ps], {LAs, Sock} = open(Addrs, Rest, 0), + putr(ref, Ref), proc_lib:init_ack({ok, self(), LAs}), erlang:monitor(process, Pid), #transport{parent = Pid, mode = {connect, connect(Sock, RAs, RP, [])}, socket = Sock}; +i({connect, _, _, _} = T) -> %% from old code + x(T); %% An accepting transport spawned by diameter. -i({accept, Pid, LPid, Sock}) -> +i({accept, Pid, LPid, Sock, Ref}) + when is_pid(Pid) -> + putr(ref, Ref), proc_lib:init_ack({ok, self()}), erlang:monitor(process, Pid), erlang:monitor(process, LPid), #transport{parent = Pid, mode = {accept, LPid}, socket = Sock}; +i({accept, _, _, _} = T) -> %% from old code + x(T); %% An accepting transport spawned at association establishment. i({accept, Ref, LPid, Sock, Id}) -> + putr(ref, Ref), proc_lib:init_ack({ok, self()}), MRef = erlang:monitor(process, LPid), %% Wait for a signal that the transport has been started before @@ -250,13 +261,33 @@ gen_opts(Opts) -> [binary, {active, once} | Opts]. %% --------------------------------------------------------------------------- +%% # ports/0-1 +%% --------------------------------------------------------------------------- + +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, + R == Ref, + {ok, N} <- [inet:port(S)]]. + +type(listener) -> + listen; +type(T) -> + T. + +%% --------------------------------------------------------------------------- %% # handle_call/3 %% --------------------------------------------------------------------------- handle_call({{accept, Ref}, Pid}, _, #listener{ref = Ref, count = N} = S) -> - {TPid, NewS} = accept(Pid, S), + {TPid, NewS} = accept(Ref, Pid, S), {reply, {ok, TPid}, NewS#listener{count = N+1}}; handle_call(_, _, State) -> @@ -306,6 +337,12 @@ terminate(_, #listener{socket = Sock}) -> %% --------------------------------------------------------------------------- +putr(Key, Val) -> + put({?MODULE, Key}, Val). + +getr(Key) -> + get({?MODULE, Key}). + %% start_timer/1 start_timer(#listener{count = 0} = S) -> @@ -411,27 +448,41 @@ transition({diameter, {send, Msg}}, S) -> transition({diameter, {close, Pid}}, #transport{parent = Pid}) -> stop; +%% 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. +transition({diameter, {tls, _Ref, _Type, _Bool}}, _) -> + stop; + %% Listener process has died. transition({'DOWN', _, process, Pid, _}, #transport{mode = {accept, Pid}}) -> stop; %% Parent process has died. transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) -> - stop. + stop; + +%% Request for the local port number. +transition({resolve_port, Pid}, #transport{socket = Sock}) + when is_pid(Pid) -> + Pid ! inet:port(Sock), + ok. %% Crash on anything unexpected. -%% accept/2 +%% accept/3 %% %% Start a new transport process or use one that's already been %% started as a consequence of association establishment. %% No pending associations: spawn a new transport. -accept(Pid, #listener{socket = Sock, - tmap = T, - pending = {0,_} = Q} - = S) -> - Arg = {accept, Pid, self(), Sock}, +accept(Ref, Pid, #listener{socket = Sock, + tmap = T, + pending = {0,_} = Q} + = S) -> + Arg = {accept, Pid, self(), Sock, Ref}, {ok, TPid} = diameter_sctp_sup:start_child(Arg), MRef = erlang:monitor(process, TPid), ets:insert(T, [{MRef, TPid}, {TPid, MRef}]), @@ -442,12 +493,12 @@ accept(Pid, #listener{socket = Sock, %% Accepting transport has died. This can happen if a new transport is %% started before the DOWN has arrived. -accept(Pid, #listener{pending = [TPid | {0,_} = Q]} = S) -> +accept(Ref, Pid, #listener{pending = [TPid | {0,_} = Q]} = S) -> false = is_process_alive(TPid), %% assert - accept(Pid, S#listener{pending = Q}); + accept(Ref, Pid, S#listener{pending = Q}); %% Pending associations: attach to the first in the queue. -accept(Pid, #listener{ref = Ref, pending = {N,Q}} = S) -> +accept(_, Pid, #listener{ref = Ref, pending = {N,Q}} = S) -> TPid = ets:first(Q), TPid ! {Ref, Pid}, ets:delete(Q, TPid), @@ -499,8 +550,14 @@ recv({[], #sctp_assoc_change{state = comm_up, outbound_streams = OS, inbound_streams = IS, assoc_id = Id}}, - #transport{assoc_id = undefined} + #transport{assoc_id = undefined, + mode = {T, _}, + socket = Sock} = S) -> + Ref = getr(ref), + is_reference(Ref) %% started in new code + andalso + (true = diameter_reg:add_new({?MODULE, 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 653c114471..78dbda6888 100644 --- a/lib/diameter/src/transport/diameter_tcp.erl +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -37,6 +37,9 @@ code_change/3, terminate/2]). +-export([ports/0, + ports/1]). + -include_lib("diameter/include/diameter.hrl"). -define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})). @@ -45,6 +48,9 @@ -define(LISTENER_TIMEOUT, 30000). -define(FRAGMENT_TIMEOUT, 1000). +%% cb_info passed to ssl. +-define(TCP_CB(Mod), {Mod, tcp, tcp_closed, tcp_error}). + %% The same gen_server implementation supports three different kinds %% of processes: an actual transport process, one that will club it to %% death should the parent die before a connection is established, and @@ -71,8 +77,8 @@ {socket :: inet:socket(), %% accept or connect socket parent :: pid(), %% of process that started us module :: module(), %% gen_tcp-like module - frag = <<>> :: binary() | {tref(), frag()}}). %% message fragment - + frag = <<>> :: binary() | {tref(), frag()}, %% message fragment + ssl :: boolean() | [term()]}). %% ssl options %% 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 @@ -122,12 +128,18 @@ 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}), - Sock = i(T, Ref, Mod, Pid, Opts, Addrs), + {SslOpts, Rest} = ssl(Opts), + Sock = i(T, Ref, Mod, Pid, SslOpts, Rest, Addrs), MPid ! {stop, self()}, %% tell the monitor to die - setopts(Mod, Sock), + M = if SslOpts -> ssl; true -> Mod end, + setopts(M, Sock), + putr(ref, Ref), #transport{parent = Pid, - module = Mod, - socket = Sock}; + module = M, + socket = Sock, + ssl = SslOpts}; +%% Put the reference in the process dictionary since we now use it +%% advertise the ssl socket after TLS upgrade. %% A monitor process to kill the transport if the parent dies. i(#monitor{parent = Pid, transport = TPid} = S) -> @@ -146,27 +158,51 @@ i({listen, LRef, APid, {Mod, Opts, Addrs}}) -> LAddr = get_addr(LA, Addrs), LPort = get_port(LP), {ok, LSock} = Mod:listen(LPort, gen_opts(LAddr, Rest)), + true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}), proc_lib:init_ack({ok, self(), {LAddr, LSock}}), erlang:monitor(process, APid), - true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}), start_timer(#listener{socket = LSock}). -%% i/6 +ssl(Opts) -> + {[SslOpts], Rest} = proplists:split(Opts, [ssl_options]), + {ssl_opts(SslOpts), Rest}. + +ssl_opts([]) -> + false; +ssl_opts([{ssl_options, true}]) -> + true; +ssl_opts([{ssl_options, Opts}]) + when is_list(Opts) -> + Opts; +ssl_opts(L) -> + ?ERROR({ssl_options, L}). + +%% i/7 + +%% Establish a TLS connection before capabilities exchange ... +i(Type, Ref, Mod, Pid, true, Opts, Addrs) -> + i(Type, Ref, ssl, Pid, [{cb_info, ?TCP_CB(Mod)} | Opts], Addrs); + +%% ... or not. +i(Type, Ref, Mod, Pid, _, Opts, Addrs) -> + i(Type, Ref, Mod, Pid, Opts, Addrs). -i(accept, Ref, Mod, Pid, Opts, Addrs) -> +i(accept = T, Ref, Mod, Pid, Opts, Addrs) -> {LAddr, LSock} = listener(Ref, {Mod, Opts, Addrs}), proc_lib:init_ack({ok, self(), [LAddr]}), Sock = ok(accept(Mod, LSock)), + true = diameter_reg:add_new({?MODULE, T, {Ref, Sock}}), diameter_peer:up(Pid), Sock; -i(connect, _, Mod, Pid, Opts, Addrs) -> +i(connect = T, Ref, Mod, Pid, Opts, Addrs) -> {[LA, RA, RP], Rest} = proplists:split(Opts, [ip, raddr, rport]), LAddr = get_addr(LA, Addrs), RAddr = get_addr(RA, []), RPort = get_port(RP), proc_lib:init_ack({ok, self(), [LAddr]}), Sock = ok(connect(Mod, RAddr, RPort, gen_opts(LAddr, Rest))), + true = diameter_reg:add_new({?MODULE, T, {Ref, Sock}}), diameter_peer:up(Pid, {RAddr, RPort}), Sock. @@ -227,6 +263,43 @@ gen_opts(LAddr, Opts) -> | Opts]. %% --------------------------------------------------------------------------- +%% # ports/1 +%% --------------------------------------------------------------------------- + +ports() -> + Ts = diameter_reg:match({?MODULE, '_', '_'}), + [{type(T), resolve(T,S), Pid} || {{?MODULE, T, {_,S}}, Pid} <- Ts]. + +ports(Ref) -> + Ts = diameter_reg:match({?MODULE, '_', {Ref, '_'}}), + [{type(T), resolve(T,S), Pid} || {{?MODULE, T, {R,S}}, Pid} <- Ts, + R == Ref]. + +type(listener) -> + listen; +type(T) -> + T. + +sock(listener, {_LAddr, Sock}) -> + Sock; +sock(_, Sock) -> + Sock. + +resolve(Type, S) -> + Sock = sock(Type, S), + try + ok(portnr(Sock)) + catch + _:_ -> Sock + end. + +portnr(Sock) + when is_port(Sock) -> + portnr(gen_tcp, Sock); +portnr(Sock) -> + portnr(ssl, Sock). + +%% --------------------------------------------------------------------------- %% # handle_call/3 %% --------------------------------------------------------------------------- @@ -258,6 +331,8 @@ 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}. @@ -270,6 +345,12 @@ terminate(_, _) -> %% --------------------------------------------------------------------------- +putr(Key, Val) -> + put({?MODULE, Key}, Val). + +getr(Key) -> + get({?MODULE, Key}). + %% start_timer/1 start_timer(#listener{count = 0} = S) -> @@ -332,17 +413,56 @@ t(T,S) -> %% transition/2 +%% 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, + module = M, + ssl = Opts} + = S) + when is_list(Opts) -> + case recv1(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} + end; + %% Incoming message. -transition({tcp, Sock, Data}, #transport{socket = Sock, - module = M} - = S) -> +transition({P, Sock, Bin}, #transport{socket = Sock, + module = M, + ssl = B} + = S) + when P == tcp, not B; + P == ssl, B -> + setopts(M, Sock), + recv(Bin, S); + +%% Capabilties exchange has decided on whether or not to run over TLS. +transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid} + = S) -> + #transport{socket = Sock, + module = M} + = NS + = tls_handshake(Type, B, S), + Pid ! {diameter, {tls, Ref}}, setopts(M, Sock), - recv(Data, S); + NS#transport{ssl = B}; -transition({tcp_closed, Sock}, #transport{socket = Sock}) -> +transition({C, Sock}, #transport{socket = Sock, + ssl = B}) + when C == tcp_closed, not B; + C == ssl_closed, B -> stop; -transition({tcp_error, Sock, _Reason} = T, #transport{socket = Sock} = S) -> +transition({E, Sock, _Reason} = T, #transport{socket = Sock, + ssl = B} + = S) + when E == tcp_error, not B; + E == ssl_error, B -> ?ERROR({T,S}); %% Outgoing message. @@ -367,10 +487,10 @@ transition({timeout, TRef, flush}, S) -> flush(TRef, S); %% Request for the local port number. -transition({resolve_port, RPid}, #transport{socket = Sock, - module = M}) - when is_pid(RPid) -> - RPid ! lport(M, Sock), +transition({resolve_port, Pid}, #transport{socket = Sock, + module = M}) + when is_pid(Pid) -> + Pid ! portnr(M, Sock), ok; %% Parent process has died. @@ -379,80 +499,122 @@ transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) -> %% Crash on anything unexpected. +%% tls_handshake/3 +%% +%% In the case that no tls message is received (eg. the service hasn't +%% been configured to advertise TLS support) we will simply never ask +%% for another TCP message, which will force the watchdog to +%% eventually take us down. + +%% TLS has already been established with the connection. +tls_handshake(_, _, #transport{ssl = true} = S) -> + S; + +%% Capabilities exchange negotiated TLS but transport was not +%% configured with an options list. +tls_handshake(_, true, #transport{ssl = false}) -> + ?ERROR(no_ssl_options); + +%% Capabilities exchange negotiated TLS: upgrade the connection. +tls_handshake(Type, true, #transport{socket = Sock, + module = M, + ssl = Opts} + = S) -> + {ok, SSock} = tls(Type, Sock, [{cb_info, ?TCP_CB(M)} | Opts]), + Ref = getr(ref), + is_reference(Ref) %% started in new code + andalso + (true = diameter_reg:add_new({?MODULE, Type, {Ref, SSock}})), + S#transport{socket = SSock, + module = ssl}; + +%% Capabilities exchange has not negotiated TLS. +tls_handshake(_, false, S) -> + S. + +tls(connect, Sock, Opts) -> + ssl:connect(Sock, Opts); +tls(accept, Sock, Opts) -> + ssl:ssl_accept(Sock, Opts). + %% recv/2 %% %% Reassemble fragmented messages and extract multple message sent %% using Nagle. recv(Bin, #transport{parent = Pid, frag = Head} = S) -> - S#transport{frag = recv(Pid, Head, Bin)}. + case recv1(Head, Bin) of + {Msg, B} when is_binary(Msg) -> + diameter_peer:recv(Pid, Msg), + recv(B, S#transport{frag = <<>>}); + Frag -> + S#transport{frag = Frag} + end. -%% recv/3 +%% recv1/2 %% No previous fragment. -recv(Pid, <<>>, Bin) -> - rcv(Pid, Bin); +recv1(<<>>, Bin) -> + rcv(Bin); -recv(Pid, {TRef, Head}, Bin) -> +recv1({TRef, Head}, Bin) -> erlang:cancel_timer(TRef), - rcv(Pid, Head, Bin). + rcv(Head, Bin). -%% rcv/3 +%% rcv/2 %% Not even the first four bytes of the header. -rcv(Pid, Head, Bin) +rcv(Head, Bin) when is_binary(Head) -> - rcv(Pid, <<Head/binary, Bin/binary>>); + rcv(<<Head/binary, Bin/binary>>); %% Or enough to know how many bytes to extract. -rcv(Pid, {Len, N, Head, Acc}, Bin) -> - rcv(Pid, Len, N + size(Bin), Head, [Bin | Acc]). +rcv({Len, N, Head, Acc}, Bin) -> + rcv(Len, N + size(Bin), Head, [Bin | Acc]). -%% rcv/5 +%% rcv/4 %% Extract a message for which we have all bytes. -rcv(Pid, Len, N, Head, Acc) +rcv(Len, N, Head, Acc) when Len =< N -> - rcv(Pid, rcv1(Pid, Len, bin(Head, Acc))); + rcv1(Len, bin(Head, Acc)); %% Wait for more packets. -rcv(_, Len, N, Head, Acc) -> +rcv(Len, N, Head, Acc) -> {start_timer(), {Len, N, Head, Acc}}. %% rcv/2 %% Nothing left. -rcv(_, <<>> = Bin) -> +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. -rcv(Pid, <<_:1/binary, Len:24, _/binary>> = Bin) +rcv(<<_:1/binary, Len:24, _/binary>> = Bin) when Len < 20 -> - diameter_peer:recv(Pid, Bin), - <<>>; + {Bin, <<>>}; %% Enough bytes to extract a message. -rcv(Pid, <<_:1/binary, Len:24, _/binary>> = Bin) +rcv(<<_:1/binary, Len:24, _/binary>> = Bin) when Len =< size(Bin) -> - rcv(Pid, rcv1(Pid, Len, Bin)); + rcv1(Len, Bin); %% Or not: wait for more packets. -rcv(_, <<_:1/binary, Len:24, _/binary>> = Head) -> +rcv(<<_:1/binary, Len:24, _/binary>> = Head) -> {start_timer(), {Len, size(Head), Head, []}}; %% Not even 4 bytes yet. -rcv(_, Head) -> +rcv(Head) -> {start_timer(), Head}. -%% rcv1/3 +%% rcv1/2 -rcv1(Pid, Len, Bin) -> +rcv1(Len, Bin) -> <<Msg:Len/binary, Rest/binary>> = Bin, - diameter_peer:recv(Pid, Msg), - Rest. + {Msg, Rest}. %% bin/[12] @@ -489,15 +651,18 @@ flush(_, S) -> %% accept/2 -accept(gen_tcp, LSock) -> - gen_tcp:accept(LSock); +accept(ssl, LSock) -> + case ssl:transport_accept(LSock) of + {ok, Sock} -> + {ssl:ssl_accept(Sock), Sock}; + {error, _} = No -> + No + end; accept(Mod, LSock) -> Mod:accept(LSock). %% connect/4 -connect(gen_tcp, Host, Port, Opts) -> - gen_tcp:connect(Host, Port, Opts); connect(Mod, Host, Port, Opts) -> Mod:connect(Host, Port, Opts). @@ -505,6 +670,8 @@ connect(Mod, Host, Port, Opts) -> send(gen_tcp, Sock, Bin) -> gen_tcp:send(Sock, Bin); +send(ssl, Sock, Bin) -> + ssl:send(Sock, Bin); send(M, Sock, Bin) -> M:send(Sock, Bin). @@ -512,6 +679,8 @@ send(M, Sock, Bin) -> setopts(gen_tcp, Sock, Opts) -> inet:setopts(Sock, Opts); +setopts(ssl, Sock, Opts) -> + ssl:setopts(Sock, Opts); setopts(M, Sock, Opts) -> M:setopts(Sock, Opts). @@ -523,9 +692,16 @@ setopts(M, Sock) -> X -> x({setopts, M, Sock, X}) %% possibly on peer disconnect end. -%% lport/2 +%% portnr/2 -lport(gen_tcp, Sock) -> +portnr(gen_tcp, Sock) -> inet:port(Sock); -lport(M, Sock) -> +portnr(ssl, Sock) -> + case ssl:sockname(Sock) of + {ok, {_Addr, PortNr}} -> + {ok, PortNr}; + {error, _} = No -> + No + end; +portnr(M, Sock) -> M:port(Sock). diff --git a/lib/diameter/src/transport/modules.mk b/lib/diameter/src/transport/modules.mk deleted file mode 100644 index a0dc3cf2c0..0000000000 --- a/lib/diameter/src/transport/modules.mk +++ /dev/null @@ -1,29 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %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% - -MODULES = \ - diameter_etcp \ - diameter_etcp_sup \ - diameter_tcp \ - diameter_tcp_sup \ - diameter_sctp \ - diameter_sctp_sup \ - diameter_transport_sup - -HRL_FILES = diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile index dba1f126dc..97d9069f4a 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -17,15 +17,13 @@ # %CopyrightEnd% ifeq ($(ERL_TOP),) -TOP = $(DIAMETER_TOP) +include $(DIAMETER_TOP)/make/target.mk +include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk else -TOP = $(ERL_TOP) -DIAMETER_TOP = $(TOP)/lib/diameter +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk endif -include $(TOP)/make/target.mk -include $(TOP)/make/$(TARGET)/otp.mk - # ---------------------------------------------------- # Application version # ---------------------------------------------------- @@ -46,38 +44,32 @@ RELSYSDIR = $(RELEASE_PATH)/diameter_test include modules.mk -EBIN = . - -HRL_FILES = $(INTERNAL_HRL_FILES) -ERL_FILES = $(MODULES:%=%.erl) - -SOURCE = $(HRL_FILES) $(ERL_FILES) +ERL_FILES = $(MODULES:%=%.erl) TARGET_FILES = $(MODULES:%=%.$(EMULATOR)) SUITE_MODULES = $(filter diameter_%_SUITE, $(MODULES)) -SUITES = $(SUITE_MODULES:diameter_%_SUITE=%) - -RELTEST_FILES = $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) $(SOURCE) +SUITES = $(SUITE_MODULES:diameter_%_SUITE=%) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -include ../src/app/diameter.mk - # This is only used to compile suite locally when running with a # target like 'all' below. Target release_tests only installs source. -ERL_COMPILE_FLAGS += $(DIAMETER_ERL_COMPILE_FLAGS) \ - -DDIAMETER_CT=true \ - -I $(DIAMETER_TOP)/src/app +ERL_COMPILE_FLAGS += +warn_export_vars \ + +warn_unused_vars \ + -I ../include \ + -I ../src/gen # ---------------------------------------------------- # Targets # ---------------------------------------------------- -all: $(SUITES) +all: opt -tests debug opt: $(TARGET_FILES) +run: $(SUITES) + +debug opt: $(TARGET_FILES) clean: rm -f $(TARGET_FILES) @@ -85,65 +77,55 @@ clean: realclean: clean rm -rf log - rm -f errs core *~ - -.PHONY: all tests debug opt clean realclean docs: +list = echo $(1):; echo $($(1)) | tr ' ' '\n' | sort | sed 's@^@ @' + info: - @echo "TARGET_FILES = $(TARGET_FILES)" - @echo - @echo "ERL_COMPILE_FLAGS = $(ERL_COMPILE_FLAGS)" - @echo "ERL = $(ERL)" - @echo "ERLC = $(ERLC)" - @echo - @echo "HRL_FILES = $(HRL_FILES)" - @echo "ERL_FILES = $(ERL_FILES)" - @echo "TARGET_FILES = $(TARGET_FILES)" + @echo ======================================== + @$(call list,MODULES) @echo - @echo "SUITE_MODULES = $(SUITE_MODULES)" - @echo "SUITES = $(SUITES)" + @$(call list,HRL_FILES) @echo + @$(call list,SUITES) + @echo ======================================== help: + @echo ======================================== + @echo "Useful targets:" @echo - @echo "Targets:" + @echo " all:" + @echo " Compile all test suites." @echo - @echo " all" - @echo " Run all test suites." + @echo " run:" + @echo " Compile and run all test suites." @echo - @echo " $(SUITES)" - @echo " Run a specific test suite." + @echo " $(SUITES):" + @echo " Compile and run a specific test suite." @echo - @echo " tests" - @echo " Compile all test-code." - @echo - @echo " clean | realclean" + @echo " clean | realclean:" @echo " Remove generated files." @echo - @echo " info" - @echo " Prints various environment variables." - @echo " May be useful when debugging this Makefile." - @echo - @echo " help" - @echo " Print this info." - @echo + @echo " info:" + @echo " Echo some relevant variables." + @echo ======================================== -.PHONY: docs info help +.PHONY: all run clean debug docs help info opt realclean # ---------------------------------------------------- # Special Targets # ---------------------------------------------------- # Exit with a non-zero status if the output looks to indicate failure. -# diameter_ct:run/1 itself can't tell (it seems). -$(SUITES): log tests +# diameter_ct:run/1 itself can't tell (it seems). The absolute -pa is +# because ct will change directories. +$(SUITES): log opt $(ERL) -noshell \ - -pa $(DIAMETER_TOP)/ebin \ - -sname diameter_test_$@ \ - -s diameter_ct run diameter_$@_SUITE \ - -s init stop \ + -pa $(realpath ../ebin) \ + -sname diameter_test_$@ \ + -s diameter_ct run diameter_$@_SUITE \ + -s init stop \ | awk '1{rc=0} {print} / FAILED /{rc=1} END{exit rc}' # Shorter in sed but requires a GNU extension (ie. Q). @@ -156,7 +138,14 @@ log: # Release Targets # ---------------------------------------------------- -include $(TOP)/make/otp_release_targets.mk +/%: % force + sed -f release.sed $< > $(RELSYSDIR)$@ + +ifeq ($(ERL_TOP),) +include $(DIAMETER_TOP)/make/release_targets.mk +else +include $(ERL_TOP)/make/otp_release_targets.mk +endif release_spec: @@ -164,9 +153,19 @@ release_docs_spec: release_tests_spec: $(INSTALL_DIR) $(RELSYSDIR) - $(INSTALL_DATA) $(RELTEST_FILES) $(RELSYSDIR) + $(INSTALL_DATA) $(TEST_SPEC_FILE) \ + $(COVER_SPEC_FILE) \ + $(HRL_FILES) \ + $(RELSYSDIR) + $(MAKE) $(ERL_FILES:%=/%) + +force: .PHONY: release_spec release_docs_spec release_test_specs +.PHONY: force + +# Can't just make $(ERL_FILES:%=/%) phony since then implicit rule +# searching is skipped. # ---------------------------------------------------- @@ -175,7 +174,7 @@ depend: depend.mk # Generate dependencies makefile. depend.mk: depend.sed $(MODULES:%=%.erl) Makefile (for f in $(MODULES); do \ - sed -f $< $$f.erl | sed "s@/@/$$f@"; \ + (echo $$f; cat $$f.erl) | sed -f $<; \ done) \ > $@ diff --git a/lib/diameter/test/depend.sed b/lib/diameter/test/depend.sed index a399eb45f0..95dca44984 100644 --- a/lib/diameter/test/depend.sed +++ b/lib/diameter/test/depend.sed @@ -18,14 +18,24 @@ # # -# Extract local include dependencies from .erl files. The output is massaged -# further in Makefile. +# Extract local include dependencies from an .erl file. The first +# input line is the module name. # -/^-include/!d +# Store the module name in the hold space. +1{ + h + d +} + +# Throw away everything but local includes. /^-include_lib/d +/^-include/!d /diameter_gen/d +/diameter\./d +# Output a dependency of the beam on the included file. s@^-include("@@ s@".*@@ -s@^@$(EBIN)/.$(EMULATOR): @ +G +s@^\(.*\)\n\(.*\)@$(EBIN)/\2.$(EMULATOR): \1@ diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl index 104785b4e6..d5ecdea291 100644 --- a/lib/diameter/test/diameter_app_SUITE.erl +++ b/lib/diameter/test/diameter_app_SUITE.erl @@ -98,6 +98,7 @@ modules(Config) -> diameter_dbg, diameter_exprecs, diameter_info, + diameter_make, diameter_spec_scan, diameter_spec_util], {[], Help} = {Mods -- Installed, lists:sort(Installed -- Mods)}. @@ -147,14 +148,13 @@ appvsn(Name) -> %% =========================================================================== %% # xref/1 %% -%% Ensure that no function in our application calls an undefined function. +%% Ensure that no function in our application calls an undefined function +%% or one in an application we haven't specified as a dependency. (Almost.) %% =========================================================================== xref(Config) -> App = fetch(app, Config), - Mods = fetch(modules, App) -- [diameter_codegen, diameter_dbg], - %% Skip modules that aren't required at runtime and that have - %% dependencies beyond those applications listed in the app file. + Mods = fetch(modules, App), {ok, XRef} = xref:start(make_name(xref_test_name)), ok = xref:set_default(XRef, [{verbose, false}, {warnings, false}]), @@ -164,7 +164,10 @@ xref(Config) -> %% stop xref from complaining about calls to module erlang, which %% was previously in kernel. Erts isn't an application however, in %% the sense that there's no .app file, and isn't listed in - %% applications. Seems less than ideal. + %% applications. Seems less than ideal. Also, diameter_tcp does + %% call ssl despite ssl not being listed as a dependency in the + %% app file since ssl is only required for TLS security: it's up + %% to a client who wants TLS it to start ssl. ok = lists:foreach(fun(A) -> add_application(XRef, A) end, [?APP, erts | fetch(applications, App)]), @@ -173,7 +176,11 @@ xref(Config) -> xref:stop(XRef), %% Only care about calls from our own application. - [] = lists:filter(fun({{M,_,_},_}) -> lists:member(M, Mods) end, Undefs). + [] = lists:filter(fun({{F,_,_},{T,_,_}}) -> + lists:member(F, Mods) + andalso {F,T} /= {diameter_tcp, ssl} + end, + Undefs). add_application(XRef, App) -> add_application(XRef, App, code:lib_dir(App)). diff --git a/lib/diameter/test/diameter_capx_SUITE.erl b/lib/diameter/test/diameter_capx_SUITE.erl new file mode 100644 index 0000000000..e6b1558bf6 --- /dev/null +++ b/lib/diameter/test/diameter_capx_SUITE.erl @@ -0,0 +1,432 @@ +%% +%% %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% +%% + +%% +%% Tests of capabilities exchange between Diameter nodes. In +%% particular, of error and event handling. +%% + +-module(diameter_capx_SUITE). + +-export([suite/0, + all/0, + groups/0, + init_per_group/2, + end_per_group/2, + init_per_testcase/2, + end_per_testcase/2]). + +%% testcases +-export([start/1, + start_services/1, + add_listeners/1, + s_no_common_application/1, + c_no_common_application/1, + s_no_common_security/1, + c_no_common_security/1, + s_unknown_peer/1, + c_unknown_peer/1, + s_unable/1, + c_unable/1, + s_client_reject/1, + c_client_reject/1, + remove_listeners/1, + stop_services/1, + stop/1]). + +%% diameter callbacks +-export([peer_up/4, + peer_down/4]). + +-include("diameter.hrl"). +-include("diameter_gen_base_rfc3588.hrl"). + +%% =========================================================================== + +-define(util, diameter_util). + +-define(CLIENT, client). +-define(SERVER, server). + +-define(ADDR, {127,0,0,1}). + +-define(REALM, "erlang.org"). +-define(HOST(Name), Name ++ "." ++ ?REALM). + +%% Config for diameter:start_service/2. +-define(SERVICE(Name), + [{'Origin-Realm', ?REALM}, + {'Host-IP-Address', [?ADDR]}, + {'Vendor-Id', 12345}, + {'Product-Name', "OTP/diameter"}, + {'Auth-Application-Id', [?DIAMETER_APP_ID_COMMON]}, + {'Acct-Application-Id', [?DIAMETER_APP_ID_ACCOUNTING]} + | [{application, [{alias, A}, + {dictionary, D}, + {module, [?MODULE, A]}]} + || {A,D} <- [{common, ?DIAMETER_DICT_COMMON}, + {accounting, ?DIAMETER_DICT_ACCOUNTING}]]]). + +-define(A, list_to_atom). +-define(L, atom_to_list). + +-define(event, #diameter_event). +-define(caps, #diameter_caps). +-define(packet, #diameter_packet). + +-define(cea, #diameter_base_CEA). +-define(answer_message, #'diameter_base_answer-message'). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 10}}]. + +all() -> + [start, start_services, add_listeners + | [{group, N} || {N, _, _} <- groups()]] + ++ [remove_listeners, stop_services, stop]. + +groups() -> + Ts = testcases(), + [{grp(P), P, Ts} || P <- [[], [parallel]]]. + +grp([]) -> + sequential; +grp([parallel = P]) -> + P. + +init_per_group(_Name, Config) -> + Config. + +end_per_group(_, _) -> + ok. + +%% Generate a unique hostname for each testcase so that watchdogs +%% don't prevent a connection from being brought up immediately. +init_per_testcase(Name, Config) -> + Uniq = ["." ++ integer_to_list(N) || N <- tuple_to_list(now())], + [{host, lists:flatten([?L(Name) | Uniq])} | Config]. + +end_per_testcase(N, _) + when N == start; + N == start_services; + N == add_listeners; + N == remove_listeners; + N == stop_services; + N == stop -> + ok; +end_per_testcase(Name, Config) -> + CRef = ?util:read_priv(Config, Name), + ok = diameter:remove_transport(?CLIENT, CRef). + +%% Testcases all come in two flavours, client and server. +testcases() -> + lists:flatmap(fun tc/1, tc()). + +tc(Name) -> + [?A([C,$_|?L(Name)]) || C <- "cs"]. + +tc() -> + [no_common_application, + no_common_security, + unknown_peer, + unable, + client_reject]. + +%% =========================================================================== +%% start/stop testcases + +start(_Config) -> + ok = diameter:start(). + +start_services(_Config) -> + ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)), + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)). + +%% One server that responds only to base accounting, one that responds +%% 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]}]), + ?util:write_priv(Config, ?MODULE, {Base, Acct}). %% lref/2 reads + +remove_listeners(_Config) -> + ok = diameter:remove_transport(?SERVER, true). + +stop_services(_Config) -> + ok = diameter:stop_service(?CLIENT), + ok = diameter:stop_service(?SERVER). + +stop(_Config) -> + ok = diameter:stop(). + +%% =========================================================================== +%% All the testcases come in pairs, one for receiving an event on the +%% client side, one on the server side. Note that testcases will +%% receive events resulting from other testcases when running in +%% parallel since the events are per service. The unique client +%% Origin-Host for each testcase plus transport references are used to +%% ensure that only the relevant event is extracted from the mailbox. +%% Don't bother extracting events that aren't relevant. + +%% ==================== +%% Ask the accounting server to speak the common application and expect +%% DIAMETER_NO_COMMON_APPLICATION = 5010. + +s_no_common_application(Config) -> + server_closed(Config, fun no_common_application/1, 5010). + +c_no_common_application(Config) -> + client_closed(Config, "acct-srv", fun no_common_application/1, 5010). + +no_common_application(Config) -> + connect(Config, acct, [{capabilities, [{'Acct-Application-Id', []}]}, + {applications, [common]}]). + +%% ==================== +%% Ask the base server to speak accounting with an unknown security +%% method and expect DIAMETER_NO_COMMON_SECURITY = 5017. + +s_no_common_security(Config) -> + server_closed(Config, fun no_common_security/1, 5017). + +c_no_common_security(Config) -> + client_closed(Config, "base-srv", fun no_common_security/1, 5017). + +no_common_security(Config) -> + connect(Config, base, [{capabilities, [{'Acct-Application-Id', []}, + {'Inband-Security-Id', [17, 18]}]}, + {applications, [common]}]). + +%% ==================== +%% Have the base server reject a decent CER with the protocol error +%% DIAMETER_UNKNOWN_PEER = 3010. + +s_unknown_peer(Config) -> + server_reject(Config, fun base/1, 3010). + +c_unknown_peer(Config) -> + true = diameter:subscribe(?CLIENT), + OH = ?HOST("base-srv"), + + {CRef, _} = base(Config), + + {'CEA', ?caps{}, + ?packet{msg = ?answer_message{'Origin-Host' = OH, + 'Result-Code' = 3010}}} + = client_recv(CRef). + +base(Config) -> + connect(Config, base, []). + +%% ==================== +%% Have the base server reject a decent CER with the non-protocol +%% error DIAMETER_UNABLE_TO_COMPLY = 5012. + +s_unable(Config) -> + server_reject(Config, fun base/1, 5012). + +c_unable(Config) -> + client_closed(Config, "base-srv", fun base/1, 5012). + +%% ==================== +%% Have the client reject a decent CEA. + +s_client_reject(Config) -> + true = diameter:subscribe(?SERVER), + OH = host(Config), + + {_, LRef} = client_reject(Config), + + receive + ?event{service = ?SERVER, + info = {up, LRef, + {_, ?caps{origin_host = {_, OH}}}, + {listen, _}, + ?packet{}}} + = Info -> + Info + after 2000 -> + fail({LRef, OH}) + end. + +c_client_reject(Config) -> + true = diameter:subscribe(?CLIENT), + OH = ?HOST("acct-srv"), + + {CRef, _} = client_reject(Config), + + {'CEA', {capabilities_cb, _, discard}, + ?caps{origin_host = {_, OH}}, + ?packet{msg = ?cea{'Result-Code' = 2001}}} + = client_recv(CRef). + +client_reject(Config) -> + connect(Config, acct, [{capabilities_cb, fun client_capx/2}]). + +%% =========================================================================== + +%% server_closed/3 + +server_closed(Config, F, RC) -> + true = diameter:subscribe(?SERVER), + OH = host(Config), + + {_, LRef} = F(Config), + + receive + ?event{service = ?SERVER, + info = {closed, LRef, + {'CER', RC, + ?caps{origin_host = {_, OH}}, + ?packet{}} + = Reason, + {listen, _}}} -> + Reason + after 2000 -> + fail({LRef, OH}) + end. + +%% server_reject/3 + +server_reject(Config, F, RC) -> + true = diameter:subscribe(?SERVER), + OH = host(Config), + + {_, LRef} = F(Config), + + receive + ?event{service = ?SERVER, + info = {closed, LRef, + {'CER', {capabilities_cb, _, RC}, + ?caps{origin_host = {_, OH}}, + ?packet{}} + = Reason, + {listen, _}}} -> + Reason + after 2000 -> + fail({LRef, OH}) + end. + +%% cliient_closed/4 + +client_closed(Config, Host, F, RC) -> + true = diameter:subscribe(?CLIENT), + OH = ?HOST(Host), + + {CRef, _} = F(Config), + + {'CEA', RC, ?caps{origin_host = {_, OH}}, ?packet{}} + = client_recv(CRef). + +%% client_recv/1 + +client_recv(CRef) -> + receive + ?event{service = ?CLIENT, + info = {closed, CRef, Reason, {connect, _}}} -> + Reason + after 2000 -> + fail(CRef) + end. + +%% server_capx/3 + +server_capx(_, ?caps{origin_host = {_, [_,$_|"unknown_peer." ++ _]}}, _) -> + unknown; + +server_capx(_, ?caps{origin_host = {_, [_,$_|"unable." ++ _]}}, _) -> + 5012; %% DIAMETER_UNABLE_TO_COMPLY + +server_capx(_, ?caps{origin_host = {OH,DH}}, _) -> + io:format("connection: ~p -> ~p~n", [DH,OH]), + ok. + +%% client_capx/2 + +client_capx(_, ?caps{origin_host = {[_,$_|"client_reject." ++ _], _}}) -> + discard. + +%% =========================================================================== + +fail(T) -> + erlang:error({T, process_info(self(), messages)}). + +host(Config) -> + {_, H} = lists:keyfind(host, 1, Config), + ?HOST(H). + +listen(Name, Opts) -> + ?util:listen(Name, tcp, Opts). + +connect(Config, T, Opts) -> + {_, H} = lists:keyfind(host, 1, Config), + LRef = lref(Config, T), + CRef = connect(LRef, [{capabilities, [{'Origin-Host', ?HOST(H)}]} + | Opts]), + Name = lists:takewhile(fun(C) -> C /= $. end, H), + ?util:write_priv(Config, Name, CRef), %% end_per_testcase reads + {CRef, LRef}. + +connect(LRef, Opts) -> + [PortNr] = ?util:lport(tcp, LRef, 20), + {ok, CRef} = diameter:add_transport(?CLIENT, + {connect, opts(PortNr, Opts)}), + CRef. + +opts(PortNr, Opts) -> + [{transport_module, diameter_tcp}, + {transport_config, [{raddr, ?ADDR}, + {rport, PortNr}, + {ip, ?ADDR}, + {port, 0}]} + | Opts]. + +lref(Config, T) -> + case ?util:read_priv(Config, ?MODULE) of + {LRef, _} when T == base -> + LRef; + {_, LRef} when T == acct -> + LRef + end. + +%% =========================================================================== +%% diameter callbacks + +peer_up(?SERVER, + {_, ?caps{origin_host = {"acct-srv." ++ _, + [_,$_|"client_reject." ++ _]}}}, + State, + _) -> + State. + +peer_down(?SERVER, + {_, ?caps{origin_host = {"acct-srv." ++ _, + [_,$_|"client_reject." ++ _]}}}, + State, + _) -> + State. diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl index aab7ab35cc..8046ca4c04 100644 --- a/lib/diameter/test/diameter_codec_test.erl +++ b/lib/diameter/test/diameter_codec_test.erl @@ -25,7 +25,7 @@ %% Test encode/decode of dictionary-related modules. %% --include_lib("diameter/include/diameter.hrl"). +-include("diameter.hrl"). -define(BASE, diameter_gen_base_rfc3588). -define(BOOL, [true, false]). diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl new file mode 100644 index 0000000000..f4d62f94c6 --- /dev/null +++ b/lib/diameter/test/diameter_failover_SUITE.erl @@ -0,0 +1,257 @@ +%% +%% %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% +%% + +%% +%% Tests of traffic between six Diameter nodes in three realms, +%% connected as follows. +%% +%% ----- SERVER1.REALM2 +%% / +%% / ----- SERVER2.REALM2 +%% | / +%% CLIENT.REALM1 ------ SERVER3.REALM2 +%% | \ +%% | \ +%% \ ---- SERVER1.REALM3 +%% \ +%% ----- SERVER2.REALM3 +%% + +-module(diameter_failover_SUITE). + +-export([suite/0, + all/0]). + +%% testcases +-export([start/1, + start_services/1, + connect/1, + send_ok/1, + send_nok/1, + stop_services/1, + stop/1]). + +%% diameter callbacks +-export([peer_up/3, + peer_down/3, + pick_peer/4, + prepare_request/3, + prepare_retransmit/3, + handle_answer/4, + handle_error/4, + handle_request/3]). + +-include("diameter.hrl"). +-include("diameter_gen_base_rfc3588.hrl"). +-include("diameter_ct.hrl"). + +%% =========================================================================== + +-define(util, diameter_util). + +-define(ADDR, {127,0,0,1}). + +-define(CLIENT, "CLIENT.REALM1"). +-define(SERVER1, "SERVER1.REALM2"). +-define(SERVER2, "SERVER2.REALM2"). +-define(SERVER3, "SERVER3.REALM2"). +-define(SERVER4, "SERVER1.REALM3"). +-define(SERVER5, "SERVER2.REALM3"). + +-define(SERVICES, [?CLIENT, ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4, ?SERVER5]). + +-define(DICT_COMMON, ?DIAMETER_DICT_COMMON). + +-define(APP_ALIAS, the_app). +-define(APP_ID, ?DICT_COMMON:id()). + +%% Config for diameter:start_service/2. +-define(SERVICE(Host, Dict), + [{'Origin-Host', Host}, + {'Origin-Realm', realm(Host)}, + {'Host-IP-Address', [?ADDR]}, + {'Vendor-Id', 12345}, + {'Product-Name', "OTP/diameter"}, + {'Acct-Application-Id', [Dict:id()]}, + {application, [{alias, ?APP_ALIAS}, + {dictionary, Dict}, + {module, ?MODULE}, + {answer_errors, callback}]}]). + +-define(SUCCESS, 2001). + +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 10}}]. + +all() -> + [start, + start_services, + connect, + send_ok, + send_nok, + stop_services, + stop]. + +%% =========================================================================== +%% start/stop testcases + +start(_Config) -> + ok = diameter:start(). + +start_services(_Config) -> + S = [server(N, ?DICT_COMMON) || N <- tl(?SERVICES)], + + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), + + {save_config, [{?CLIENT, S}]}. + +connect(Config) -> + {_, Conns} = proplists:get_value(saved_config, Config), + + lists:foreach(fun({CN,Ss}) -> connect(CN, Ss) end, Conns). + +stop_services(_Config) -> + [] = [{H,T} || H <- ?SERVICES, + T <- [diameter:stop_service(H)], + T /= ok]. + +stop(_Config) -> + ok = diameter:stop(). + +%% ---------------------------------------- + +server(Name, Dict) -> + ok = diameter:start_service(Name, ?SERVICE(Name, Dict)), + {Name, ?util:listen(Name, tcp)}. + +connect(Name, Refs) -> + [{{Name, ?util:connect(Name, tcp, LRef)}, T} || {_, LRef} = T <- Refs]. + +%% =========================================================================== +%% traffic testcases + +%% Send an STR and expect success after SERVER3 answers after a couple +%% of failovers. +send_ok(_Config) -> + Req = ['STR', {'Destination-Realm', realm(?SERVER1)}, + {'Termination-Cause', ?LOGOUT}, + {'Auth-Application-Id', ?APP_ID}], + #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Origin-Host' = ?SERVER3} + = call(Req, [{filter, realm}]). + +%% Send an STR and expect failure when both servers fail. +send_nok(_Config) -> + Req = ['STR', {'Destination-Realm', realm(?SERVER4)}, + {'Termination-Cause', ?LOGOUT}, + {'Auth-Application-Id', ?APP_ID}], + {error, failover} = call(Req, [{filter, realm}]). + +%% =========================================================================== + +realm(Host) -> + tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). + +call(Req, Opts) -> + diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts). + +set([H|T], Vs) -> + [H | Vs ++ T]. + +%% =========================================================================== +%% diameter callbacks + +%% peer_up/3 + +peer_up(_SvcName, _Peer, State) -> + State. + +%% peer_down/3 + +peer_down(_SvcName, _Peer, State) -> + State. + +%% pick_peer/4 + +%% Choose a server other than SERVER3 or SERVER5 if possible. +pick_peer(Peers, _, ?CLIENT, _State) -> + case lists:partition(fun({_, #diameter_caps{origin_host = {_, OH}}}) -> + OH /= ?SERVER3 andalso OH /= ?SERVER5 + end, + Peers) + of + {[], [Peer]} -> + {ok, Peer}; + {[Peer | _], _} -> + {ok, Peer} + end. + +%% prepare_request/3 + +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}) -> + {send, prepare(Pkt, Caps)}. + +prepare(#diameter_packet{msg = Req}, Caps) -> + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, _}} + = Caps, + set(Req, [{'Session-Id', diameter:session_id(OH)}, + {'Origin-Host', OH}, + {'Origin-Realm', OR}]). + +%% prepare_retransmit/3 + +prepare_retransmit(Pkt, ?CLIENT, _Peer) -> + {send, Pkt}. + +%% handle_answer/4 + +handle_answer(Pkt, _Req, ?CLIENT, _Peer) -> + #diameter_packet{msg = Rec, errors = []} = Pkt, + Rec. + +%% handle_error/4 + +handle_error(Reason, _Req, ?CLIENT, _Peer) -> + {error, Reason}. + +%% handle_request/3 + +%% Only SERVER3 actually answers. +handle_request(Pkt, ?SERVER3, {_, Caps}) -> + #diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId, + 'Origin-Host' = ?CLIENT}} + = Pkt, + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, _}} + = Caps, + + {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Session-Id' = SId, + 'Origin-Host' = OH, + 'Origin-Realm' = OR}}; + +%% Others kill the transport to force failover. +handle_request(_, _, {TPid, _}) -> + exit(TPid, kill), + discard. diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl index d3d1fe690a..40cbdf805a 100644 --- a/lib/diameter/test/diameter_relay_SUITE.erl +++ b/lib/diameter/test/diameter_relay_SUITE.erl @@ -37,20 +37,22 @@ all/0, groups/0, init_per_group/2, - end_per_group/2, - init_per_suite/1, - end_per_suite/1]). + end_per_group/2]). %% testcases --export([send1/1, +-export([start/1, + start_services/1, + connect/1, + send1/1, send2/1, send3/1, send4/1, send_loop/1, send_timeout_1/1, send_timeout_2/1, - remove_transports/1, - stop_services/1]). + disconnect/1, + stop_services/1, + stop/1]). %% diameter callbacks -export([peer_up/3, @@ -62,17 +64,14 @@ handle_error/4, handle_request/3]). --ifdef(DIAMETER_CT). +-include("diameter.hrl"). -include("diameter_gen_base_rfc3588.hrl"). --else. --include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). --endif. - --include_lib("diameter/include/diameter.hrl"). -include("diameter_ct.hrl"). %% =========================================================================== +-define(util, diameter_util). + -define(ADDR, {127,0,0,1}). -define(CLIENT, "CLIENT.REALM1"). @@ -83,6 +82,10 @@ -define(SERVER3, "SERVER1.REALM3"). -define(SERVER4, "SERVER2.REALM3"). +-define(SERVICES, [?CLIENT, + ?RELAY1, ?RELAY2, + ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4]). + -define(DICT_COMMON, ?DIAMETER_DICT_COMMON). -define(DICT_RELAY, ?DIAMETER_DICT_RELAY). @@ -102,19 +105,6 @@ {module, ?MODULE}, {answer_errors, callback}]}]). -%% Config for diameter:add_transport/2. In the listening case, listen -%% on a free port that we then lookup using the implementation detail -%% that diameter_tcp registers the port with diameter_reg. --define(CONNECT(PortNr), - {connect, [{transport_module, diameter_tcp}, - {transport_config, [{raddr, ?ADDR}, - {rport, PortNr}, - {ip, ?ADDR}, - {port, 0}]}]}). --define(LISTEN, - {listen, [{transport_module, diameter_tcp}, - {transport_config, [{ip, ?ADDR}, {port, 0}]}]}). - -define(SUCCESS, 2001). -define(LOOP_DETECTED, 3005). -define(UNABLE_TO_DELIVER, 3002). @@ -122,22 +112,21 @@ -define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). -define(AUTHORIZE_ONLY, ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_ONLY'). --define(A, list_to_atom). --define(L, atom_to_list). - %% =========================================================================== suite() -> [{timetrap, {seconds, 10}}]. all() -> - [{group, N} || {N, _, _} <- groups()] - ++ [remove_transports, stop_services]. + [start, start_services, connect] + ++ tc() + ++ [{group, all}, + disconnect, + stop_services, + stop]. groups() -> - Ts = tc(), - [{all, [], Ts}, - {p, [parallel], Ts}]. + [{all, [parallel], tc()}]. init_per_group(_, Config) -> Config. @@ -145,32 +134,7 @@ init_per_group(_, Config) -> end_per_group(_, _) -> ok. -init_per_suite(Config) -> - ok = diameter:start(), - [S1,S2,S3,S4] = S = [server(N, ?DICT_COMMON) || N <- [?SERVER1, - ?SERVER2, - ?SERVER3, - ?SERVER4]], - [R1,R2] = R = [server(N, ?DICT_RELAY) || N <- [?RELAY1, ?RELAY2]], - - ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), - - true = diameter:subscribe(?RELAY1), - true = diameter:subscribe(?RELAY2), - true = diameter:subscribe(?CLIENT), - - [C1,C2] = connect(?RELAY1, [S1,S2]), - [C3,C4] = connect(?RELAY2, [S3,S4]), - [C5,C6] = connect(?CLIENT, [R1,R2]), - - C7 = connect(?RELAY1, R2), - - [{transports, {S, R, [C1,C2,C3,C4,C5,C6,C7]}} | Config]. - -end_per_suite(_Config) -> - ok = diameter:stop(). - -%% Testcases to run when services are started and connections +%% Traffic cases run when services are started and connections %% established. tc() -> [send1, @@ -181,43 +145,56 @@ tc() -> send_timeout_1, send_timeout_2]. -server(Host, Dict) -> - ok = diameter:start_service(Host, ?SERVICE(Host, Dict)), - {ok, LRef} = diameter:add_transport(Host, ?LISTEN), - {LRef, portnr(LRef)}. - -connect(Host, {_LRef, PortNr}) -> - {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr)), - ok = receive - #diameter_event{service = Host, - info = {up, Ref, _, _, #diameter_packet{}}} -> - ok - after 2000 -> - false - end, - Ref; -connect(Host, Ports) -> - [connect(Host, P) || P <- Ports]. - -portnr(LRef) -> - portnr(LRef, 20). - -portnr(LRef, N) - when 0 < N -> - case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of - [{T, _Pid}] -> - {_, _, {LRef, {_Addr, LSock}}} = T, - {ok, PortNr} = inet:port(LSock), - PortNr; - [] -> - receive after 50 -> ok end, - portnr(LRef, N-1) - end. +%% =========================================================================== +%% start/stop testcases -realm(Host) -> - tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). +start(_Config) -> + ok = diameter:start(). + +start_services(_Config) -> + [S1,S2,S3,S4] = [server(N, ?DICT_COMMON) || N <- [?SERVER1, + ?SERVER2, + ?SERVER3, + ?SERVER4]], + [R1,R2] = [server(N, ?DICT_RELAY) || N <- [?RELAY1, ?RELAY2]], + + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), + + {save_config, [{?RELAY1, [S1,S2,R2]}, + {?RELAY2, [S3,S4]}, + {?CLIENT, [R1,R2]}]}. + +connect(Config) -> + {_, Conns} = proplists:get_value(saved_config, Config), + + ?util:write_priv(Config, + "cfg", + lists:flatmap(fun({CN,Ss}) -> connect(CN, Ss) end, + Conns)). + +disconnect(Config) -> + lists:foreach(fun({{CN,CR},{SN,SR}}) -> ?util:disconnect(CN,CR,SN,SR) end, + ?util:read_priv(Config, "cfg")). + +stop_services(_Config) -> + [] = [{H,T} || H <- ?SERVICES, + T <- [diameter:stop_service(H)], + T /= ok]. + +stop(_Config) -> + ok = diameter:stop(). + +%% ---------------------------------------- + +server(Name, Dict) -> + ok = diameter:start_service(Name, ?SERVICE(Name, Dict)), + {Name, ?util:listen(Name, tcp)}. + +connect(Name, Refs) -> + [{{Name, ?util:connect(Name, tcp, LRef)}, T} || {_, LRef} = T <- Refs]. %% =========================================================================== +%% traffic testcases %% Send an STR intended for a specific server and expect success. send1(_Config) -> @@ -254,40 +231,11 @@ send_timeout(Tmo) -> {'Re-Auth-Request-Type', ?AUTHORIZE_ONLY}], call(Req, [{filter, realm}, {timeout, Tmo}]). -%% Remove the client transports and expect the corresponding server -%% transport to go down. -remove_transports(Config) -> - {[S1,S2,S3,S4], [R1,R2], [C1,C2,C3,C4,C5,C6,C7]} - = proplists:get_value(transports, Config), - - true = diameter:subscribe(?SERVER1), - true = diameter:subscribe(?SERVER2), - true = diameter:subscribe(?SERVER3), - true = diameter:subscribe(?SERVER4), - true = diameter:subscribe(?RELAY1), - true = diameter:subscribe(?RELAY2), - - disconnect(S1, ?RELAY1, C1), - disconnect(S2, ?RELAY1, C2), - disconnect(S3, ?RELAY2, C3), - disconnect(S4, ?RELAY2, C4), - disconnect(R1, ?CLIENT, C5), - disconnect(R2, ?CLIENT, C6), - disconnect(R2, ?RELAY1, C7). - -disconnect({LRef, _PortNr}, Client, CRef) -> - ok = diameter:remove_transport(Client, CRef), - ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok - after 2000 -> false - end. - -stop_services(_Config) -> - S = [?CLIENT, ?RELAY1, ?RELAY2, ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4], - Ok = [ok || _ <- S], - Ok = [diameter:stop_service(H) || H <- S]. - %% =========================================================================== +realm(Host) -> + tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). + call(Server) -> Realm = realm(Server), Req = ['STR', {'Destination-Realm', Realm}, @@ -323,7 +271,7 @@ peer_down(_SvcName, _Peer, State) -> pick_peer([Peer | _], _, Svc, _State) when Svc == ?RELAY1; Svc == ?RELAY2; - Svc == ?CLIENT-> + Svc == ?CLIENT -> {ok, Peer}. %% prepare_request/3 diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl new file mode 100644 index 0000000000..127e3435dc --- /dev/null +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -0,0 +1,406 @@ +%% +%% %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% +%% + +%% +%% Tests of traffic between six Diameter nodes connected as follows. +%% +%% ---- SERVER.REALM1 (TLS after capabilities exchange) +%% / +%% / ---- SERVER.REALM2 (ditto) +%% | / +%% CLIENT.REALM0 ----- SERVER.REALM3 (no security) +%% | \ +%% \ ---- SERVER.REALM4 (TLS at connection establishment) +%% \ +%% ---- SERVER.REALM5 (ditto) +%% + +-module(diameter_tls_SUITE). + +-export([suite/0, + all/0, + groups/0, + init_per_group/2, + end_per_group/2, + init_per_suite/1, + end_per_suite/1]). + +%% testcases +-export([start_ssl/1, + start_diameter/1, + make_certs/1, make_certs/0, + start_services/1, + add_transports/1, + send1/1, + send2/1, + send3/1, + send4/1, + send5/1, + remove_transports/1, + stop_services/1, + stop_diameter/1, + stop_ssl/1]). + +%% diameter callbacks +-export([peer_up/3, + peer_down/3, + pick_peer/4, + prepare_request/3, + prepare_retransmit/3, + handle_answer/4, + handle_error/4, + handle_request/3]). + +-include("diameter.hrl"). +-include("diameter_gen_base_rfc3588.hrl"). +-include("diameter_ct.hrl"). + +%% =========================================================================== + +-define(util, diameter_util). + +-define(ADDR, {127,0,0,1}). + +-define(CLIENT, "CLIENT.REALM0"). +-define(SERVER1, "SERVER.REALM1"). +-define(SERVER2, "SERVER.REALM2"). +-define(SERVER3, "SERVER.REALM3"). +-define(SERVER4, "SERVER.REALM4"). +-define(SERVER5, "SERVER.REALM5"). + +-define(SERVERS, [?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4, ?SERVER5]). + +-define(DICT_COMMON, ?DIAMETER_DICT_COMMON). + +-define(APP_ALIAS, the_app). +-define(APP_ID, ?DICT_COMMON:id()). + +-define(NO_INBAND_SECURITY, 0). +-define(TLS, 1). + +%% Config for diameter:start_service/2. +-define(SERVICE(Host, Dict), + [{'Origin-Host', Host}, + {'Origin-Realm', realm(Host)}, + {'Host-IP-Address', [?ADDR]}, + {'Vendor-Id', 12345}, + {'Product-Name', "OTP/diameter"}, + {'Inband-Security-Id', [?NO_INBAND_SECURITY]}, + {'Auth-Application-Id', [Dict:id()]}, + {application, [{alias, ?APP_ALIAS}, + {dictionary, Dict}, + {module, ?MODULE}, + {answer_errors, callback}]}]). + +%% Config for diameter:add_transport/2. In the listening case, listen +%% on a free port that we then lookup using the implementation detail +%% that diameter_tcp registers the port with diameter_reg. +-define(CONNECT(PortNr, Caps, Opts), + {connect, [{transport_module, diameter_tcp}, + {transport_config, [{raddr, ?ADDR}, + {rport, PortNr}, + {ip, ?ADDR}, + {port, 0} + | Opts]}, + {capabilities, Caps}]}). +-define(LISTEN(Caps, Opts), + {listen, [{transport_module, diameter_tcp}, + {transport_config, [{ip, ?ADDR}, {port, 0} | Opts]}, + {capabilities, Caps}]}). + +-define(SUCCESS, 2001). +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 10}}]. + +all() -> + [start_ssl, + start_diameter, + make_certs, + start_services, + add_transports] + ++ [{group, N} || {N, _, _} <- groups()] + ++ [remove_transports, stop_services, stop_diameter, stop_ssl]. + +groups() -> + Ts = tc(), + [{all, [], Ts}, + {p, [parallel], Ts}]. + +init_per_group(_, Config) -> + Config. + +end_per_group(_, _) -> + ok. + +init_per_suite(Config) -> + case os:find_executable("openssl") of + false -> + {skip, no_openssl}; + _ -> + Config + end. + +end_per_suite(_Config) -> + ok. + +%% Testcases to run when services are started and connections +%% established. +tc() -> + [send1, + send2, + send3, + send4, + send5]. + +%% =========================================================================== +%% testcases + +start_ssl(_Config) -> + ok = ssl:start(). + +start_diameter(_Config) -> + ok = diameter:start(). + +make_certs() -> + [{timetrap, {seconds, 30}}]. + +make_certs(Config) -> + Dir = proplists:get_value(priv_dir, Config), + + [] = ?util:run([[fun make_cert/2, Dir, B] || B <- ["server1", + "server2", + "server4", + "server5", + "client"]]). + +start_services(Config) -> + Dir = proplists:get_value(priv_dir, Config), + Servers = [server(S, sopts(S, Dir)) || S <- ?SERVERS], + + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), + + {save_config, [Dir | Servers]}. + +add_transports(Config) -> + {_, [Dir | Servers]} = proplists:get_value(saved_config, Config), + + true = diameter:subscribe(?CLIENT), + + Opts = ssl_options(Dir, "client"), + Connections = [connect(?CLIENT, S, copts(N, Opts)) + || {S,N} <- lists:zip(Servers, ?SERVERS)], + + ?util:write_priv(Config, "cfg", lists:zip(Servers, Connections)). + + +%% Remove the client transports and expect the corresponding server +%% transport to go down. +remove_transports(Config) -> + Ts = ?util:read_priv(Config, "cfg"), + [] = [T || S <- ?SERVERS, T <- [diameter:subscribe(S)], T /= true], + lists:map(fun disconnect/1, Ts). + +stop_services(_Config) -> + [] = [{H,T} || H <- [?CLIENT | ?SERVERS], + T <- [diameter:stop_service(H)], + T /= ok]. + +stop_diameter(_Config) -> + ok = diameter:stop(). + +stop_ssl(_Config) -> + ok = ssl:stop(). + +%% Send an STR intended for a specific server and expect success. +send1(_Config) -> + call(?SERVER1). +send2(_Config) -> + call(?SERVER2). +send3(_Config) -> + call(?SERVER3). +send4(_Config) -> + call(?SERVER4). +send5(_Config) -> + call(?SERVER5). + +%% =========================================================================== +%% diameter callbacks + +%% peer_up/3 + +peer_up(_SvcName, _Peer, State) -> + State. + +%% peer_down/3 + +peer_down(_SvcName, _Peer, State) -> + State. + +%% pick_peer/4 + +pick_peer([Peer], _, ?CLIENT, _State) -> + {ok, Peer}. + +%% prepare_request/3 + +prepare_request(#diameter_packet{msg = Req}, + ?CLIENT, + {_Ref, Caps}) -> + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, _}} + = Caps, + + {send, set(Req, [{'Session-Id', diameter:session_id(OH)}, + {'Origin-Host', OH}, + {'Origin-Realm', OR}])}. + +%% prepare_retransmit/3 + +prepare_retransmit(_Pkt, false, _Peer) -> + discard. + +%% handle_answer/4 + +handle_answer(Pkt, _Req, ?CLIENT, _Peer) -> + #diameter_packet{msg = Rec, errors = []} = Pkt, + Rec. + +%% handle_error/4 + +handle_error(Reason, _Req, ?CLIENT, _Peer) -> + {error, Reason}. + +%% handle_request/3 + +handle_request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId}}, + OH, + {_Ref, #diameter_caps{origin_host = {OH,_}, + origin_realm = {OR, _}}}) + when OH /= ?CLIENT -> + {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Session-Id' = SId, + 'Origin-Host' = OH, + 'Origin-Realm' = OR}}. + +%% =========================================================================== +%% support functions + +call(Server) -> + Realm = realm(Server), + Req = ['STR', {'Destination-Realm', Realm}, + {'Termination-Cause', ?LOGOUT}, + {'Auth-Application-Id', ?APP_ID}], + #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Origin-Host' = Server, + 'Origin-Realm' = Realm} + = call(Req, [{filter, realm}]). + +call(Req, Opts) -> + diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts). + +set([H|T], Vs) -> + [H | Vs ++ T]. + +disconnect({{LRef, _PortNr}, CRef}) -> + ok = diameter:remove_transport(?CLIENT, CRef), + ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok + after 2000 -> false + end. + +realm(Host) -> + tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). + +inband_security(Ids) -> + [{'Inband-Security-Id', Ids}]. + +ssl_options(Dir, Base) -> + Root = filename:join([Dir, Base]), + [{ssl_options, [{certfile, Root ++ "_ca.pem"}, + {keyfile, Root ++ "_key.pem"}]}]. + +make_cert(Dir, Base) -> + make_cert(Dir, Base ++ "_key.pem", Base ++ "_ca.pem"). + +make_cert(Dir, Keyfile, Certfile) -> + [K,C] = Paths = [filename:join([Dir, F]) || F <- [Keyfile, Certfile]], + + KCmd = join(["openssl genrsa -out", K, "2048"]), + CCmd = join(["openssl req -new -x509 -key", K, "-out", C, "-days 7", + "-subj /C=SE/ST=./L=Stockholm/CN=www.erlang.org"]), + + %% Hope for the best and only check that files are written. + os:cmd(KCmd), + os:cmd(CCmd), + + [_,_] = [T || P <- Paths, {ok, T} <- [file:read_file_info(P)]], + + {K,C}. + +join(Strs) -> + string:join(Strs, " "). + +%% server/2 + +server(Host, {Caps, Opts}) -> + ok = diameter:start_service(Host, ?SERVICE(Host, ?DICT_COMMON)), + {ok, LRef} = diameter:add_transport(Host, ?LISTEN(Caps, Opts)), + {LRef, hd([_] = ?util:lport(tcp, LRef, 20))}. + +sopts(?SERVER1, Dir) -> + {inband_security([?TLS]), + ssl_options(Dir, "server1")}; +sopts(?SERVER2, Dir) -> + {inband_security([?NO_INBAND_SECURITY, ?TLS]), + ssl_options(Dir, "server2")}; +sopts(?SERVER3, _) -> + {[], []}; +sopts(?SERVER4, Dir) -> + {[], ssl(ssl_options(Dir, "server4"))}; +sopts(?SERVER5, Dir) -> + {[], ssl(ssl_options(Dir, "server5"))}. + +ssl([{ssl_options = T, Opts}]) -> + [{T, true} | Opts]. + +%% connect/3 + +connect(Host, {_LRef, PortNr}, {Caps, Opts}) -> + {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr, Caps, Opts)), + ok = receive + #diameter_event{service = Host, + info = {up, Ref, _, _, #diameter_packet{}}} -> + ok + after 2000 -> + false + end, + Ref. + +copts(S, Opts) + when S == ?SERVER1; + S == ?SERVER2; + S == ?SERVER3 -> + {inband_security([?NO_INBAND_SECURITY, ?TLS]), Opts}; +copts(S, Opts) + when S == ?SERVER4; + S == ?SERVER5 -> + {[], ssl(Opts)}. diff --git a/lib/ssl/c_src/Makefile b/lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca index 52d9140153..3f2645add0 100644 --- a/lib/ssl/c_src/Makefile +++ b/lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca @@ -1,26 +1,43 @@ -# +# -*- makefile -*- # %CopyrightBegin% -# -# Copyright Ericsson AB 1999-2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 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% -# - # +# %CopyrightEnd% # -# Invoke with GNU make or clearmake -C gnu. +# Certificates are now generated from the suite itself but the +# makefile itself is still useful. # -include $(ERL_TOP)/make/run_make.mk +KEYS = $(HOSTS:%=%_key.pem) +CERTS = $(HOSTS:%=%_ca.pem) + +all: $(CERTS) + +%_ca.pem: %_key.pem + openssl req -new -x509 -key $< -out $@ -days 1095 \ + -subj '/C=SE/ST=./L=Stockholm/CN=www.erlang.org' + +%_key.pem: + openssl genrsa -out $@ 2048 + +clean: + rm -f $(CERTS) + +realclean: clean + rm -f $(KEYS) + +.PRECIOUS: $(KEYS) +.PHONY: all clean realclean diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 8c85323222..55c5fc7c54 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -26,15 +26,16 @@ -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([result_codes/1, +-export([start/1, + start_services/1, + add_transports/1, + result_codes/1, send_ok/1, send_arbitrary/1, send_unknown/1, @@ -73,7 +74,8 @@ send_multiple_filters_3/1, send_anything/1, remove_transports/1, - stop_services/1]). + stop_services/1, + stop/1]). %% diameter callbacks -export([peer_up/3, @@ -85,17 +87,14 @@ handle_error/5, handle_request/3]). --ifdef(DIAMETER_CT). +-include("diameter.hrl"). -include("diameter_gen_base_rfc3588.hrl"). --else. --include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). --endif. - --include_lib("diameter/include/diameter.hrl"). -include("diameter_ct.hrl"). %% =========================================================================== +-define(util, diameter_util). + -define(ADDR, {127,0,0,1}). -define(CLIENT, "CLIENT"). @@ -123,19 +122,6 @@ {module, ?MODULE}, {answer_errors, callback}]}]). -%% Config for diameter:add_transport/2. In the listening case, listen -%% on a free port that we then lookup using the implementation detail -%% that diameter_tcp registers the port with diameter_reg. --define(CONNECT(PortNr), - {connect, [{transport_module, diameter_tcp}, - {transport_config, [{raddr, ?ADDR}, - {rport, PortNr}, - {ip, ?ADDR}, - {port, 0}]}]}). --define(LISTEN, - {listen, [{transport_module, diameter_tcp}, - {transport_config, [{ip, ?ADDR}, {port, 0}]}]}). - -define(SUCCESS, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). -define(COMMAND_UNSUPPORTED, @@ -177,30 +163,18 @@ suite() -> [{timetrap, {seconds, 10}}]. all() -> - [result_codes | [{group, N} || {N, _, _} <- groups()]] - ++ [remove_transports, stop_services]. + [start, start_services, add_transports, result_codes + | [{group, N} || {N, _, _} <- groups()]] + ++ [remove_transports, stop_services, stop]. groups() -> Ts = tc(), - [{E, [], Ts} || E <- ?ENCODINGS] - ++ [{?P(E), [parallel], Ts} || E <- ?ENCODINGS]. + [{grp(E,P), P, Ts} || E <- ?ENCODINGS, P <- [[], [parallel]]]. -init_per_suite(Config) -> - ok = diameter:start(), - ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)), - ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)), - {ok, LRef} = diameter:add_transport(?SERVER, ?LISTEN), - true = diameter:subscribe(?CLIENT), - {ok, CRef} = diameter:add_transport(?CLIENT, ?CONNECT(portnr())), - {up, CRef, _Peer, _Config, #diameter_packet{}} - = receive #diameter_event{service = ?CLIENT, info = I} -> I - after 2000 -> false - end, - true = diameter:unsubscribe(?CLIENT), - [{transports, {LRef, CRef}} | Config]. - -end_per_suite(_Config) -> - ok = diameter:stop(). +grp(E, []) -> + E; +grp(E, [parallel]) -> + ?P(E). init_per_group(Name, Config) -> E = case ?L(Name) of @@ -261,20 +235,35 @@ tc() -> send_multiple_filters_3, send_anything]. -portnr() -> - portnr(20). - -portnr(N) - when 0 < N -> - case diameter_reg:match({diameter_tcp, listener, '_'}) of - [{T, _Pid}] -> - {_, _, {_LRef, {_Addr, LSock}}} = T, - {ok, PortNr} = inet:port(LSock), - PortNr; - [] -> - receive after 50 -> ok end, - portnr(N-1) - end. +%% =========================================================================== +%% start/stop testcases + +start(_Config) -> + ok = diameter:start(). + +start_services(_Config) -> + ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)), + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)). + +add_transports(Config) -> + LRef = ?util:listen(?SERVER, tcp, [{capabilities_cb, fun capx/2}]), + CRef = ?util:connect(?CLIENT, tcp, LRef), + ?util:write_priv(Config, "transport", {LRef, CRef}). + +remove_transports(Config) -> + {LRef, CRef} = ?util:read_priv(Config, "transport"), + ?util:disconnect(?CLIENT, CRef, ?SERVER, LRef). + +stop_services(_Config) -> + ok = diameter:stop_service(?CLIENT), + ok = diameter:stop_service(?SERVER). + +stop(_Config) -> + ok = diameter:stop(). + +capx(_, #diameter_caps{origin_host = {OH,DH}}) -> + io:format("connection: ~p -> ~p~n", [DH,OH]), + ok. %% =========================================================================== @@ -532,21 +521,6 @@ send_anything(Config) -> #diameter_base_STA{'Result-Code' = ?SUCCESS} = call(Config, anything). -%% Remove the client transport and expect the server transport to -%% go down. -remove_transports(Config) -> - {LRef, CRef} = proplists:get_value(transports, Config), - true = diameter:subscribe(?SERVER), - ok = diameter:remove_transport(?CLIENT, CRef), - {down, LRef, _, _} - = receive #diameter_event{service = ?SERVER, info = I} -> I - after 2000 -> false - end. - -stop_services(_Config) -> - {ok, ok} = {diameter:stop_service(?CLIENT), - diameter:stop_service(?SERVER)}. - %% =========================================================================== call(Config, Req) -> diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl index d545859fe8..c22adc3334 100644 --- a/lib/diameter/test/diameter_transport_SUITE.erl +++ b/lib/diameter/test/diameter_transport_SUITE.erl @@ -33,17 +33,19 @@ end_per_suite/1]). %% testcases --export([tcp_accept/1, +-export([start/1, + tcp_accept/1, tcp_connect/1, sctp_accept/1, - sctp_connect/1]). + sctp_connect/1, + stop/1]). -export([accept/1, connect/1, init/2]). -include_lib("kernel/include/inet_sctp.hrl"). --include_lib("diameter/include/diameter.hrl"). +-include("diameter.hrl"). -include("diameter_ct.hrl"). -define(util, diameter_util). @@ -67,16 +69,6 @@ = #diameter_caps{host_ip_address = Addrs}}). -%% The term diameter_tcp/sctp registers after opening a listening -%% socket. This is an implementation detail that should probably be -%% replaced by some documented way of getting at the port number of -%% the listening socket, which is what we're after since we specify -%% port 0 to get something unused. --define(TCP_LISTENER(Ref, Addr, LSock), - {diameter_tcp, listener, {Ref, {Addr, LSock}}}). --define(SCTP_LISTENER(Ref, Addr, LSock), - {diameter_sctp, listener, {Ref, {[Addr], LSock}}}). - %% The term we register after open a listening port with gen_tcp. -define(TEST_LISTENER(Ref, PortNr), {?MODULE, listen, Ref, PortNr}). @@ -101,7 +93,7 @@ suite() -> [{timetrap, {minutes, 2}}]. all() -> - [{group, all} | tc()]. + [start | tc()] ++ [{group, all}, stop]. groups() -> [{all, [parallel], tc()}]. @@ -119,10 +111,17 @@ end_per_group(_, _) -> ok. init_per_suite(Config) -> - ok = diameter:start(), [{sctp, have_sctp()} | Config]. end_per_suite(_Config) -> + ok. + +%% =========================================================================== + +start(_Config) -> + ok = diameter:start(). + +stop(_Config) -> ok = diameter:stop(). %% =========================================================================== @@ -180,7 +179,9 @@ have_sctp() -> try gen_sctp:open() of {ok, Sock} -> gen_sctp:close(Sock), - true + true; + {error, eprotonosupport} -> %% fail on any other reason + false catch error: badarg -> false @@ -216,7 +217,7 @@ init(accept, {Prot, Ref}) -> init(gen_connect, {Prot, Ref}) -> %% Lookup the peer's listening socket. - {ok, PortNr} = inet:port(lsock(Prot, Ref)), + [PortNr] = ?util:lport(Prot, Ref, 20), %% Connect, send a message and receive it back. {ok, Sock} = gen_connect(Prot, PortNr, Ref), @@ -253,22 +254,16 @@ init(connect, {Prot, Ref}) -> MRef = erlang:monitor(process, TPid), ?RECV({'DOWN', MRef, process, _, _}). -lsock(sctp, Ref) -> - [{?SCTP_LISTENER(_ , _, LSock), _}] - = match(?SCTP_LISTENER(Ref, ?ADDR, '_')), - LSock; -lsock(tcp, Ref) -> - [{?TCP_LISTENER(_ , _, LSock), _}] - = match(?TCP_LISTENER(Ref, ?ADDR, '_')), - LSock. - match(Pat) -> - case diameter_reg:match(Pat) of - [] -> + match(Pat, 20). + +match(Pat, T) -> + L = diameter_reg:match(Pat), + if [] /= L orelse 1 == T -> + L; + true -> ?WAIT(50), - match(Pat); - L -> - L + match(Pat, T-1) end. bin(sctp, #diameter_packet{bin = Bin}) -> @@ -332,7 +327,7 @@ start_accept(Prot, Ref) -> %% Configure the same port number for transports on the same %% reference. - PortNr = portnr(Prot, Ref), + [PortNr | _] = ?util:lport(Prot, Ref) ++ [0], {Mod, Opts} = tmod(Prot), try @@ -362,23 +357,6 @@ tmod(sctp) -> tmod(tcp) -> {diameter_tcp, []}. -portnr(sctp, Ref) -> - case diameter_reg:match(?SCTP_LISTENER(Ref, ?ADDR, '_')) of - [{?SCTP_LISTENER(_, _, LSock), _}] -> - {ok, N} = inet:port(LSock), - N; - [] -> - 0 - end; -portnr(tcp, Ref) -> - case diameter_reg:match(?TCP_LISTENER(Ref, ?ADDR, '_')) of - [{?TCP_LISTENER(_, _, LSock), _}] -> - {ok, N} = inet:port(LSock), - N; - [] -> - 0 - end. - %% =========================================================================== %% gen_connect/3 diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index 99f4fa1977..6b1dc1f0c9 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -23,15 +23,28 @@ %% Utility functions. %% +%% generic -export([consult/2, run/1, fold/3, foldl/3, - scramble/1, - ps/0]). + scramble/1]). + +%% diameter-specific +-export([lport/2, + lport/3, + listen/2, listen/3, + connect/3, connect/4, + disconnect/4]). + +%% common_test-specific +-export([write_priv/3, + read_priv/2, + map_priv/3]). -define(L, atom_to_list). +%% --------------------------------------------------------------------------- %% consult/2 %% %% Extract info from the app/appup file (presumably) of the named @@ -56,6 +69,7 @@ consult(Path) -> %% Name/Path in the return value distinguish the errors and allow for %% a useful badmatch. +%% --------------------------------------------------------------------------- %% run/1 %% %% Evaluate functions in parallel and return a list of those that @@ -71,6 +85,7 @@ cons(true, _, _, Acc) -> cons(false, F, RC, Acc) -> [{F, RC} | Acc]. +%% --------------------------------------------------------------------------- %% fold/3 %% %% Parallel fold. Results are folded in the order received. @@ -116,6 +131,7 @@ down(MRef) -> down() -> receive {'DOWN', MRef, process, _, Reason} -> {MRef, Reason} end. +%% --------------------------------------------------------------------------- %% foldl/3 %% %% Parallel fold. Results are folded in order of the function list. @@ -131,6 +147,7 @@ recvl([{MRef, F} | L], Ref, Fun, Acc) -> R = down(MRef), recvl(L, Ref, Fun, acc(R, Ref, F, Fun, Acc)). +%% --------------------------------------------------------------------------- %% scramble/1 %% %% Sort a list into random order. @@ -150,12 +167,10 @@ s(Acc, L) -> {H, [T|Rest]} = lists:split(random:uniform(length(L)) - 1, L), s([T|Acc], H ++ Rest). -%% ps/0 - -ps() -> - [{P, process_info(P)} || P <- erlang:processes()]. - +%% --------------------------------------------------------------------------- %% eval/1 +%% +%% Evaluate a function in one of a number of forms. eval({M,[F|A]}) when is_atom(F) -> @@ -175,3 +190,133 @@ eval(L) eval(F) when is_function(F,0) -> F(). + +%% --------------------------------------------------------------------------- +%% write_priv/3 +%% +%% Write an arbitrary term to a named file. + +write_priv(Config, Name, Term) -> + write(path(Config, Name), Term). + +write(Path, Term) -> + ok = file:write_file(Path, term_to_binary(Term)). + +%% read_priv/2 +%% +%% Read a term from a file. + +read_priv(Config, Name) -> + read(path(Config, Name)). + +read(Path) -> + {ok, Bin} = file:read_file(Path), + binary_to_term(Bin). + +%% map_priv/3 +%% +%% Modify a term in a file and return both old and new values. + +map_priv(Config, Name, Fun1) -> + map(path(Config, Name), Fun1). + +map(Path, Fun1) -> + T0 = read(Path), + T1 = Fun1(T0), + write(Path, T1), + {T0, T1}. + +path(Config, Name) + when is_atom(Name) -> + path(Config, ?L(Name)); +path(Config, Name) -> + Dir = proplists:get_value(priv_dir, Config), + filename:join([Dir, Name]). + +%% --------------------------------------------------------------------------- +%% lport/2-3 +%% +%% Lookup the port number of a tcp/sctp listening transport. + +lport(M, Ref) -> + lport(M, Ref, 1). + +lport(M, Ref, Tries) -> + lp(tmod(M), Ref, Tries). + +lp(M, Ref, T) -> + L = [N || {listen, N, _} <- M:ports(Ref)], + if [] /= L orelse T =< 1 -> + L; + true -> + receive after 50 -> ok end, + lp(M, Ref, T-1) + end. + +%% --------------------------------------------------------------------------- +%% listen/2-3 +%% +%% Add a listening transport on the loopback address and a free port. + +listen(SvcName, Prot) -> + listen(SvcName, Prot, []). + +listen(SvcName, Prot, Opts) -> + add_transport(SvcName, {listen, opts(Prot, listen) ++ Opts}). + +%% --------------------------------------------------------------------------- +%% connect/2-3 +%% +%% Add a connecting transport on and connect to a listening transport +%% with the specified reference. + +connect(Client, Prot, LRef) -> + connect(Client, Prot, LRef, []). + +connect(Client, Prot, LRef, Opts) -> + [PortNr] = lport(Prot, LRef, 20), + Ref = add_transport(Client, {connect, opts(Prot, PortNr) ++ Opts}), + true = diameter:subscribe(Client), + ok = receive + {diameter_event, Client, {up, Ref, _, _, _}} -> ok + after 2000 -> + {Client, Prot, PortNr, process_info(self(), messages)} + end, + Ref. + +%% --------------------------------------------------------------------------- +%% disconnect/4 +%% +%% Remove the client transport and expect the server transport to go +%% down. + +disconnect(Client, Ref, Server, LRef) -> + true = diameter:subscribe(Server), + ok = diameter:remove_transport(Client, Ref), + ok = receive + {diameter_event, Server, {down, LRef, _, _}} -> ok + after 2000 -> + {Client, Ref, Server, LRef, process_info(self(), messages)} + end. + +%% --------------------------------------------------------------------------- + +-define(ADDR, {127,0,0,1}). + +add_transport(SvcName, T) -> + {ok, Ref} = diameter:add_transport(SvcName, T), + Ref. + +tmod(tcp) -> + diameter_tcp; +tmod(sctp) -> + diameter_sctp. + +opts(Prot, T) -> + [{transport_module, tmod(Prot)}, + {transport_config, [{ip, ?ADDR}, {port, 0} | opts(T)]}]. + +opts(listen) -> + []; +opts(PortNr) -> + [{raddr, ?ADDR}, {rport, PortNr}]. diff --git a/lib/diameter/test/diameter_watchdog_SUITE.erl b/lib/diameter/test/diameter_watchdog_SUITE.erl index dec307529a..b40d7c104d 100644 --- a/lib/diameter/test/diameter_watchdog_SUITE.erl +++ b/lib/diameter/test/diameter_watchdog_SUITE.erl @@ -36,7 +36,7 @@ id/1, %% jitter callback run/1]). --include_lib("diameter/include/diameter.hrl"). +-include("diameter.hrl"). -include("diameter_ct.hrl"). %% =========================================================================== diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk index c6f709dc36..f88258c232 100644 --- a/lib/diameter/test/modules.mk +++ b/lib/diameter/test/modules.mk @@ -33,8 +33,11 @@ MODULES = \ diameter_stats_SUITE \ diameter_watchdog_SUITE \ diameter_transport_SUITE \ + diameter_capx_SUITE \ diameter_traffic_SUITE \ - diameter_relay_SUITE + diameter_relay_SUITE \ + diameter_tls_SUITE \ + diameter_failover_SUITE -INTERNAL_HRL_FILES = \ +HRL_FILES = \ diameter_ct.hrl diff --git a/lib/diameter/src/app/depend.sed b/lib/diameter/test/release.sed index 9df0133960..2720b778f2 100644 --- a/lib/diameter/src/app/depend.sed +++ b/lib/diameter/test/release.sed @@ -18,14 +18,18 @@ # # -# Extract include dependencies from .erl files. The output is massaged -# further in Makefile. +# This bit of gymnastics is to replace the include of diameter's +# public hrls by include_lib when releasing testsuites, so that they +# compile both in the development filesystem (where generated hrls +# aren't in diameter/include) and with common_test's autocompilation +# on an installed release. Solving the problem by installing generated +# hrls to ../include is anathema: that directory is for handwritten +# source.) # -/^-include/!d -/"diameter/!d +/^-include("/!b +/"diameter_gen_/b s +/"diameter\./!b -s@^-include_lib("[^/]*@$(DIAMETER_TOP)@ -s@^-include("@@ -s@".*@@ -s@^@$(EBIN)/.$(EMULATOR): @ +:s +s@("@_lib&diameter/include/@ diff --git a/lib/docbuilder/src/docb_main.erl b/lib/docbuilder/src/docb_main.erl index 4f5f035a65..c20cfc8e67 100644 --- a/lib/docbuilder/src/docb_main.erl +++ b/lib/docbuilder/src/docb_main.erl @@ -436,11 +436,11 @@ transform(From, To, Opts, File, Tree) -> case catch Filter:transform(File, Tree, Opts) of %% R5C - {'EXIT', {undef, [{Filter, transform, [File, Tree, Opts]}|_]}}-> + {'EXIT', {undef, [{Filter, transform, [File, Tree, Opts],_}|_]}}-> %% No transformation defined finish_transform(Tree, File, Opts, Filter); - {'EXIT', {undef, {Filter, transform, [File, Tree, Opts]}}} -> + {'EXIT', {undef, {Filter, transform, [File, Tree, Opts],_}}} -> %% No transformation defined finish_transform(Tree, File, Opts, Filter); @@ -507,16 +507,16 @@ pp({Tag, Optional, Args}, TagPath, Level, Filter, Opts) -> Rule_3_result = case catch Filter:rule(TagPath1, {Level,Optional1,Args},Opts) of %% R5C - {'EXIT', {undef, [{_, rule, _}|_]}} -> % No rule/3 defined + {'EXIT', {undef, [{_, rule, _, _}|_]}} -> % No rule/3 defined failed; - {'EXIT', {undef, {_, rule, _}}} -> % No rule/3 defined + {'EXIT', {undef, {_, rule, _, _}}} -> % No rule/3 defined failed; %% R5C - {'EXIT', {function_clause, [{_, rule, _}|_]}} -> % No MATCHING rule/3 + {'EXIT', {function_clause, [{_, rule, _, _}|_]}} -> % No MATCHING rule/3 failed; - {'EXIT', {function_clause, {_, rule, _}}} -> % No MATCHING rule/3 + {'EXIT', {function_clause, {_, rule, _, _}}} -> % No MATCHING rule/3 failed; {'EXIT', What} -> diff --git a/lib/docbuilder/test/docb_SUITE_data/cdata_problem.xml b/lib/docbuilder/test/docb_SUITE_data/cdata_problem.xml index b7f6f5376e..b7f6f5376e 100755..100644 --- a/lib/docbuilder/test/docb_SUITE_data/cdata_problem.xml +++ b/lib/docbuilder/test/docb_SUITE_data/cdata_problem.xml diff --git a/lib/docbuilder/xsd/application.xsd b/lib/docbuilder/xsd/application.xsd index eb666cb6c7..eb666cb6c7 100755..100644 --- a/lib/docbuilder/xsd/application.xsd +++ b/lib/docbuilder/xsd/application.xsd diff --git a/lib/docbuilder/xsd/appref.xsd b/lib/docbuilder/xsd/appref.xsd index b63839e494..b63839e494 100755..100644 --- a/lib/docbuilder/xsd/appref.xsd +++ b/lib/docbuilder/xsd/appref.xsd diff --git a/lib/docbuilder/xsd/book.xsd b/lib/docbuilder/xsd/book.xsd index b47962263a..b47962263a 100755..100644 --- a/lib/docbuilder/xsd/book.xsd +++ b/lib/docbuilder/xsd/book.xsd diff --git a/lib/docbuilder/xsd/chapter.xsd b/lib/docbuilder/xsd/chapter.xsd index 4d89baa988..4d89baa988 100755..100644 --- a/lib/docbuilder/xsd/chapter.xsd +++ b/lib/docbuilder/xsd/chapter.xsd diff --git a/lib/docbuilder/xsd/common.entities.xsd b/lib/docbuilder/xsd/common.entities.xsd index 52a5d35179..52a5d35179 100755..100644 --- a/lib/docbuilder/xsd/common.entities.xsd +++ b/lib/docbuilder/xsd/common.entities.xsd diff --git a/lib/docbuilder/xsd/common.header.xsd b/lib/docbuilder/xsd/common.header.xsd index bfee4b8bb4..bfee4b8bb4 100755..100644 --- a/lib/docbuilder/xsd/common.header.xsd +++ b/lib/docbuilder/xsd/common.header.xsd diff --git a/lib/docbuilder/xsd/common.image.xsd b/lib/docbuilder/xsd/common.image.xsd index 17054eb23c..17054eb23c 100755..100644 --- a/lib/docbuilder/xsd/common.image.xsd +++ b/lib/docbuilder/xsd/common.image.xsd diff --git a/lib/docbuilder/xsd/common.refs.xsd b/lib/docbuilder/xsd/common.refs.xsd index 58b450669d..58b450669d 100755..100644 --- a/lib/docbuilder/xsd/common.refs.xsd +++ b/lib/docbuilder/xsd/common.refs.xsd diff --git a/lib/docbuilder/xsd/common.table.xsd b/lib/docbuilder/xsd/common.table.xsd index cf63df4317..cf63df4317 100755..100644 --- a/lib/docbuilder/xsd/common.table.xsd +++ b/lib/docbuilder/xsd/common.table.xsd diff --git a/lib/docbuilder/xsd/common.xsd b/lib/docbuilder/xsd/common.xsd index 3d43390bd8..3d43390bd8 100755..100644 --- a/lib/docbuilder/xsd/common.xsd +++ b/lib/docbuilder/xsd/common.xsd diff --git a/lib/docbuilder/xsd/comref.xsd b/lib/docbuilder/xsd/comref.xsd index 61df4dd848..61df4dd848 100755..100644 --- a/lib/docbuilder/xsd/comref.xsd +++ b/lib/docbuilder/xsd/comref.xsd diff --git a/lib/docbuilder/xsd/cref.xsd b/lib/docbuilder/xsd/cref.xsd index f1cbeddfff..f1cbeddfff 100755..100644 --- a/lib/docbuilder/xsd/cref.xsd +++ b/lib/docbuilder/xsd/cref.xsd diff --git a/lib/docbuilder/xsd/erlref.xsd b/lib/docbuilder/xsd/erlref.xsd index f6011b7bea..f6011b7bea 100755..100644 --- a/lib/docbuilder/xsd/erlref.xsd +++ b/lib/docbuilder/xsd/erlref.xsd diff --git a/lib/docbuilder/xsd/fascicules.xsd b/lib/docbuilder/xsd/fascicules.xsd index bfdb5bd604..bfdb5bd604 100755..100644 --- a/lib/docbuilder/xsd/fascicules.xsd +++ b/lib/docbuilder/xsd/fascicules.xsd diff --git a/lib/docbuilder/xsd/fileref.xsd b/lib/docbuilder/xsd/fileref.xsd index 8038f2115f..8038f2115f 100755..100644 --- a/lib/docbuilder/xsd/fileref.xsd +++ b/lib/docbuilder/xsd/fileref.xsd diff --git a/lib/docbuilder/xsd/part.xsd b/lib/docbuilder/xsd/part.xsd index 30d6ec0120..30d6ec0120 100755..100644 --- a/lib/docbuilder/xsd/part.xsd +++ b/lib/docbuilder/xsd/part.xsd diff --git a/lib/edoc/doc/Makefile b/lib/edoc/doc/Makefile index c5f68b25d0..7a59809d9b 100644 --- a/lib/edoc/doc/Makefile +++ b/lib/edoc/doc/Makefile @@ -78,12 +78,3 @@ release_docs_spec: docs release_spec: - - - -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- -#-include make.dep - - diff --git a/lib/edoc/doc/src/make.dep b/lib/edoc/doc/src/make.dep deleted file mode 100644 index b46e36314f..0000000000 --- a/lib/edoc/doc/src/make.dep +++ /dev/null @@ -1,21 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex chapter.tex edoc.tex edoc_doclet.tex \ - edoc_extract.tex edoc_layout.tex edoc_lib.tex \ - edoc_run.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/erl_docgen/priv/xsl/db_man.xsl b/lib/erl_docgen/priv/xsl/db_man.xsl index 1df96caa36..0aca74bc97 100644 --- a/lib/erl_docgen/priv/xsl/db_man.xsl +++ b/lib/erl_docgen/priv/xsl/db_man.xsl @@ -137,8 +137,9 @@ (there is no spec with more than one clause) --> <xsl:if test="count($clause/guard) > 0 or count($type) > 0"> <xsl:text> .RS</xsl:text> - <xsl:text> .TP 3</xsl:text> + <xsl:text> .LP</xsl:text> <xsl:text> Types: </xsl:text> + <xsl:text> .RS 3</xsl:text> <xsl:choose> <xsl:when test="$output_subtypes"> @@ -164,6 +165,8 @@ <xsl:with-param name="type_desc" select="$type_desc"/> <xsl:with-param name="local_types" select="$local_types"/> </xsl:call-template> + <xsl:text> .RE</xsl:text> + <xsl:text> .RE</xsl:text> </xsl:if> @@ -257,8 +260,8 @@ <!-- Similar to <d> --> <xsl:template match="type_desc"> - <xsl:text> </xsl:text><xsl:apply-templates/> - <xsl:text> .br</xsl:text> + <xsl:text> .RS 2 </xsl:text><xsl:apply-templates/> + <xsl:text> .RE</xsl:text> </xsl:template> <!-- Datatypes --> @@ -757,24 +760,26 @@ <!-- The case where @name != 0 is taken care of in "type_name" --> <xsl:if test="string-length(@name) = 0 and string-length(@variable) = 0"> <xsl:text> .RS</xsl:text> - <xsl:text> .TP 3</xsl:text> + <xsl:text> .LP</xsl:text> <xsl:text> Types: </xsl:text> + <xsl:text> .RS 3</xsl:text> <xsl:apply-templates/> <xsl:text> .RE</xsl:text> + <xsl:text> .RE</xsl:text> </xsl:if> </xsl:template> <!-- V --> <xsl:template match="v"> - <xsl:text> </xsl:text><xsl:value-of select="normalize-space(text())"/> + <xsl:text> </xsl:text><xsl:apply-templates/> <xsl:text> .br</xsl:text> </xsl:template> <!-- D --> <xsl:template match="d"> - <xsl:text> </xsl:text><xsl:apply-templates/> - <xsl:text> .br</xsl:text> + <xsl:text> .RS 2 </xsl:text><xsl:apply-templates/> + <xsl:text> .RE</xsl:text> </xsl:template> <!-- Desc --> diff --git a/lib/erl_interface/doc/src/make.dep b/lib/erl_interface/doc/src/make.dep deleted file mode 100644 index 3f43cf64fe..0000000000 --- a/lib/erl_interface/doc/src/make.dep +++ /dev/null @@ -1,24 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin//docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex ei.tex ei_connect.tex ei_users_guide.tex \ - erl_call.tex erl_connect.tex erl_error.tex \ - erl_eterm.tex erl_format.tex erl_global.tex \ - erl_malloc.tex erl_marshal.tex part_ei.tex \ - ref_man.tex ref_man_ei.tex ref_man_erl_interface.tex \ - registry.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml ref_man_ei.xml ref_man_erl_interface.xml - diff --git a/lib/erl_interface/src/Makefile.in b/lib/erl_interface/src/Makefile.in index 8ff142a366..0d841cfa48 100644 --- a/lib/erl_interface/src/Makefile.in +++ b/lib/erl_interface/src/Makefile.in @@ -143,7 +143,6 @@ BINDIR = $(ERL_TOP)/lib/erl_interface/bin/$(TARGET) vpath %.c connect:encode:decode:misc:epmd:legacy:registry - ########################################################################### # List targets ########################################################################### @@ -202,11 +201,6 @@ ifeq ($(USING_VC),yes) # Windows targets TARGETS = \ - $(BINDIR) \ - $(OBJDIR) \ - $(MT_OBJDIR) \ - $(MD_OBJDIR) \ - $(MDD_OBJDIR) \ $(OBJ_TARGETS) \ $(EXE_TARGETS) @@ -236,9 +230,6 @@ else ifeq ($USING_MINGW,yes) TARGETS = \ - $(BINDIR) \ - $(OBJDIR) \ - $(MD_OBJDIR) \ $(OBJ_TARGETS) \ $(EXE_TARGETS) @@ -257,10 +248,6 @@ else ifdef THR_DEFS TARGETS = \ - $(BINDIR) \ - $(OBJDIR) \ - $(ST_OBJDIR) \ - $(MT_OBJDIR) \ $(OBJ_TARGETS) \ $(EXE_TARGETS) @@ -283,9 +270,6 @@ FAKE_TARGETS = \ else TARGETS = \ - $(BINDIR) \ - $(OBJDIR) \ - $(ST_OBJDIR) \ $(OBJ_TARGETS) \ $(EXE_TARGETS) @@ -601,23 +585,7 @@ $(MDD_OBJDIR)/%.o: %.c # Create directories ########################################################################### -$(BINDIR): - mkdir -p $(BINDIR) - -$(OBJDIR): - mkdir -p $(OBJDIR) - -$(ST_OBJDIR): - mkdir -p $(ST_OBJDIR) - -$(MT_OBJDIR): - mkdir -p $(MT_OBJDIR) - -$(MD_OBJDIR): - mkdir -p $(MD_OBJDIR) - -$(MDD_OBJDIR): - mkdir -p $(MDD_OBJDIR) +_create_dirs := $(shell mkdir -p $(BINDIR) $(OBJDIR) $(ST_OBJDIR) $(MT_OBJDIR) $(MD_OBJDIR) $(MDD_OBJDIR)) ########################################################################### # Special rules diff --git a/lib/erl_interface/test/all_SUITE_data/Makefile.src b/lib/erl_interface/test/all_SUITE_data/Makefile.src index 9be2360656..42d4c6f27f 100644 --- a/lib/erl_interface/test/all_SUITE_data/Makefile.src +++ b/lib/erl_interface/test/all_SUITE_data/Makefile.src @@ -30,6 +30,8 @@ CHMOD=chmod all: $(ALL_OBJS) +$(EI_COMMON_OBJS): gccifier@exe@ + @IFEQ@ (@erl_interface_cross_compile@, true) gccifier@exe@: $(CP) gccifier.sh gccifier@exe@ diff --git a/lib/erl_interface/test/all_SUITE_data/init_tc.erl b/lib/erl_interface/test/all_SUITE_data/init_tc.erl index 8157d590fc..8db4667bf9 100644 --- a/lib/erl_interface/test/all_SUITE_data/init_tc.erl +++ b/lib/erl_interface/test/all_SUITE_data/init_tc.erl @@ -40,23 +40,11 @@ run([]) -> run1(Name) -> CFile = Name ++ ".c", {ok, Bin} = file:read_file(CFile), - String = binary_to_list(Bin), - - %% This ConstPart stuff is because you can't retrieve part of a match. - %% Long live Perl! - - ConstPart = "\nTESTCASE\\(", - ConstPartLen = 10, - {match, Matches} = regexp:matches(String, ConstPart++"[_a-zA-Z]*"), - Cases = get_names(Matches, ConstPartLen, Bin, []), + RE = "\nTESTCASE\\(([_a-zA-Z]*)\\)", + {match, Cases0} = re:run(Bin, RE, [{capture,all_but_first,list},global]), + Cases = lists:concat(Cases0), generate(Name, Cases). -get_names([{Start, Length}|Rest], Skip, Bin, Result) -> - Name = binary_to_list(Bin, Start+Skip, Start+Length-1), - get_names(Rest, Skip, Bin, [Name|Result]); -get_names([], _Skip, _Bin, Result) -> - lists:reverse(Result). - generate(TcName, Cases) -> Hrl = TcName ++ "_cases.hrl", {ok, HrlFile} = file:open(Hrl, write), diff --git a/lib/eunit/doc/src/make.dep b/lib/eunit/doc/src/make.dep deleted file mode 100644 index d68f888403..0000000000 --- a/lib/eunit/doc/src/make.dep +++ /dev/null @@ -1,19 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex chapter.tex eunit.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/eunit/src/Makefile b/lib/eunit/src/Makefile index 4897c20ec1..bec2fdbe0b 100644 --- a/lib/eunit/src/Makefile +++ b/lib/eunit/src/Makefile @@ -26,8 +26,9 @@ INCLUDE=../include ERL_COMPILE_FLAGS += -pa $(EBIN) -I$(INCLUDE) +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_obsolete_guard +PARSE_TRANSFORM = eunit_autoexport.erl + SOURCES= \ - eunit_autoexport.erl \ eunit_striptests.erl \ eunit.erl \ eunit_tests.erl \ @@ -43,6 +44,8 @@ SOURCES= \ INCLUDE_FILES = eunit.hrl +PARSE_TRANSFORM_BIN = $(PARSE_TRANSFORM:%.erl=$(EBIN)/%.$(EMULATOR)) + OBJECTS=$(SOURCES:%.erl=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) INCLUDE_DELIVERABLES = $(INCLUDE_FILES:%=$(INCLUDE)/%) @@ -59,7 +62,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) # Targets # ---------------------------------------------------- -debug opt: $(OBJECTS) +debug opt: $(PARSE_TRANSFORM_BIN) $(OBJECTS) docs: @@ -86,6 +89,8 @@ realclean: clean $(EBIN)/%.$(EMULATOR):%.erl erlc -W $(ERL_COMPILE_FLAGS) -o$(EBIN) $< +$(OBJECTS): $(PARSE_TRANSFORM_BIN) + # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- @@ -103,9 +108,9 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(OBJECTS) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(PARSE_TRANSFORM_BIN) $(OBJECTS) $(RELSYSDIR)/ebin $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DATA) $(SOURCES) $(RELSYSDIR)/src + $(INSTALL_DATA) $(PARSE_TRANSFORM) $(SOURCES) $(RELSYSDIR)/src $(INSTALL_DIR) $(RELSYSDIR)/include $(INSTALL_DATA) $(INCLUDE_DELIVERABLES) $(RELSYSDIR)/include diff --git a/lib/gs/doc/src/make.dep b/lib/gs/doc/src/make.dep deleted file mode 100644 index b33ed3b2de..0000000000 --- a/lib/gs/doc/src/make.dep +++ /dev/null @@ -1,58 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex gs.tex gs_chapter1.tex gs_chapter2.tex \ - gs_chapter3.tex gs_chapter4.tex gs_chapter5.tex \ - gs_chapter6.tex gs_chapter7.tex gs_chapter8.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -gs_chapter2.tex: examples/ex1.erl examples/ex2.erl - -gs_chapter4.tex: examples/ex3.erl examples/ex4.erl examples/ex5.erl \ - examples/ex6.erl - -gs_chapter5.tex: examples/ex15.erl - -gs_chapter6.tex: examples/ex16.erl - -gs_chapter7.tex: examples/ex17.erl - -gs_chapter8.tex: examples/ex10.erl examples/ex11.erl examples/ex12.erl \ - examples/ex13.erl examples/ex14.erl examples/ex7.erl \ - examples/ex8.erl examples/ex9.erl - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: pics/gs1-1-image-1.ps pics/gs1-1-image-2.ps \ - pics/gs1-1-image-3.ps - -book.dvi: pics/ex1.ps pics/gs1-1-image-4.ps - -book.dvi: pics/ex15.ps - -book.dvi: pics/ex16.ps - -book.dvi: pics/packer1.ps pics/packer2.ps - -book.dvi: pics/arc.ps pics/buttons.ps pics/ex10.ps pics/ex11.ps \ - pics/ex12.ps pics/ex13.ps pics/ex14.ps pics/ex8.ps \ - pics/ex9.ps pics/image.ps pics/line.ps pics/oval.ps \ - pics/polygon.ps pics/rectangle.ps pics/text.ps \ - pics/window.ps - diff --git a/lib/gs/src/Makefile b/lib/gs/src/Makefile index a648d3cf13..964966ba00 100644 --- a/lib/gs/src/Makefile +++ b/lib/gs/src/Makefile @@ -90,7 +90,7 @@ clean: # Special Build Targets # ---------------------------------------------------- -gstk_generic.hrl: gs_make.erl +gstk_generic.hrl: gs_make.erl ../ebin/gs_make.$(EMULATOR) ../ebin/gs.$(EMULATOR) $(ERL) -pa $(EBIN) -s gs_make -s erlang halt -noshell $(APP_TARGET): $(APP_SRC) ../vsn.mk @@ -99,6 +99,8 @@ $(APP_TARGET): $(APP_SRC) ../vsn.mk $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk sed -e 's;%VSN%;$(VSN);' $< > $@ +$(GSTK_GENERIC_TARGET): gstk_generic.hrl + # ---------------------------------------------------- # Release Target # ---------------------------------------------------- diff --git a/lib/gs/src/gstk_editor.erl b/lib/gs/src/gstk_editor.erl index 3e0c8240e4..8cc7021cc6 100644 --- a/lib/gs/src/gstk_editor.erl +++ b/lib/gs/src/gstk_editor.erl @@ -243,14 +243,14 @@ option(Option, Gstkid, _MainW, DB, Editor) -> Editor, " ins ",AI," ", gstk:to_ascii(Text)]}; clear -> {c, [Editor, " delete 1.0 end"]}; {load, File} -> - {ok, F2,_} = regexp:gsub(File, [92,92], "/"), + F2 = re:replace(File, [92,92], "/", [global,{return,list}]), case gstk:call(["ed_load ", Editor, " ", gstk:to_ascii(F2)]) of {result, _} -> none; {bad_result,Re} -> {error,{no_such_file,editor,load,F2,Re}} end; {save, File} -> - {ok, F2,_} = regexp:gsub(File, [92,92], "/"), + F2 = re:replace(File, [92,92], "/", [global,{return,list}]), case gstk:call(["ed_save ",Editor," ",gstk:to_ascii(F2)]) of {result, _} -> none; {bad_result,Re} -> diff --git a/lib/gs/src/gstk_generic.erl b/lib/gs/src/gstk_generic.erl index 3ddb69efc5..2cc6c4c2d3 100644 --- a/lib/gs/src/gstk_generic.erl +++ b/lib/gs/src/gstk_generic.erl @@ -414,7 +414,7 @@ gen_font(_Opt,Gstkid,_TkW,DB,_ExtraArg) -> gen_label({text,Text},Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) -> out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -text ", gstk:to_ascii(Text), " -bi {}"|S],P,C); gen_label({image,Img},Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) -> - {ok, I2,_} = regexp:gsub(Img, [92,92], "/"), + I2 = re:replace(Img, [92,92], "/", [global,{return,list}]), out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -bi \"@", I2, "\" -text {}"|S],P,C). gen_label(_Opt,_Gstkid,TkW,_DB,_ExtraArg) -> case gstk:call([TkW, " cg -bit"]) of diff --git a/lib/gs/src/gstk_image.erl b/lib/gs/src/gstk_image.erl index 5ad37cf6de..9adbe42386 100644 --- a/lib/gs/src/gstk_image.erl +++ b/lib/gs/src/gstk_image.erl @@ -227,10 +227,10 @@ event(DB, Gstkid, Etype, Edata, Args) -> option(Option, Gstkid, _Canvas, _DB, _AItem) -> case Option of {bitmap, Bitmap} -> - {ok, BF,_} = regexp:gsub(Bitmap, [92,92], "/"), + BF = re:replace(Bitmap, [92,92], "/", [global,{return,list}]), {s, [" -bi @", BF]}; {load_gif, File} -> - {ok, F2,_} = regexp:gsub(File, [92,92], "/"), + F2 = re:replace(File, [92,92], "/", [global,{return,list}]), {Photo_item, _item} = Gstkid#gstkid.widget_data, {c,[Photo_item, " configure -file ", gstk:to_ascii(F2)]}; {pix_val, {Coords,Color}} -> diff --git a/lib/gs/src/tool_utils.erl b/lib/gs/src/tool_utils.erl index b07e92c4f0..d09af5f22f 100644 --- a/lib/gs/src/tool_utils.erl +++ b/lib/gs/src/tool_utils.erl @@ -98,7 +98,8 @@ open_help_default(Parent, File) -> _Else -> "netscape -remote \"openURL(file:" ++ File ++ ")\"" end; {win32,_AnyType} -> - "netscape.exe -h " ++ regexp:gsub(File,"\\\\","/"); + "netscape.exe -h " ++ + re:replace(File,"\\\\","/",[global,{return,list}]); _Other -> unknown end; diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 4163f2dae2..1483b2aee1 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -678,8 +678,6 @@ type(erlang, check_old_code, 1, Xs) -> type(erlang, check_process_code, 2, Xs) -> strict(arg_types(erlang, check_process_code, 2), Xs, fun (_) -> t_boolean() end); -type(erlang, concat_binary, 1, Xs) -> - strict(arg_types(erlang, concat_binary, 1), Xs, fun (_) -> t_binary() end); type(erlang, crc32, 1, Xs) -> strict(arg_types(erlang, crc32, 1), Xs, fun (_) -> t_crc32() end); type(erlang, crc32, 2, Xs) -> @@ -801,7 +799,8 @@ type(erlang, get_module_info, 2, Xs) -> end end); type(erlang, get_stacktrace, 0, _) -> - t_list(t_tuple([t_atom(), t_atom(), t_sup([t_arity(), t_list()])])); + t_list(t_tuple([t_atom(), t_atom(), t_sup([t_arity(), t_list()]), + t_list()])); type(erlang, group_leader, 0, _) -> t_pid(); type(erlang, group_leader, 2, Xs) -> strict(arg_types(erlang, group_leader, 2), Xs, @@ -3446,8 +3445,6 @@ arg_types(erlang, check_old_code, 1) -> [t_atom()]; arg_types(erlang, check_process_code, 2) -> [t_pid(), t_atom()]; -arg_types(erlang, concat_binary, 1) -> - [t_list(t_binary())]; arg_types(erlang, crc32, 1) -> [t_iodata()]; arg_types(erlang, crc32, 2) -> @@ -3763,7 +3760,10 @@ arg_types(erlang, purge_module, 1) -> arg_types(erlang, put, 2) -> [t_any(), t_any()]; arg_types(erlang, raise, 3) -> - [t_raise_errorclass(), t_any(), type(erlang, get_stacktrace, 0, [])]; + OldStyleType = t_list(t_tuple([t_atom(), t_atom(), + t_sup([t_arity(), t_list()])])), + NewStyleType = type(erlang, get_stacktrace, 0, []), + [t_raise_errorclass(), t_any(), t_sup(OldStyleType, NewStyleType)]; arg_types(erlang, read_timer, 1) -> [t_reference()]; arg_types(erlang, ref_to_list, 1) -> diff --git a/lib/hipe/doc/src/make.dep b/lib/hipe/doc/src/make.dep deleted file mode 100644 index d5f5844c21..0000000000 --- a/lib/hipe/doc/src/make.dep +++ /dev/null @@ -1,13 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex - diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index cfed410240..45b390acbd 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -281,10 +281,14 @@ needs_redtest(Leafness) -> %%----------------------------------------------------------------------- %%--- label & func_info combo --- +trans_fun([{label,_}=F,{func_info,_,_,_}=FI|Instructions], Env) -> + %% Handle old code without a line instruction. + trans_fun([F,{line,[]},FI|Instructions], Env); trans_fun([{label,B},{label,_}, {func_info,M,F,A},{label,L}|Instructions], Env) -> trans_fun([{label,B},{func_info,M,F,A},{label,L}|Instructions], Env); trans_fun([{label,B}, + {line,_}, {func_info,{atom,_M},{atom,_F},_A}, {label,L}|Instructions], Env) -> %% Emit code to handle function_clause errors. The BEAM test instructions @@ -1142,6 +1146,11 @@ trans_fun([{trim,N,NY}|Instructions], Env) -> Moves = trans_trim(N, NY), Moves ++ trans_fun(Instructions, Env); %%-------------------------------------------------------------------- +%% New line/1 instruction in R15. +%%-------------------------------------------------------------------- +trans_fun([{line,_}|Instructions], Env) -> + trans_fun(Instructions,Env); +%%-------------------------------------------------------------------- %%--- ERROR HANDLING --- %%-------------------------------------------------------------------- trans_fun([X|_], _) -> @@ -1869,6 +1878,8 @@ patch_make_funs([], FunIndex, Acc) -> find_mfa([{label,_}|Code]) -> find_mfa(Code); +find_mfa([{line,_}|Code]) -> + find_mfa(Code); find_mfa([{func_info,{atom,M},{atom,F},A}|_]) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> {M, F, A}. diff --git a/lib/hipe/icode/hipe_icode_pp.erl b/lib/hipe/icode/hipe_icode_pp.erl index 575bbfe43d..575bbfe43d 100755..100644 --- a/lib/hipe/icode/hipe_icode_pp.erl +++ b/lib/hipe/icode/hipe_icode_pp.erl diff --git a/lib/hipe/icode/hipe_icode_ssa.erl b/lib/hipe/icode/hipe_icode_ssa.erl index 719d5d8f45..719d5d8f45 100755..100644 --- a/lib/hipe/icode/hipe_icode_ssa.erl +++ b/lib/hipe/icode/hipe_icode_ssa.erl diff --git a/lib/hipe/rtl/Makefile b/lib/hipe/rtl/Makefile index 55d20af8af..690045b978 100644 --- a/lib/hipe/rtl/Makefile +++ b/lib/hipe/rtl/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2010. All Rights Reserved. +# Copyright Ericsson AB 2001-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 @@ -108,10 +108,30 @@ release_spec: opt release_docs_spec: -HIPE_MKLITERALS=$(ERL_TOP)/bin/$(TARGET)/hipe_mkliterals +ifeq ($(TYPE),debug) +TYPE_STR=.debug +else +TYPE_STR= +endif + +ifeq ($(FLAVOR),smp) +FLAVOR_STR=.smp +else +FLAVOR_STR= +endif + +ifeq ($(XCOMP),yes) +MKLIT_FLAGS= -x +else +MKLIT_FLAGS= +endif + + +HIPE_MKLITERALS=$(ERL_TOP)/bin/$(TARGET)/hipe_mkliterals$(TYPE_STR)$(FLAVOR_STR) + hipe_literals.hrl: $(HIPE_MKLITERALS) - $(HIPE_MKLITERALS) -e > hipe_literals.hrl + $(HIPE_MKLITERALS) $(MKLIT_FLAGS) -e > hipe_literals.hrl # Need to generate hipe.hrl from one and only one target in one and only # one makefile; otherwise, clearmake will force rebuilds of hipe over and diff --git a/lib/hipe/util/hipe_dot.erl b/lib/hipe/util/hipe_dot.erl index d6ef801c88..d6ef801c88 100755..100644 --- a/lib/hipe/util/hipe_dot.erl +++ b/lib/hipe/util/hipe_dot.erl diff --git a/lib/ic/c_src/Makefile.in b/lib/ic/c_src/Makefile.in index 6eef7827b9..28040ca42d 100644 --- a/lib/ic/c_src/Makefile.in +++ b/lib/ic/c_src/Makefile.in @@ -125,13 +125,9 @@ docs: # Special Build Targets # ---------------------------------------------------- -$(OBJDIR): - -mkdir -p $(OBJDIR) +_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) -$(LIBDIR): - -mkdir -p $(LIBDIR) - -$(LIBRARY): $(OBJDIR) $(LIBDIR) $(OBJ_FILES) +$(LIBRARY): $(OBJ_FILES) -$(AR) $(AR_OUT) $@ $(OBJ_FILES) -$(RANLIB) $@ diff --git a/lib/ic/doc/src/Makefile b/lib/ic/doc/src/Makefile index 8eda436a24..1e93578cb1 100644 --- a/lib/ic/doc/src/Makefile +++ b/lib/ic/doc/src/Makefile @@ -26,13 +26,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk include ../../vsn.mk VSN=$(IC_VSN) APPLICATION=ic -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif # ---------------------------------------------------- # Java specific @@ -96,32 +89,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - JAVA_SOURCE_FILES = \ Holder.java \ BooleanHolder.java \ @@ -209,8 +180,6 @@ JAVADOCFLAGS = \ $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - ifneq (,$(JAVA)) docs: pdf html man $(JAVADOC_GENERATED_FILES) else @@ -229,38 +198,11 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html $(JAVADOC_GENERATED_FILES) gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) +$(JAVADOC_GENERATED_FILES): JAVADOC-GENERATED -html: $(HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - rm -rf $(JAVA_OUT_DIR) - -endif - -$(JAVA_OUT_DIR): - mkdir $(JAVA_OUT_DIR) - -$(JAVADOC_GENERATED_FILES): $(JAVA_OUT_DIR) +JAVADOC-GENERATED: $(JAVA_SOURCE_FILES:%=$(JAVA_SOURCE_DIR)/%) @(cd ../../java_src; $(JAVADOC) $(JAVADOCFLAGS) com.ericsson.otp.ic) + >JAVADOC-GENERATED man: $(MAN3_FILES) @@ -277,8 +219,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -288,46 +228,4 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) -ifneq (,$(JAVA)) - $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java - $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/resources - $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com - $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com/ericsson - $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com/ericsson/otp - $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com/ericsson/otp/ic - $(INSTALL_DATA) $(JAVADOC_INDEX_HTML_FILES) \ - $(RELSYSDIR)/doc/html/java - $(INSTALL_DATA) $(JD_GIF_FILES) \ - $(RELSYSDIR)/doc/html/java/resources - $(INSTALL_DATA) $(JAVADOC_PACK_HTML_FILES) \ - $(RELSYSDIR)/doc/html/java/com/ericsson/otp/ic -endif - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif - - release_spec: - - diff --git a/lib/ic/doc/src/make.dep b/lib/ic/doc/src/make.dep deleted file mode 100644 index 64694ee85a..0000000000 --- a/lib/ic/doc/src/make.dep +++ /dev/null @@ -1,24 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex c-part.tex ch_basic_idl.tex ch_c_client.tex \ - ch_c_corba_env.tex ch_c_mapping.tex ch_c_server.tex \ - ch_erl_genserv.tex ch_erl_plain.tex ch_ic_protocol.tex \ - ch_introduction.tex ch_java.tex erl-part.tex \ - ic.tex ic_c_protocol.tex ic_clib.tex java-part.tex \ - ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/ic/examples/pre_post_condition/Makefile b/lib/ic/examples/pre_post_condition/Makefile index 68e2168e1e..d57133c964 100644 --- a/lib/ic/examples/pre_post_condition/Makefile +++ b/lib/ic/examples/pre_post_condition/Makefile @@ -100,7 +100,7 @@ YRL_FLAGS = debug opt: $(TARGET_FILES) clean: - rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES) + rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES) IDL-GENERATED rm -f errs core *~ docs: @@ -108,9 +108,14 @@ docs: test: $(TEST_TARGET_FILES) -$(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES): ex.idl +IDL-GENERATED: ex.idl erlc $(ERL_LOCAL_FLAGS) +'{precond,{tracer,pre}}' \ +'{{postcond,"m::i::f"},{tracer,post}}' ex.idl + >IDL-GENERATED + +$(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/ic/java_src/com/ericsson/otp/ic/ignore_config_record.inf b/lib/ic/java_src/com/ericsson/otp/ic/ignore_config_record.inf deleted file mode 100644 index 34e5586175..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/ignore_config_record.inf +++ /dev/null @@ -1 +0,0 @@ -Dummy to speed up compilatio diff --git a/lib/inets/doc/archive/rfc3986.txt b/lib/inets/doc/archive/rfc3986.txt new file mode 100644 index 0000000000..c56ed4eb70 --- /dev/null +++ b/lib/inets/doc/archive/rfc3986.txt @@ -0,0 +1,3419 @@ + + + + + + +Network Working Group T. Berners-Lee +Request for Comments: 3986 W3C/MIT +STD: 66 R. Fielding +Updates: 1738 Day Software +Obsoletes: 2732, 2396, 1808 L. Masinter +Category: Standards Track Adobe Systems + January 2005 + + + Uniform Resource Identifier (URI): Generic Syntax + +Status of This Memo + + This document specifies an Internet standards track protocol for the + Internet community, and requests discussion and suggestions for + improvements. Please refer to the current edition of the "Internet + Official Protocol Standards" (STD 1) for the standardization state + and status of this protocol. Distribution of this memo is unlimited. + +Copyright Notice + + Copyright (C) The Internet Society (2005). + +Abstract + + A Uniform Resource Identifier (URI) is a compact sequence of + characters that identifies an abstract or physical resource. This + specification defines the generic URI syntax and a process for + resolving URI references that might be in relative form, along with + guidelines and security considerations for the use of URIs on the + Internet. The URI syntax defines a grammar that is a superset of all + valid URIs, allowing an implementation to parse the common components + of a URI reference without knowing the scheme-specific requirements + of every possible identifier. This specification does not define a + generative grammar for URIs; that task is performed by the individual + specifications of each URI scheme. + + + + + + + + + + + + + + + +Berners-Lee, et al. Standards Track [Page 1] + +RFC 3986 URI Generic Syntax January 2005 + + +Table of Contents + + 1. Introduction . . . . . . . . . . . . . . . . . . . . . . . . . 4 + 1.1. Overview of URIs . . . . . . . . . . . . . . . . . . . . 4 + 1.1.1. Generic Syntax . . . . . . . . . . . . . . . . . 6 + 1.1.2. Examples . . . . . . . . . . . . . . . . . . . . 7 + 1.1.3. URI, URL, and URN . . . . . . . . . . . . . . . 7 + 1.2. Design Considerations . . . . . . . . . . . . . . . . . 8 + 1.2.1. Transcription . . . . . . . . . . . . . . . . . 8 + 1.2.2. Separating Identification from Interaction . . . 9 + 1.2.3. Hierarchical Identifiers . . . . . . . . . . . . 10 + 1.3. Syntax Notation . . . . . . . . . . . . . . . . . . . . 11 + 2. Characters . . . . . . . . . . . . . . . . . . . . . . . . . . 11 + 2.1. Percent-Encoding . . . . . . . . . . . . . . . . . . . . 12 + 2.2. Reserved Characters . . . . . . . . . . . . . . . . . . 12 + 2.3. Unreserved Characters . . . . . . . . . . . . . . . . . 13 + 2.4. When to Encode or Decode . . . . . . . . . . . . . . . . 14 + 2.5. Identifying Data . . . . . . . . . . . . . . . . . . . . 14 + 3. Syntax Components . . . . . . . . . . . . . . . . . . . . . . 16 + 3.1. Scheme . . . . . . . . . . . . . . . . . . . . . . . . . 17 + 3.2. Authority . . . . . . . . . . . . . . . . . . . . . . . 17 + 3.2.1. User Information . . . . . . . . . . . . . . . . 18 + 3.2.2. Host . . . . . . . . . . . . . . . . . . . . . . 18 + 3.2.3. Port . . . . . . . . . . . . . . . . . . . . . . 22 + 3.3. Path . . . . . . . . . . . . . . . . . . . . . . . . . . 22 + 3.4. Query . . . . . . . . . . . . . . . . . . . . . . . . . 23 + 3.5. Fragment . . . . . . . . . . . . . . . . . . . . . . . . 24 + 4. Usage . . . . . . . . . . . . . . . . . . . . . . . . . . . . 25 + 4.1. URI Reference . . . . . . . . . . . . . . . . . . . . . 25 + 4.2. Relative Reference . . . . . . . . . . . . . . . . . . . 26 + 4.3. Absolute URI . . . . . . . . . . . . . . . . . . . . . . 27 + 4.4. Same-Document Reference . . . . . . . . . . . . . . . . 27 + 4.5. Suffix Reference . . . . . . . . . . . . . . . . . . . . 27 + 5. Reference Resolution . . . . . . . . . . . . . . . . . . . . . 28 + 5.1. Establishing a Base URI . . . . . . . . . . . . . . . . 28 + 5.1.1. Base URI Embedded in Content . . . . . . . . . . 29 + 5.1.2. Base URI from the Encapsulating Entity . . . . . 29 + 5.1.3. Base URI from the Retrieval URI . . . . . . . . 30 + 5.1.4. Default Base URI . . . . . . . . . . . . . . . . 30 + 5.2. Relative Resolution . . . . . . . . . . . . . . . . . . 30 + 5.2.1. Pre-parse the Base URI . . . . . . . . . . . . . 31 + 5.2.2. Transform References . . . . . . . . . . . . . . 31 + 5.2.3. Merge Paths . . . . . . . . . . . . . . . . . . 32 + 5.2.4. Remove Dot Segments . . . . . . . . . . . . . . 33 + 5.3. Component Recomposition . . . . . . . . . . . . . . . . 35 + 5.4. Reference Resolution Examples . . . . . . . . . . . . . 35 + 5.4.1. Normal Examples . . . . . . . . . . . . . . . . 36 + 5.4.2. Abnormal Examples . . . . . . . . . . . . . . . 36 + + + +Berners-Lee, et al. Standards Track [Page 2] + +RFC 3986 URI Generic Syntax January 2005 + + + 6. Normalization and Comparison . . . . . . . . . . . . . . . . . 38 + 6.1. Equivalence . . . . . . . . . . . . . . . . . . . . . . 38 + 6.2. Comparison Ladder . . . . . . . . . . . . . . . . . . . 39 + 6.2.1. Simple String Comparison . . . . . . . . . . . . 39 + 6.2.2. Syntax-Based Normalization . . . . . . . . . . . 40 + 6.2.3. Scheme-Based Normalization . . . . . . . . . . . 41 + 6.2.4. Protocol-Based Normalization . . . . . . . . . . 42 + 7. Security Considerations . . . . . . . . . . . . . . . . . . . 43 + 7.1. Reliability and Consistency . . . . . . . . . . . . . . 43 + 7.2. Malicious Construction . . . . . . . . . . . . . . . . . 43 + 7.3. Back-End Transcoding . . . . . . . . . . . . . . . . . . 44 + 7.4. Rare IP Address Formats . . . . . . . . . . . . . . . . 45 + 7.5. Sensitive Information . . . . . . . . . . . . . . . . . 45 + 7.6. Semantic Attacks . . . . . . . . . . . . . . . . . . . . 45 + 8. IANA Considerations . . . . . . . . . . . . . . . . . . . . . 46 + 9. Acknowledgements . . . . . . . . . . . . . . . . . . . . . . . 46 + 10. References . . . . . . . . . . . . . . . . . . . . . . . . . . 46 + 10.1. Normative References . . . . . . . . . . . . . . . . . . 46 + 10.2. Informative References . . . . . . . . . . . . . . . . . 47 + A. Collected ABNF for URI . . . . . . . . . . . . . . . . . . . . 49 + B. Parsing a URI Reference with a Regular Expression . . . . . . 50 + C. Delimiting a URI in Context . . . . . . . . . . . . . . . . . 51 + D. Changes from RFC 2396 . . . . . . . . . . . . . . . . . . . . 53 + D.1. Additions . . . . . . . . . . . . . . . . . . . . . . . 53 + D.2. Modifications . . . . . . . . . . . . . . . . . . . . . 53 + Index . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 56 + Authors' Addresses . . . . . . . . . . . . . . . . . . . . . . . . 60 + Full Copyright Statement . . . . . . . . . . . . . . . . . . . . . 61 + + + + + + + + + + + + + + + + + + + + + + + +Berners-Lee, et al. Standards Track [Page 3] + +RFC 3986 URI Generic Syntax January 2005 + + +1. Introduction + + A Uniform Resource Identifier (URI) provides a simple and extensible + means for identifying a resource. This specification of URI syntax + and semantics is derived from concepts introduced by the World Wide + Web global information initiative, whose use of these identifiers + dates from 1990 and is described in "Universal Resource Identifiers + in WWW" [RFC1630]. The syntax is designed to meet the + recommendations laid out in "Functional Recommendations for Internet + Resource Locators" [RFC1736] and "Functional Requirements for Uniform + Resource Names" [RFC1737]. + + This document obsoletes [RFC2396], which merged "Uniform Resource + Locators" [RFC1738] and "Relative Uniform Resource Locators" + [RFC1808] in order to define a single, generic syntax for all URIs. + It obsoletes [RFC2732], which introduced syntax for an IPv6 address. + It excludes portions of RFC 1738 that defined the specific syntax of + individual URI schemes; those portions will be updated as separate + documents. The process for registration of new URI schemes is + defined separately by [BCP35]. Advice for designers of new URI + schemes can be found in [RFC2718]. All significant changes from RFC + 2396 are noted in Appendix D. + + This specification uses the terms "character" and "coded character + set" in accordance with the definitions provided in [BCP19], and + "character encoding" in place of what [BCP19] refers to as a + "charset". + +1.1. Overview of URIs + + URIs are characterized as follows: + + Uniform + + Uniformity provides several benefits. It allows different types + of resource identifiers to be used in the same context, even when + the mechanisms used to access those resources may differ. It + allows uniform semantic interpretation of common syntactic + conventions across different types of resource identifiers. It + allows introduction of new types of resource identifiers without + interfering with the way that existing identifiers are used. It + allows the identifiers to be reused in many different contexts, + thus permitting new applications or protocols to leverage a pre- + existing, large, and widely used set of resource identifiers. + + + + + + + +Berners-Lee, et al. Standards Track [Page 4] + +RFC 3986 URI Generic Syntax January 2005 + + + Resource + + This specification does not limit the scope of what might be a + resource; rather, the term "resource" is used in a general sense + for whatever might be identified by a URI. Familiar examples + include an electronic document, an image, a source of information + with a consistent purpose (e.g., "today's weather report for Los + Angeles"), a service (e.g., an HTTP-to-SMS gateway), and a + collection of other resources. A resource is not necessarily + accessible via the Internet; e.g., human beings, corporations, and + bound books in a library can also be resources. Likewise, + abstract concepts can be resources, such as the operators and + operands of a mathematical equation, the types of a relationship + (e.g., "parent" or "employee"), or numeric values (e.g., zero, + one, and infinity). + + Identifier + + An identifier embodies the information required to distinguish + what is being identified from all other things within its scope of + identification. Our use of the terms "identify" and "identifying" + refer to this purpose of distinguishing one resource from all + other resources, regardless of how that purpose is accomplished + (e.g., by name, address, or context). These terms should not be + mistaken as an assumption that an identifier defines or embodies + the identity of what is referenced, though that may be the case + for some identifiers. Nor should it be assumed that a system + using URIs will access the resource identified: in many cases, + URIs are used to denote resources without any intention that they + be accessed. Likewise, the "one" resource identified might not be + singular in nature (e.g., a resource might be a named set or a + mapping that varies over time). + + A URI is an identifier consisting of a sequence of characters + matching the syntax rule named <URI> in Section 3. It enables + uniform identification of resources via a separately defined + extensible set of naming schemes (Section 3.1). How that + identification is accomplished, assigned, or enabled is delegated to + each scheme specification. + + This specification does not place any limits on the nature of a + resource, the reasons why an application might seek to refer to a + resource, or the kinds of systems that might use URIs for the sake of + identifying resources. This specification does not require that a + URI persists in identifying the same resource over time, though that + is a common goal of all URI schemes. Nevertheless, nothing in this + + + + + +Berners-Lee, et al. Standards Track [Page 5] + +RFC 3986 URI Generic Syntax January 2005 + + + specification prevents an application from limiting itself to + particular types of resources, or to a subset of URIs that maintains + characteristics desired by that application. + + URIs have a global scope and are interpreted consistently regardless + of context, though the result of that interpretation may be in + relation to the end-user's context. For example, "http://localhost/" + has the same interpretation for every user of that reference, even + though the network interface corresponding to "localhost" may be + different for each end-user: interpretation is independent of access. + However, an action made on the basis of that reference will take + place in relation to the end-user's context, which implies that an + action intended to refer to a globally unique thing must use a URI + that distinguishes that resource from all other things. URIs that + identify in relation to the end-user's local context should only be + used when the context itself is a defining aspect of the resource, + such as when an on-line help manual refers to a file on the end- + user's file system (e.g., "file:///etc/hosts"). + +1.1.1. Generic Syntax + + Each URI begins with a scheme name, as defined in Section 3.1, that + refers to a specification for assigning identifiers within that + scheme. As such, the URI syntax is a federated and extensible naming + system wherein each scheme's specification may further restrict the + syntax and semantics of identifiers using that scheme. + + This specification defines those elements of the URI syntax that are + required of all URI schemes or are common to many URI schemes. It + thus defines the syntax and semantics needed to implement a scheme- + independent parsing mechanism for URI references, by which the + scheme-dependent handling of a URI can be postponed until the + scheme-dependent semantics are needed. Likewise, protocols and data + formats that make use of URI references can refer to this + specification as a definition for the range of syntax allowed for all + URIs, including those schemes that have yet to be defined. This + decouples the evolution of identification schemes from the evolution + of protocols, data formats, and implementations that make use of + URIs. + + A parser of the generic URI syntax can parse any URI reference into + its major components. Once the scheme is determined, further + scheme-specific parsing can be performed on the components. In other + words, the URI generic syntax is a superset of the syntax of all URI + schemes. + + + + + + +Berners-Lee, et al. Standards Track [Page 6] + +RFC 3986 URI Generic Syntax January 2005 + + +1.1.2. Examples + + The following example URIs illustrate several URI schemes and + variations in their common syntax components: + + ftp://ftp.is.co.za/rfc/rfc1808.txt + + http://www.ietf.org/rfc/rfc2396.txt + + ldap://[2001:db8::7]/c=GB?objectClass?one + + mailto:[email protected] + + news:comp.infosystems.www.servers.unix + + tel:+1-816-555-1212 + + telnet://192.0.2.16:80/ + + urn:oasis:names:specification:docbook:dtd:xml:4.1.2 + + +1.1.3. URI, URL, and URN + + A URI can be further classified as a locator, a name, or both. The + term "Uniform Resource Locator" (URL) refers to the subset of URIs + that, in addition to identifying a resource, provide a means of + locating the resource by describing its primary access mechanism + (e.g., its network "location"). The term "Uniform Resource Name" + (URN) has been used historically to refer to both URIs under the + "urn" scheme [RFC2141], which are required to remain globally unique + and persistent even when the resource ceases to exist or becomes + unavailable, and to any other URI with the properties of a name. + + An individual scheme does not have to be classified as being just one + of "name" or "locator". Instances of URIs from any given scheme may + have the characteristics of names or locators or both, often + depending on the persistence and care in the assignment of + identifiers by the naming authority, rather than on any quality of + the scheme. Future specifications and related documentation should + use the general term "URI" rather than the more restrictive terms + "URL" and "URN" [RFC3305]. + + + + + + + + + +Berners-Lee, et al. Standards Track [Page 7] + +RFC 3986 URI Generic Syntax January 2005 + + +1.2. Design Considerations + +1.2.1. Transcription + + The URI syntax has been designed with global transcription as one of + its main considerations. A URI is a sequence of characters from a + very limited set: the letters of the basic Latin alphabet, digits, + and a few special characters. A URI may be represented in a variety + of ways; e.g., ink on paper, pixels on a screen, or a sequence of + character encoding octets. The interpretation of a URI depends only + on the characters used and not on how those characters are + represented in a network protocol. + + The goal of transcription can be described by a simple scenario. + Imagine two colleagues, Sam and Kim, sitting in a pub at an + international conference and exchanging research ideas. Sam asks Kim + for a location to get more information, so Kim writes the URI for the + research site on a napkin. Upon returning home, Sam takes out the + napkin and types the URI into a computer, which then retrieves the + information to which Kim referred. + + There are several design considerations revealed by the scenario: + + o A URI is a sequence of characters that is not always represented + as a sequence of octets. + + o A URI might be transcribed from a non-network source and thus + should consist of characters that are most likely able to be + entered into a computer, within the constraints imposed by + keyboards (and related input devices) across languages and + locales. + + o A URI often has to be remembered by people, and it is easier for + people to remember a URI when it consists of meaningful or + familiar components. + + These design considerations are not always in alignment. For + example, it is often the case that the most meaningful name for a URI + component would require characters that cannot be typed into some + systems. The ability to transcribe a resource identifier from one + medium to another has been considered more important than having a + URI consist of the most meaningful of components. + + In local or regional contexts and with improving technology, users + might benefit from being able to use a wider range of characters; + such use is not defined by this specification. Percent-encoded + octets (Section 2.1) may be used within a URI to represent characters + outside the range of the US-ASCII coded character set if this + + + +Berners-Lee, et al. Standards Track [Page 8] + +RFC 3986 URI Generic Syntax January 2005 + + + representation is allowed by the scheme or by the protocol element in + which the URI is referenced. Such a definition should specify the + character encoding used to map those characters to octets prior to + being percent-encoded for the URI. + +1.2.2. Separating Identification from Interaction + + A common misunderstanding of URIs is that they are only used to refer + to accessible resources. The URI itself only provides + identification; access to the resource is neither guaranteed nor + implied by the presence of a URI. Instead, any operation associated + with a URI reference is defined by the protocol element, data format + attribute, or natural language text in which it appears. + + Given a URI, a system may attempt to perform a variety of operations + on the resource, as might be characterized by words such as "access", + "update", "replace", or "find attributes". Such operations are + defined by the protocols that make use of URIs, not by this + specification. However, we do use a few general terms for describing + common operations on URIs. URI "resolution" is the process of + determining an access mechanism and the appropriate parameters + necessary to dereference a URI; this resolution may require several + iterations. To use that access mechanism to perform an action on the + URI's resource is to "dereference" the URI. + + When URIs are used within information retrieval systems to identify + sources of information, the most common form of URI dereference is + "retrieval": making use of a URI in order to retrieve a + representation of its associated resource. A "representation" is a + sequence of octets, along with representation metadata describing + those octets, that constitutes a record of the state of the resource + at the time when the representation is generated. Retrieval is + achieved by a process that might include using the URI as a cache key + to check for a locally cached representation, resolution of the URI + to determine an appropriate access mechanism (if any), and + dereference of the URI for the sake of applying a retrieval + operation. Depending on the protocols used to perform the retrieval, + additional information might be supplied about the resource (resource + metadata) and its relation to other resources. + + URI references in information retrieval systems are designed to be + late-binding: the result of an access is generally determined when it + is accessed and may vary over time or due to other aspects of the + interaction. These references are created in order to be used in the + future: what is being identified is not some specific result that was + obtained in the past, but rather some characteristic that is expected + to be true for future results. In such cases, the resource referred + to by the URI is actually a sameness of characteristics as observed + + + +Berners-Lee, et al. Standards Track [Page 9] + +RFC 3986 URI Generic Syntax January 2005 + + + over time, perhaps elucidated by additional comments or assertions + made by the resource provider. + + Although many URI schemes are named after protocols, this does not + imply that use of these URIs will result in access to the resource + via the named protocol. URIs are often used simply for the sake of + identification. Even when a URI is used to retrieve a representation + of a resource, that access might be through gateways, proxies, + caches, and name resolution services that are independent of the + protocol associated with the scheme name. The resolution of some + URIs may require the use of more than one protocol (e.g., both DNS + and HTTP are typically used to access an "http" URI's origin server + when a representation isn't found in a local cache). + +1.2.3. Hierarchical Identifiers + + The URI syntax is organized hierarchically, with components listed in + order of decreasing significance from left to right. For some URI + schemes, the visible hierarchy is limited to the scheme itself: + everything after the scheme component delimiter (":") is considered + opaque to URI processing. Other URI schemes make the hierarchy + explicit and visible to generic parsing algorithms. + + The generic syntax uses the slash ("/"), question mark ("?"), and + number sign ("#") characters to delimit components that are + significant to the generic parser's hierarchical interpretation of an + identifier. In addition to aiding the readability of such + identifiers through the consistent use of familiar syntax, this + uniform representation of hierarchy across naming schemes allows + scheme-independent references to be made relative to that hierarchy. + + It is often the case that a group or "tree" of documents has been + constructed to serve a common purpose, wherein the vast majority of + URI references in these documents point to resources within the tree + rather than outside it. Similarly, documents located at a particular + site are much more likely to refer to other resources at that site + than to resources at remote sites. Relative referencing of URIs + allows document trees to be partially independent of their location + and access scheme. For instance, it is possible for a single set of + hypertext documents to be simultaneously accessible and traversable + via each of the "file", "http", and "ftp" schemes if the documents + refer to each other with relative references. Furthermore, such + document trees can be moved, as a whole, without changing any of the + relative references. + + A relative reference (Section 4.2) refers to a resource by describing + the difference within a hierarchical name space between the reference + context and the target URI. The reference resolution algorithm, + + + +Berners-Lee, et al. Standards Track [Page 10] + +RFC 3986 URI Generic Syntax January 2005 + + + presented in Section 5, defines how such a reference is transformed + to the target URI. As relative references can only be used within + the context of a hierarchical URI, designers of new URI schemes + should use a syntax consistent with the generic syntax's hierarchical + components unless there are compelling reasons to forbid relative + referencing within that scheme. + + NOTE: Previous specifications used the terms "partial URI" and + "relative URI" to denote a relative reference to a URI. As some + readers misunderstood those terms to mean that relative URIs are a + subset of URIs rather than a method of referencing URIs, this + specification simply refers to them as relative references. + + All URI references are parsed by generic syntax parsers when used. + However, because hierarchical processing has no effect on an absolute + URI used in a reference unless it contains one or more dot-segments + (complete path segments of "." or "..", as described in Section 3.3), + URI scheme specifications can define opaque identifiers by + disallowing use of slash characters, question mark characters, and + the URIs "scheme:." and "scheme:..". + +1.3. Syntax Notation + + This specification uses the Augmented Backus-Naur Form (ABNF) + notation of [RFC2234], including the following core ABNF syntax rules + defined by that specification: ALPHA (letters), CR (carriage return), + DIGIT (decimal digits), DQUOTE (double quote), HEXDIG (hexadecimal + digits), LF (line feed), and SP (space). The complete URI syntax is + collected in Appendix A. + +2. Characters + + The URI syntax provides a method of encoding data, presumably for the + sake of identifying a resource, as a sequence of characters. The URI + characters are, in turn, frequently encoded as octets for transport + or presentation. This specification does not mandate any particular + character encoding for mapping between URI characters and the octets + used to store or transmit those characters. When a URI appears in a + protocol element, the character encoding is defined by that protocol; + without such a definition, a URI is assumed to be in the same + character encoding as the surrounding text. + + The ABNF notation defines its terminal values to be non-negative + integers (codepoints) based on the US-ASCII coded character set + [ASCII]. Because a URI is a sequence of characters, we must invert + that relation in order to understand the URI syntax. Therefore, the + + + + + +Berners-Lee, et al. Standards Track [Page 11] + +RFC 3986 URI Generic Syntax January 2005 + + + integer values used by the ABNF must be mapped back to their + corresponding characters via US-ASCII in order to complete the syntax + rules. + + A URI is composed from a limited set of characters consisting of + digits, letters, and a few graphic symbols. A reserved subset of + those characters may be used to delimit syntax components within a + URI while the remaining characters, including both the unreserved set + and those reserved characters not acting as delimiters, define each + component's identifying data. + +2.1. Percent-Encoding + + A percent-encoding mechanism is used to represent a data octet in a + component when that octet's corresponding character is outside the + allowed set or is being used as a delimiter of, or within, the + component. A percent-encoded octet is encoded as a character + triplet, consisting of the percent character "%" followed by the two + hexadecimal digits representing that octet's numeric value. For + example, "%20" is the percent-encoding for the binary octet + "00100000" (ABNF: %x20), which in US-ASCII corresponds to the space + character (SP). Section 2.4 describes when percent-encoding and + decoding is applied. + + pct-encoded = "%" HEXDIG HEXDIG + + The uppercase hexadecimal digits 'A' through 'F' are equivalent to + the lowercase digits 'a' through 'f', respectively. If two URIs + differ only in the case of hexadecimal digits used in percent-encoded + octets, they are equivalent. For consistency, URI producers and + normalizers should use uppercase hexadecimal digits for all percent- + encodings. + +2.2. Reserved Characters + + URIs include components and subcomponents that are delimited by + characters in the "reserved" set. These characters are called + "reserved" because they may (or may not) be defined as delimiters by + the generic syntax, by each scheme-specific syntax, or by the + implementation-specific syntax of a URI's dereferencing algorithm. + If data for a URI component would conflict with a reserved + character's purpose as a delimiter, then the conflicting data must be + percent-encoded before the URI is formed. + + + + + + + + +Berners-Lee, et al. Standards Track [Page 12] + +RFC 3986 URI Generic Syntax January 2005 + + + reserved = gen-delims / sub-delims + + gen-delims = ":" / "/" / "?" / "#" / "[" / "]" / "@" + + sub-delims = "!" / "$" / "&" / "'" / "(" / ")" + / "*" / "+" / "," / ";" / "=" + + The purpose of reserved characters is to provide a set of delimiting + characters that are distinguishable from other data within a URI. + URIs that differ in the replacement of a reserved character with its + corresponding percent-encoded octet are not equivalent. Percent- + encoding a reserved character, or decoding a percent-encoded octet + that corresponds to a reserved character, will change how the URI is + interpreted by most applications. Thus, characters in the reserved + set are protected from normalization and are therefore safe to be + used by scheme-specific and producer-specific algorithms for + delimiting data subcomponents within a URI. + + A subset of the reserved characters (gen-delims) is used as + delimiters of the generic URI components described in Section 3. A + component's ABNF syntax rule will not use the reserved or gen-delims + rule names directly; instead, each syntax rule lists the characters + allowed within that component (i.e., not delimiting it), and any of + those characters that are also in the reserved set are "reserved" for + use as subcomponent delimiters within the component. Only the most + common subcomponents are defined by this specification; other + subcomponents may be defined by a URI scheme's specification, or by + the implementation-specific syntax of a URI's dereferencing + algorithm, provided that such subcomponents are delimited by + characters in the reserved set allowed within that component. + + URI producing applications should percent-encode data octets that + correspond to characters in the reserved set unless these characters + are specifically allowed by the URI scheme to represent data in that + component. If a reserved character is found in a URI component and + no delimiting role is known for that character, then it must be + interpreted as representing the data octet corresponding to that + character's encoding in US-ASCII. + +2.3. Unreserved Characters + + Characters that are allowed in a URI but do not have a reserved + purpose are called unreserved. These include uppercase and lowercase + letters, decimal digits, hyphen, period, underscore, and tilde. + + unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~" + + + + + +Berners-Lee, et al. Standards Track [Page 13] + +RFC 3986 URI Generic Syntax January 2005 + + + URIs that differ in the replacement of an unreserved character with + its corresponding percent-encoded US-ASCII octet are equivalent: they + identify the same resource. However, URI comparison implementations + do not always perform normalization prior to comparison (see Section + 6). For consistency, percent-encoded octets in the ranges of ALPHA + (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period (%2E), + underscore (%5F), or tilde (%7E) should not be created by URI + producers and, when found in a URI, should be decoded to their + corresponding unreserved characters by URI normalizers. + +2.4. When to Encode or Decode + + Under normal circumstances, the only time when octets within a URI + are percent-encoded is during the process of producing the URI from + its component parts. This is when an implementation determines which + of the reserved characters are to be used as subcomponent delimiters + and which can be safely used as data. Once produced, a URI is always + in its percent-encoded form. + + When a URI is dereferenced, the components and subcomponents + significant to the scheme-specific dereferencing process (if any) + must be parsed and separated before the percent-encoded octets within + those components can be safely decoded, as otherwise the data may be + mistaken for component delimiters. The only exception is for + percent-encoded octets corresponding to characters in the unreserved + set, which can be decoded at any time. For example, the octet + corresponding to the tilde ("~") character is often encoded as "%7E" + by older URI processing implementations; the "%7E" can be replaced by + "~" without changing its interpretation. + + Because the percent ("%") character serves as the indicator for + percent-encoded octets, it must be percent-encoded as "%25" for that + octet to be used as data within a URI. Implementations must not + percent-encode or decode the same string more than once, as decoding + an already decoded string might lead to misinterpreting a percent + data octet as the beginning of a percent-encoding, or vice versa in + the case of percent-encoding an already percent-encoded string. + +2.5. Identifying Data + + URI characters provide identifying data for each of the URI + components, serving as an external interface for identification + between systems. Although the presence and nature of the URI + production interface is hidden from clients that use its URIs (and is + thus beyond the scope of the interoperability requirements defined by + this specification), it is a frequent source of confusion and errors + in the interpretation of URI character issues. Implementers have to + be aware that there are multiple character encodings involved in the + + + +Berners-Lee, et al. Standards Track [Page 14] + +RFC 3986 URI Generic Syntax January 2005 + + + production and transmission of URIs: local name and data encoding, + public interface encoding, URI character encoding, data format + encoding, and protocol encoding. + + Local names, such as file system names, are stored with a local + character encoding. URI producing applications (e.g., origin + servers) will typically use the local encoding as the basis for + producing meaningful names. The URI producer will transform the + local encoding to one that is suitable for a public interface and + then transform the public interface encoding into the restricted set + of URI characters (reserved, unreserved, and percent-encodings). + Those characters are, in turn, encoded as octets to be used as a + reference within a data format (e.g., a document charset), and such + data formats are often subsequently encoded for transmission over + Internet protocols. + + For most systems, an unreserved character appearing within a URI + component is interpreted as representing the data octet corresponding + to that character's encoding in US-ASCII. Consumers of URIs assume + that the letter "X" corresponds to the octet "01011000", and even + when that assumption is incorrect, there is no harm in making it. A + system that internally provides identifiers in the form of a + different character encoding, such as EBCDIC, will generally perform + character translation of textual identifiers to UTF-8 [STD63] (or + some other superset of the US-ASCII character encoding) at an + internal interface, thereby providing more meaningful identifiers + than those resulting from simply percent-encoding the original + octets. + + For example, consider an information service that provides data, + stored locally using an EBCDIC-based file system, to clients on the + Internet through an HTTP server. When an author creates a file with + the name "Laguna Beach" on that file system, the "http" URI + corresponding to that resource is expected to contain the meaningful + string "Laguna%20Beach". If, however, that server produces URIs by + using an overly simplistic raw octet mapping, then the result would + be a URI containing "%D3%81%87%A4%95%81@%C2%85%81%83%88". An + internal transcoding interface fixes this problem by transcoding the + local name to a superset of US-ASCII prior to producing the URI. + Naturally, proper interpretation of an incoming URI on such an + interface requires that percent-encoded octets be decoded (e.g., + "%20" to SP) before the reverse transcoding is applied to obtain the + local name. + + In some cases, the internal interface between a URI component and the + identifying data that it has been crafted to represent is much less + direct than a character encoding translation. For example, portions + of a URI might reflect a query on non-ASCII data, or numeric + + + +Berners-Lee, et al. Standards Track [Page 15] + +RFC 3986 URI Generic Syntax January 2005 + + + coordinates on a map. Likewise, a URI scheme may define components + with additional encoding requirements that are applied prior to + forming the component and producing the URI. + + When a new URI scheme defines a component that represents textual + data consisting of characters from the Universal Character Set [UCS], + the data should first be encoded as octets according to the UTF-8 + character encoding [STD63]; then only those octets that do not + correspond to characters in the unreserved set should be percent- + encoded. For example, the character A would be represented as "A", + the character LATIN CAPITAL LETTER A WITH GRAVE would be represented + as "%C3%80", and the character KATAKANA LETTER A would be represented + as "%E3%82%A2". + +3. Syntax Components + + The generic URI syntax consists of a hierarchical sequence of + components referred to as the scheme, authority, path, query, and + fragment. + + URI = scheme ":" hier-part [ "?" query ] [ "#" fragment ] + + hier-part = "//" authority path-abempty + / path-absolute + / path-rootless + / path-empty + + The scheme and path components are required, though the path may be + empty (no characters). When authority is present, the path must + either be empty or begin with a slash ("/") character. When + authority is not present, the path cannot begin with two slash + characters ("//"). These restrictions result in five different ABNF + rules for a path (Section 3.3), only one of which will match any + given URI reference. + + The following are two example URIs and their component parts: + + foo://example.com:8042/over/there?name=ferret#nose + \_/ \______________/\_________/ \_________/ \__/ + | | | | | + scheme authority path query fragment + | _____________________|__ + / \ / \ + urn:example:animal:ferret:nose + + + + + + + +Berners-Lee, et al. Standards Track [Page 16] + +RFC 3986 URI Generic Syntax January 2005 + + +3.1. Scheme + + Each URI begins with a scheme name that refers to a specification for + assigning identifiers within that scheme. As such, the URI syntax is + a federated and extensible naming system wherein each scheme's + specification may further restrict the syntax and semantics of + identifiers using that scheme. + + Scheme names consist of a sequence of characters beginning with a + letter and followed by any combination of letters, digits, plus + ("+"), period ("."), or hyphen ("-"). Although schemes are case- + insensitive, the canonical form is lowercase and documents that + specify schemes must do so with lowercase letters. An implementation + should accept uppercase letters as equivalent to lowercase in scheme + names (e.g., allow "HTTP" as well as "http") for the sake of + robustness but should only produce lowercase scheme names for + consistency. + + scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." ) + + Individual schemes are not specified by this document. The process + for registration of new URI schemes is defined separately by [BCP35]. + The scheme registry maintains the mapping between scheme names and + their specifications. Advice for designers of new URI schemes can be + found in [RFC2718]. URI scheme specifications must define their own + syntax so that all strings matching their scheme-specific syntax will + also match the <absolute-URI> grammar, as described in Section 4.3. + + When presented with a URI that violates one or more scheme-specific + restrictions, the scheme-specific resolution process should flag the + reference as an error rather than ignore the unused parts; doing so + reduces the number of equivalent URIs and helps detect abuses of the + generic syntax, which might indicate that the URI has been + constructed to mislead the user (Section 7.6). + +3.2. Authority + + Many URI schemes include a hierarchical element for a naming + authority so that governance of the name space defined by the + remainder of the URI is delegated to that authority (which may, in + turn, delegate it further). The generic syntax provides a common + means for distinguishing an authority based on a registered name or + server address, along with optional port and user information. + + The authority component is preceded by a double slash ("//") and is + terminated by the next slash ("/"), question mark ("?"), or number + sign ("#") character, or by the end of the URI. + + + + +Berners-Lee, et al. Standards Track [Page 17] + +RFC 3986 URI Generic Syntax January 2005 + + + authority = [ userinfo "@" ] host [ ":" port ] + + URI producers and normalizers should omit the ":" delimiter that + separates host from port if the port component is empty. Some + schemes do not allow the userinfo and/or port subcomponents. + + If a URI contains an authority component, then the path component + must either be empty or begin with a slash ("/") character. Non- + validating parsers (those that merely separate a URI reference into + its major components) will often ignore the subcomponent structure of + authority, treating it as an opaque string from the double-slash to + the first terminating delimiter, until such time as the URI is + dereferenced. + +3.2.1. User Information + + The userinfo subcomponent may consist of a user name and, optionally, + scheme-specific information about how to gain authorization to access + the resource. The user information, if present, is followed by a + commercial at-sign ("@") that delimits it from the host. + + userinfo = *( unreserved / pct-encoded / sub-delims / ":" ) + + Use of the format "user:password" in the userinfo field is + deprecated. Applications should not render as clear text any data + after the first colon (":") character found within a userinfo + subcomponent unless the data after the colon is the empty string + (indicating no password). Applications may choose to ignore or + reject such data when it is received as part of a reference and + should reject the storage of such data in unencrypted form. The + passing of authentication information in clear text has proven to be + a security risk in almost every case where it has been used. + + Applications that render a URI for the sake of user feedback, such as + in graphical hypertext browsing, should render userinfo in a way that + is distinguished from the rest of a URI, when feasible. Such + rendering will assist the user in cases where the userinfo has been + misleadingly crafted to look like a trusted domain name + (Section 7.6). + +3.2.2. Host + + The host subcomponent of authority is identified by an IP literal + encapsulated within square brackets, an IPv4 address in dotted- + decimal form, or a registered name. The host subcomponent is case- + insensitive. The presence of a host subcomponent within a URI does + not imply that the scheme requires access to the given host on the + Internet. In many cases, the host syntax is used only for the sake + + + +Berners-Lee, et al. Standards Track [Page 18] + +RFC 3986 URI Generic Syntax January 2005 + + + of reusing the existing registration process created and deployed for + DNS, thus obtaining a globally unique name without the cost of + deploying another registry. However, such use comes with its own + costs: domain name ownership may change over time for reasons not + anticipated by the URI producer. In other cases, the data within the + host component identifies a registered name that has nothing to do + with an Internet host. We use the name "host" for the ABNF rule + because that is its most common purpose, not its only purpose. + + host = IP-literal / IPv4address / reg-name + + The syntax rule for host is ambiguous because it does not completely + distinguish between an IPv4address and a reg-name. In order to + disambiguate the syntax, we apply the "first-match-wins" algorithm: + If host matches the rule for IPv4address, then it should be + considered an IPv4 address literal and not a reg-name. Although host + is case-insensitive, producers and normalizers should use lowercase + for registered names and hexadecimal addresses for the sake of + uniformity, while only using uppercase letters for percent-encodings. + + A host identified by an Internet Protocol literal address, version 6 + [RFC3513] or later, is distinguished by enclosing the IP literal + within square brackets ("[" and "]"). This is the only place where + square bracket characters are allowed in the URI syntax. In + anticipation of future, as-yet-undefined IP literal address formats, + an implementation may use an optional version flag to indicate such a + format explicitly rather than rely on heuristic determination. + + IP-literal = "[" ( IPv6address / IPvFuture ) "]" + + IPvFuture = "v" 1*HEXDIG "." 1*( unreserved / sub-delims / ":" ) + + The version flag does not indicate the IP version; rather, it + indicates future versions of the literal format. As such, + implementations must not provide the version flag for the existing + IPv4 and IPv6 literal address forms described below. If a URI + containing an IP-literal that starts with "v" (case-insensitive), + indicating that the version flag is present, is dereferenced by an + application that does not know the meaning of that version flag, then + the application should return an appropriate error for "address + mechanism not supported". + + A host identified by an IPv6 literal address is represented inside + the square brackets without a preceding version flag. The ABNF + provided here is a translation of the text definition of an IPv6 + literal address provided in [RFC3513]. This syntax does not support + IPv6 scoped addressing zone identifiers. + + + + +Berners-Lee, et al. Standards Track [Page 19] + +RFC 3986 URI Generic Syntax January 2005 + + + A 128-bit IPv6 address is divided into eight 16-bit pieces. Each + piece is represented numerically in case-insensitive hexadecimal, + using one to four hexadecimal digits (leading zeroes are permitted). + The eight encoded pieces are given most-significant first, separated + by colon characters. Optionally, the least-significant two pieces + may instead be represented in IPv4 address textual format. A + sequence of one or more consecutive zero-valued 16-bit pieces within + the address may be elided, omitting all their digits and leaving + exactly two consecutive colons in their place to mark the elision. + + IPv6address = 6( h16 ":" ) ls32 + / "::" 5( h16 ":" ) ls32 + / [ h16 ] "::" 4( h16 ":" ) ls32 + / [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32 + / [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32 + / [ *3( h16 ":" ) h16 ] "::" h16 ":" ls32 + / [ *4( h16 ":" ) h16 ] "::" ls32 + / [ *5( h16 ":" ) h16 ] "::" h16 + / [ *6( h16 ":" ) h16 ] "::" + + ls32 = ( h16 ":" h16 ) / IPv4address + ; least-significant 32 bits of address + + h16 = 1*4HEXDIG + ; 16 bits of address represented in hexadecimal + + A host identified by an IPv4 literal address is represented in + dotted-decimal notation (a sequence of four decimal numbers in the + range 0 to 255, separated by "."), as described in [RFC1123] by + reference to [RFC0952]. Note that other forms of dotted notation may + be interpreted on some platforms, as described in Section 7.4, but + only the dotted-decimal form of four octets is allowed by this + grammar. + + IPv4address = dec-octet "." dec-octet "." dec-octet "." dec-octet + + dec-octet = DIGIT ; 0-9 + / %x31-39 DIGIT ; 10-99 + / "1" 2DIGIT ; 100-199 + / "2" %x30-34 DIGIT ; 200-249 + / "25" %x30-35 ; 250-255 + + A host identified by a registered name is a sequence of characters + usually intended for lookup within a locally defined host or service + name registry, though the URI's scheme-specific semantics may require + that a specific registry (or fixed name table) be used instead. The + most common name registry mechanism is the Domain Name System (DNS). + A registered name intended for lookup in the DNS uses the syntax + + + +Berners-Lee, et al. Standards Track [Page 20] + +RFC 3986 URI Generic Syntax January 2005 + + + defined in Section 3.5 of [RFC1034] and Section 2.1 of [RFC1123]. + Such a name consists of a sequence of domain labels separated by ".", + each domain label starting and ending with an alphanumeric character + and possibly also containing "-" characters. The rightmost domain + label of a fully qualified domain name in DNS may be followed by a + single "." and should be if it is necessary to distinguish between + the complete domain name and some local domain. + + reg-name = *( unreserved / pct-encoded / sub-delims ) + + If the URI scheme defines a default for host, then that default + applies when the host subcomponent is undefined or when the + registered name is empty (zero length). For example, the "file" URI + scheme is defined so that no authority, an empty host, and + "localhost" all mean the end-user's machine, whereas the "http" + scheme considers a missing authority or empty host invalid. + + This specification does not mandate a particular registered name + lookup technology and therefore does not restrict the syntax of reg- + name beyond what is necessary for interoperability. Instead, it + delegates the issue of registered name syntax conformance to the + operating system of each application performing URI resolution, and + that operating system decides what it will allow for the purpose of + host identification. A URI resolution implementation might use DNS, + host tables, yellow pages, NetInfo, WINS, or any other system for + lookup of registered names. However, a globally scoped naming + system, such as DNS fully qualified domain names, is necessary for + URIs intended to have global scope. URI producers should use names + that conform to the DNS syntax, even when use of DNS is not + immediately apparent, and should limit these names to no more than + 255 characters in length. + + The reg-name syntax allows percent-encoded octets in order to + represent non-ASCII registered names in a uniform way that is + independent of the underlying name resolution technology. Non-ASCII + characters must first be encoded according to UTF-8 [STD63], and then + each octet of the corresponding UTF-8 sequence must be percent- + encoded to be represented as URI characters. URI producing + applications must not use percent-encoding in host unless it is used + to represent a UTF-8 character sequence. When a non-ASCII registered + name represents an internationalized domain name intended for + resolution via the DNS, the name must be transformed to the IDNA + encoding [RFC3490] prior to name lookup. URI producers should + provide these registered names in the IDNA encoding, rather than a + percent-encoding, if they wish to maximize interoperability with + legacy URI resolvers. + + + + + +Berners-Lee, et al. Standards Track [Page 21] + +RFC 3986 URI Generic Syntax January 2005 + + +3.2.3. Port + + The port subcomponent of authority is designated by an optional port + number in decimal following the host and delimited from it by a + single colon (":") character. + + port = *DIGIT + + A scheme may define a default port. For example, the "http" scheme + defines a default port of "80", corresponding to its reserved TCP + port number. The type of port designated by the port number (e.g., + TCP, UDP, SCTP) is defined by the URI scheme. URI producers and + normalizers should omit the port component and its ":" delimiter if + port is empty or if its value would be the same as that of the + scheme's default. + +3.3. Path + + The path component contains data, usually organized in hierarchical + form, that, along with data in the non-hierarchical query component + (Section 3.4), serves to identify a resource within the scope of the + URI's scheme and naming authority (if any). The path is terminated + by the first question mark ("?") or number sign ("#") character, or + by the end of the URI. + + If a URI contains an authority component, then the path component + must either be empty or begin with a slash ("/") character. If a URI + does not contain an authority component, then the path cannot begin + with two slash characters ("//"). In addition, a URI reference + (Section 4.1) may be a relative-path reference, in which case the + first path segment cannot contain a colon (":") character. The ABNF + requires five separate rules to disambiguate these cases, only one of + which will match the path substring within a given URI reference. We + use the generic term "path component" to describe the URI substring + matched by the parser to one of these rules. + + path = path-abempty ; begins with "/" or is empty + / path-absolute ; begins with "/" but not "//" + / path-noscheme ; begins with a non-colon segment + / path-rootless ; begins with a segment + / path-empty ; zero characters + + path-abempty = *( "/" segment ) + path-absolute = "/" [ segment-nz *( "/" segment ) ] + path-noscheme = segment-nz-nc *( "/" segment ) + path-rootless = segment-nz *( "/" segment ) + path-empty = 0<pchar> + + + + +Berners-Lee, et al. Standards Track [Page 22] + +RFC 3986 URI Generic Syntax January 2005 + + + segment = *pchar + segment-nz = 1*pchar + segment-nz-nc = 1*( unreserved / pct-encoded / sub-delims / "@" ) + ; non-zero-length segment without any colon ":" + + pchar = unreserved / pct-encoded / sub-delims / ":" / "@" + + A path consists of a sequence of path segments separated by a slash + ("/") character. A path is always defined for a URI, though the + defined path may be empty (zero length). Use of the slash character + to indicate hierarchy is only required when a URI will be used as the + context for relative references. For example, the URI + <mailto:[email protected]> has a path of "[email protected]", whereas + the URI <foo://info.example.com?fred> has an empty path. + + The path segments "." and "..", also known as dot-segments, are + defined for relative reference within the path name hierarchy. They + are intended for use at the beginning of a relative-path reference + (Section 4.2) to indicate relative position within the hierarchical + tree of names. This is similar to their role within some operating + systems' file directory structures to indicate the current directory + and parent directory, respectively. However, unlike in a file + system, these dot-segments are only interpreted within the URI path + hierarchy and are removed as part of the resolution process (Section + 5.2). + + Aside from dot-segments in hierarchical paths, a path segment is + considered opaque by the generic syntax. URI producing applications + often use the reserved characters allowed in a segment to delimit + scheme-specific or dereference-handler-specific subcomponents. For + example, the semicolon (";") and equals ("=") reserved characters are + often used to delimit parameters and parameter values applicable to + that segment. The comma (",") reserved character is often used for + similar purposes. For example, one URI producer might use a segment + such as "name;v=1.1" to indicate a reference to version 1.1 of + "name", whereas another might use a segment such as "name,1.1" to + indicate the same. Parameter types may be defined by scheme-specific + semantics, but in most cases the syntax of a parameter is specific to + the implementation of the URI's dereferencing algorithm. + +3.4. Query + + The query component contains non-hierarchical data that, along with + data in the path component (Section 3.3), serves to identify a + resource within the scope of the URI's scheme and naming authority + (if any). The query component is indicated by the first question + mark ("?") character and terminated by a number sign ("#") character + or by the end of the URI. + + + +Berners-Lee, et al. Standards Track [Page 23] + +RFC 3986 URI Generic Syntax January 2005 + + + query = *( pchar / "/" / "?" ) + + The characters slash ("/") and question mark ("?") may represent data + within the query component. Beware that some older, erroneous + implementations may not handle such data correctly when it is used as + the base URI for relative references (Section 5.1), apparently + because they fail to distinguish query data from path data when + looking for hierarchical separators. However, as query components + are often used to carry identifying information in the form of + "key=value" pairs and one frequently used value is a reference to + another URI, it is sometimes better for usability to avoid percent- + encoding those characters. + +3.5. Fragment + + The fragment identifier component of a URI allows indirect + identification of a secondary resource by reference to a primary + resource and additional identifying information. The identified + secondary resource may be some portion or subset of the primary + resource, some view on representations of the primary resource, or + some other resource defined or described by those representations. A + fragment identifier component is indicated by the presence of a + number sign ("#") character and terminated by the end of the URI. + + fragment = *( pchar / "/" / "?" ) + + The semantics of a fragment identifier are defined by the set of + representations that might result from a retrieval action on the + primary resource. The fragment's format and resolution is therefore + dependent on the media type [RFC2046] of a potentially retrieved + representation, even though such a retrieval is only performed if the + URI is dereferenced. If no such representation exists, then the + semantics of the fragment are considered unknown and are effectively + unconstrained. Fragment identifier semantics are independent of the + URI scheme and thus cannot be redefined by scheme specifications. + + Individual media types may define their own restrictions on or + structures within the fragment identifier syntax for specifying + different types of subsets, views, or external references that are + identifiable as secondary resources by that media type. If the + primary resource has multiple representations, as is often the case + for resources whose representation is selected based on attributes of + the retrieval request (a.k.a., content negotiation), then whatever is + identified by the fragment should be consistent across all of those + representations. Each representation should either define the + fragment so that it corresponds to the same secondary resource, + regardless of how it is represented, or should leave the fragment + undefined (i.e., not found). + + + +Berners-Lee, et al. Standards Track [Page 24] + +RFC 3986 URI Generic Syntax January 2005 + + + As with any URI, use of a fragment identifier component does not + imply that a retrieval action will take place. A URI with a fragment + identifier may be used to refer to the secondary resource without any + implication that the primary resource is accessible or will ever be + accessed. + + Fragment identifiers have a special role in information retrieval + systems as the primary form of client-side indirect referencing, + allowing an author to specifically identify aspects of an existing + resource that are only indirectly provided by the resource owner. As + such, the fragment identifier is not used in the scheme-specific + processing of a URI; instead, the fragment identifier is separated + from the rest of the URI prior to a dereference, and thus the + identifying information within the fragment itself is dereferenced + solely by the user agent, regardless of the URI scheme. Although + this separate handling is often perceived to be a loss of + information, particularly for accurate redirection of references as + resources move over time, it also serves to prevent information + providers from denying reference authors the right to refer to + information within a resource selectively. Indirect referencing also + provides additional flexibility and extensibility to systems that use + URIs, as new media types are easier to define and deploy than new + schemes of identification. + + The characters slash ("/") and question mark ("?") are allowed to + represent data within the fragment identifier. Beware that some + older, erroneous implementations may not handle this data correctly + when it is used as the base URI for relative references (Section + 5.1). + +4. Usage + + When applications make reference to a URI, they do not always use the + full form of reference defined by the "URI" syntax rule. To save + space and take advantage of hierarchical locality, many Internet + protocol elements and media type formats allow an abbreviation of a + URI, whereas others restrict the syntax to a particular form of URI. + We define the most common forms of reference syntax in this + specification because they impact and depend upon the design of the + generic syntax, requiring a uniform parsing algorithm in order to be + interpreted consistently. + +4.1. URI Reference + + URI-reference is used to denote the most common usage of a resource + identifier. + + URI-reference = URI / relative-ref + + + +Berners-Lee, et al. Standards Track [Page 25] + +RFC 3986 URI Generic Syntax January 2005 + + + A URI-reference is either a URI or a relative reference. If the + URI-reference's prefix does not match the syntax of a scheme followed + by its colon separator, then the URI-reference is a relative + reference. + + A URI-reference is typically parsed first into the five URI + components, in order to determine what components are present and + whether the reference is relative. Then, each component is parsed + for its subparts and their validation. The ABNF of URI-reference, + along with the "first-match-wins" disambiguation rule, is sufficient + to define a validating parser for the generic syntax. Readers + familiar with regular expressions should see Appendix B for an + example of a non-validating URI-reference parser that will take any + given string and extract the URI components. + +4.2. Relative Reference + + A relative reference takes advantage of the hierarchical syntax + (Section 1.2.3) to express a URI reference relative to the name space + of another hierarchical URI. + + relative-ref = relative-part [ "?" query ] [ "#" fragment ] + + relative-part = "//" authority path-abempty + / path-absolute + / path-noscheme + / path-empty + + The URI referred to by a relative reference, also known as the target + URI, is obtained by applying the reference resolution algorithm of + Section 5. + + A relative reference that begins with two slash characters is termed + a network-path reference; such references are rarely used. A + relative reference that begins with a single slash character is + termed an absolute-path reference. A relative reference that does + not begin with a slash character is termed a relative-path reference. + + A path segment that contains a colon character (e.g., "this:that") + cannot be used as the first segment of a relative-path reference, as + it would be mistaken for a scheme name. Such a segment must be + preceded by a dot-segment (e.g., "./this:that") to make a relative- + path reference. + + + + + + + + +Berners-Lee, et al. Standards Track [Page 26] + +RFC 3986 URI Generic Syntax January 2005 + + +4.3. Absolute URI + + Some protocol elements allow only the absolute form of a URI without + a fragment identifier. For example, defining a base URI for later + use by relative references calls for an absolute-URI syntax rule that + does not allow a fragment. + + absolute-URI = scheme ":" hier-part [ "?" query ] + + URI scheme specifications must define their own syntax so that all + strings matching their scheme-specific syntax will also match the + <absolute-URI> grammar. Scheme specifications will not define + fragment identifier syntax or usage, regardless of its applicability + to resources identifiable via that scheme, as fragment identification + is orthogonal to scheme definition. However, scheme specifications + are encouraged to include a wide range of examples, including + examples that show use of the scheme's URIs with fragment identifiers + when such usage is appropriate. + +4.4. Same-Document Reference + + When a URI reference refers to a URI that is, aside from its fragment + component (if any), identical to the base URI (Section 5.1), that + reference is called a "same-document" reference. The most frequent + examples of same-document references are relative references that are + empty or include only the number sign ("#") separator followed by a + fragment identifier. + + When a same-document reference is dereferenced for a retrieval + action, the target of that reference is defined to be within the same + entity (representation, document, or message) as the reference; + therefore, a dereference should not result in a new retrieval action. + + Normalization of the base and target URIs prior to their comparison, + as described in Sections 6.2.2 and 6.2.3, is allowed but rarely + performed in practice. Normalization may increase the set of same- + document references, which may be of benefit to some caching + applications. As such, reference authors should not assume that a + slightly different, though equivalent, reference URI will (or will + not) be interpreted as a same-document reference by any given + application. + +4.5. Suffix Reference + + The URI syntax is designed for unambiguous reference to resources and + extensibility via the URI scheme. However, as URI identification and + usage have become commonplace, traditional media (television, radio, + newspapers, billboards, etc.) have increasingly used a suffix of the + + + +Berners-Lee, et al. Standards Track [Page 27] + +RFC 3986 URI Generic Syntax January 2005 + + + URI as a reference, consisting of only the authority and path + portions of the URI, such as + + www.w3.org/Addressing/ + + or simply a DNS registered name on its own. Such references are + primarily intended for human interpretation rather than for machines, + with the assumption that context-based heuristics are sufficient to + complete the URI (e.g., most registered names beginning with "www" + are likely to have a URI prefix of "http://"). Although there is no + standard set of heuristics for disambiguating a URI suffix, many + client implementations allow them to be entered by the user and + heuristically resolved. + + Although this practice of using suffix references is common, it + should be avoided whenever possible and should never be used in + situations where long-term references are expected. The heuristics + noted above will change over time, particularly when a new URI scheme + becomes popular, and are often incorrect when used out of context. + Furthermore, they can lead to security issues along the lines of + those described in [RFC1535]. + + As a URI suffix has the same syntax as a relative-path reference, a + suffix reference cannot be used in contexts where a relative + reference is expected. As a result, suffix references are limited to + places where there is no defined base URI, such as dialog boxes and + off-line advertisements. + +5. Reference Resolution + + This section defines the process of resolving a URI reference within + a context that allows relative references so that the result is a + string matching the <URI> syntax rule of Section 3. + +5.1. Establishing a Base URI + + The term "relative" implies that a "base URI" exists against which + the relative reference is applied. Aside from fragment-only + references (Section 4.4), relative references are only usable when a + base URI is known. A base URI must be established by the parser + prior to parsing URI references that might be relative. A base URI + must conform to the <absolute-URI> syntax rule (Section 4.3). If the + base URI is obtained from a URI reference, then that reference must + be converted to absolute form and stripped of any fragment component + prior to its use as a base URI. + + + + + + +Berners-Lee, et al. Standards Track [Page 28] + +RFC 3986 URI Generic Syntax January 2005 + + + The base URI of a reference can be established in one of four ways, + discussed below in order of precedence. The order of precedence can + be thought of in terms of layers, where the innermost defined base + URI has the highest precedence. This can be visualized graphically + as follows: + + .----------------------------------------------------------. + | .----------------------------------------------------. | + | | .----------------------------------------------. | | + | | | .----------------------------------------. | | | + | | | | .----------------------------------. | | | | + | | | | | <relative-reference> | | | | | + | | | | `----------------------------------' | | | | + | | | | (5.1.1) Base URI embedded in content | | | | + | | | `----------------------------------------' | | | + | | | (5.1.2) Base URI of the encapsulating entity | | | + | | | (message, representation, or none) | | | + | | `----------------------------------------------' | | + | | (5.1.3) URI used to retrieve the entity | | + | `----------------------------------------------------' | + | (5.1.4) Default Base URI (application-dependent) | + `----------------------------------------------------------' + +5.1.1. Base URI Embedded in Content + + Within certain media types, a base URI for relative references can be + embedded within the content itself so that it can be readily obtained + by a parser. This can be useful for descriptive documents, such as + tables of contents, which may be transmitted to others through + protocols other than their usual retrieval context (e.g., email or + USENET news). + + It is beyond the scope of this specification to specify how, for each + media type, a base URI can be embedded. The appropriate syntax, when + available, is described by the data format specification associated + with each media type. + +5.1.2. Base URI from the Encapsulating Entity + + If no base URI is embedded, the base URI is defined by the + representation's retrieval context. For a document that is enclosed + within another entity, such as a message or archive, the retrieval + context is that entity. Thus, the default base URI of a + representation is the base URI of the entity in which the + representation is encapsulated. + + + + + + +Berners-Lee, et al. Standards Track [Page 29] + +RFC 3986 URI Generic Syntax January 2005 + + + A mechanism for embedding a base URI within MIME container types + (e.g., the message and multipart types) is defined by MHTML + [RFC2557]. Protocols that do not use the MIME message header syntax, + but that do allow some form of tagged metadata to be included within + messages, may define their own syntax for defining a base URI as part + of a message. + +5.1.3. Base URI from the Retrieval URI + + If no base URI is embedded and the representation is not encapsulated + within some other entity, then, if a URI was used to retrieve the + representation, that URI shall be considered the base URI. Note that + if the retrieval was the result of a redirected request, the last URI + used (i.e., the URI that resulted in the actual retrieval of the + representation) is the base URI. + +5.1.4. Default Base URI + + If none of the conditions described above apply, then the base URI is + defined by the context of the application. As this definition is + necessarily application-dependent, failing to define a base URI by + using one of the other methods may result in the same content being + interpreted differently by different types of applications. + + A sender of a representation containing relative references is + responsible for ensuring that a base URI for those references can be + established. Aside from fragment-only references, relative + references can only be used reliably in situations where the base URI + is well defined. + +5.2. Relative Resolution + + This section describes an algorithm for converting a URI reference + that might be relative to a given base URI into the parsed components + of the reference's target. The components can then be recomposed, as + described in Section 5.3, to form the target URI. This algorithm + provides definitive results that can be used to test the output of + other implementations. Applications may implement relative reference + resolution by using some other algorithm, provided that the results + match what would be given by this one. + + + + + + + + + + + +Berners-Lee, et al. Standards Track [Page 30] + +RFC 3986 URI Generic Syntax January 2005 + + +5.2.1. Pre-parse the Base URI + + The base URI (Base) is established according to the procedure of + Section 5.1 and parsed into the five main components described in + Section 3. Note that only the scheme component is required to be + present in a base URI; the other components may be empty or + undefined. A component is undefined if its associated delimiter does + not appear in the URI reference; the path component is never + undefined, though it may be empty. + + Normalization of the base URI, as described in Sections 6.2.2 and + 6.2.3, is optional. A URI reference must be transformed to its + target URI before it can be normalized. + +5.2.2. Transform References + + For each URI reference (R), the following pseudocode describes an + algorithm for transforming R into its target URI (T): + + -- The URI reference is parsed into the five URI components + -- + (R.scheme, R.authority, R.path, R.query, R.fragment) = parse(R); + + -- A non-strict parser may ignore a scheme in the reference + -- if it is identical to the base URI's scheme. + -- + if ((not strict) and (R.scheme == Base.scheme)) then + undefine(R.scheme); + endif; + + + + + + + + + + + + + + + + + + + + + + +Berners-Lee, et al. Standards Track [Page 31] + +RFC 3986 URI Generic Syntax January 2005 + + + if defined(R.scheme) then + T.scheme = R.scheme; + T.authority = R.authority; + T.path = remove_dot_segments(R.path); + T.query = R.query; + else + if defined(R.authority) then + T.authority = R.authority; + T.path = remove_dot_segments(R.path); + T.query = R.query; + else + if (R.path == "") then + T.path = Base.path; + if defined(R.query) then + T.query = R.query; + else + T.query = Base.query; + endif; + else + if (R.path starts-with "/") then + T.path = remove_dot_segments(R.path); + else + T.path = merge(Base.path, R.path); + T.path = remove_dot_segments(T.path); + endif; + T.query = R.query; + endif; + T.authority = Base.authority; + endif; + T.scheme = Base.scheme; + endif; + + T.fragment = R.fragment; + +5.2.3. Merge Paths + + The pseudocode above refers to a "merge" routine for merging a + relative-path reference with the path of the base URI. This is + accomplished as follows: + + o If the base URI has a defined authority component and an empty + path, then return a string consisting of "/" concatenated with the + reference's path; otherwise, + + + + + + + + +Berners-Lee, et al. Standards Track [Page 32] + +RFC 3986 URI Generic Syntax January 2005 + + + o return a string consisting of the reference's path component + appended to all but the last segment of the base URI's path (i.e., + excluding any characters after the right-most "/" in the base URI + path, or excluding the entire base URI path if it does not contain + any "/" characters). + +5.2.4. Remove Dot Segments + + The pseudocode also refers to a "remove_dot_segments" routine for + interpreting and removing the special "." and ".." complete path + segments from a referenced path. This is done after the path is + extracted from a reference, whether or not the path was relative, in + order to remove any invalid or extraneous dot-segments prior to + forming the target URI. Although there are many ways to accomplish + this removal process, we describe a simple method using two string + buffers. + + 1. The input buffer is initialized with the now-appended path + components and the output buffer is initialized to the empty + string. + + 2. While the input buffer is not empty, loop as follows: + + A. If the input buffer begins with a prefix of "../" or "./", + then remove that prefix from the input buffer; otherwise, + + B. if the input buffer begins with a prefix of "/./" or "/.", + where "." is a complete path segment, then replace that + prefix with "/" in the input buffer; otherwise, + + C. if the input buffer begins with a prefix of "/../" or "/..", + where ".." is a complete path segment, then replace that + prefix with "/" in the input buffer and remove the last + segment and its preceding "/" (if any) from the output + buffer; otherwise, + + D. if the input buffer consists only of "." or "..", then remove + that from the input buffer; otherwise, + + E. move the first path segment in the input buffer to the end of + the output buffer, including the initial "/" character (if + any) and any subsequent characters up to, but not including, + the next "/" character or the end of the input buffer. + + 3. Finally, the output buffer is returned as the result of + remove_dot_segments. + + + + + +Berners-Lee, et al. Standards Track [Page 33] + +RFC 3986 URI Generic Syntax January 2005 + + + Note that dot-segments are intended for use in URI references to + express an identifier relative to the hierarchy of names in the base + URI. The remove_dot_segments algorithm respects that hierarchy by + removing extra dot-segments rather than treat them as an error or + leaving them to be misinterpreted by dereference implementations. + + The following illustrates how the above steps are applied for two + examples of merged paths, showing the state of the two buffers after + each step. + + STEP OUTPUT BUFFER INPUT BUFFER + + 1 : /a/b/c/./../../g + 2E: /a /b/c/./../../g + 2E: /a/b /c/./../../g + 2E: /a/b/c /./../../g + 2B: /a/b/c /../../g + 2C: /a/b /../g + 2C: /a /g + 2E: /a/g + + STEP OUTPUT BUFFER INPUT BUFFER + + 1 : mid/content=5/../6 + 2E: mid /content=5/../6 + 2E: mid/content=5 /../6 + 2C: mid /6 + 2E: mid/6 + + Some applications may find it more efficient to implement the + remove_dot_segments algorithm by using two segment stacks rather than + strings. + + Note: Beware that some older, erroneous implementations will fail + to separate a reference's query component from its path component + prior to merging the base and reference paths, resulting in an + interoperability failure if the query component contains the + strings "/../" or "/./". + + + + + + + + + + + + + +Berners-Lee, et al. Standards Track [Page 34] + +RFC 3986 URI Generic Syntax January 2005 + + +5.3. Component Recomposition + + Parsed URI components can be recomposed to obtain the corresponding + URI reference string. Using pseudocode, this would be: + + result = "" + + if defined(scheme) then + append scheme to result; + append ":" to result; + endif; + + if defined(authority) then + append "//" to result; + append authority to result; + endif; + + append path to result; + + if defined(query) then + append "?" to result; + append query to result; + endif; + + if defined(fragment) then + append "#" to result; + append fragment to result; + endif; + + return result; + + Note that we are careful to preserve the distinction between a + component that is undefined, meaning that its separator was not + present in the reference, and a component that is empty, meaning that + the separator was present and was immediately followed by the next + component separator or the end of the reference. + +5.4. Reference Resolution Examples + + Within a representation with a well defined base URI of + + http://a/b/c/d;p?q + + a relative reference is transformed to its target URI as follows. + + + + + + + +Berners-Lee, et al. Standards Track [Page 35] + +RFC 3986 URI Generic Syntax January 2005 + + +5.4.1. Normal Examples + + "g:h" = "g:h" + "g" = "http://a/b/c/g" + "./g" = "http://a/b/c/g" + "g/" = "http://a/b/c/g/" + "/g" = "http://a/g" + "//g" = "http://g" + "?y" = "http://a/b/c/d;p?y" + "g?y" = "http://a/b/c/g?y" + "#s" = "http://a/b/c/d;p?q#s" + "g#s" = "http://a/b/c/g#s" + "g?y#s" = "http://a/b/c/g?y#s" + ";x" = "http://a/b/c/;x" + "g;x" = "http://a/b/c/g;x" + "g;x?y#s" = "http://a/b/c/g;x?y#s" + "" = "http://a/b/c/d;p?q" + "." = "http://a/b/c/" + "./" = "http://a/b/c/" + ".." = "http://a/b/" + "../" = "http://a/b/" + "../g" = "http://a/b/g" + "../.." = "http://a/" + "../../" = "http://a/" + "../../g" = "http://a/g" + +5.4.2. Abnormal Examples + + Although the following abnormal examples are unlikely to occur in + normal practice, all URI parsers should be capable of resolving them + consistently. Each example uses the same base as that above. + + Parsers must be careful in handling cases where there are more ".." + segments in a relative-path reference than there are hierarchical + levels in the base URI's path. Note that the ".." syntax cannot be + used to change the authority component of a URI. + + "../../../g" = "http://a/g" + "../../../../g" = "http://a/g" + + + + + + + + + + + + +Berners-Lee, et al. Standards Track [Page 36] + +RFC 3986 URI Generic Syntax January 2005 + + + Similarly, parsers must remove the dot-segments "." and ".." when + they are complete components of a path, but not when they are only + part of a segment. + + "/./g" = "http://a/g" + "/../g" = "http://a/g" + "g." = "http://a/b/c/g." + ".g" = "http://a/b/c/.g" + "g.." = "http://a/b/c/g.." + "..g" = "http://a/b/c/..g" + + Less likely are cases where the relative reference uses unnecessary + or nonsensical forms of the "." and ".." complete path segments. + + "./../g" = "http://a/b/g" + "./g/." = "http://a/b/c/g/" + "g/./h" = "http://a/b/c/g/h" + "g/../h" = "http://a/b/c/h" + "g;x=1/./y" = "http://a/b/c/g;x=1/y" + "g;x=1/../y" = "http://a/b/c/y" + + Some applications fail to separate the reference's query and/or + fragment components from the path component before merging it with + the base path and removing dot-segments. This error is rarely + noticed, as typical usage of a fragment never includes the hierarchy + ("/") character and the query component is not normally used within + relative references. + + "g?y/./x" = "http://a/b/c/g?y/./x" + "g?y/../x" = "http://a/b/c/g?y/../x" + "g#s/./x" = "http://a/b/c/g#s/./x" + "g#s/../x" = "http://a/b/c/g#s/../x" + + Some parsers allow the scheme name to be present in a relative + reference if it is the same as the base URI scheme. This is + considered to be a loophole in prior specifications of partial URI + [RFC1630]. Its use should be avoided but is allowed for backward + compatibility. + + "http:g" = "http:g" ; for strict parsers + / "http://a/b/c/g" ; for backward compatibility + + + + + + + + + + +Berners-Lee, et al. Standards Track [Page 37] + +RFC 3986 URI Generic Syntax January 2005 + + +6. Normalization and Comparison + + One of the most common operations on URIs is simple comparison: + determining whether two URIs are equivalent without using the URIs to + access their respective resource(s). A comparison is performed every + time a response cache is accessed, a browser checks its history to + color a link, or an XML parser processes tags within a namespace. + Extensive normalization prior to comparison of URIs is often used by + spiders and indexing engines to prune a search space or to reduce + duplication of request actions and response storage. + + URI comparison is performed for some particular purpose. Protocols + or implementations that compare URIs for different purposes will + often be subject to differing design trade-offs in regards to how + much effort should be spent in reducing aliased identifiers. This + section describes various methods that may be used to compare URIs, + the trade-offs between them, and the types of applications that might + use them. + +6.1. Equivalence + + Because URIs exist to identify resources, presumably they should be + considered equivalent when they identify the same resource. However, + this definition of equivalence is not of much practical use, as there + is no way for an implementation to compare two resources unless it + has full knowledge or control of them. For this reason, + determination of equivalence or difference of URIs is based on string + comparison, perhaps augmented by reference to additional rules + provided by URI scheme definitions. We use the terms "different" and + "equivalent" to describe the possible outcomes of such comparisons, + but there are many application-dependent versions of equivalence. + + Even though it is possible to determine that two URIs are equivalent, + URI comparison is not sufficient to determine whether two URIs + identify different resources. For example, an owner of two different + domain names could decide to serve the same resource from both, + resulting in two different URIs. Therefore, comparison methods are + designed to minimize false negatives while strictly avoiding false + positives. + + In testing for equivalence, applications should not directly compare + relative references; the references should be converted to their + respective target URIs before comparison. When URIs are compared to + select (or avoid) a network action, such as retrieval of a + representation, fragment components (if any) should be excluded from + the comparison. + + + + + +Berners-Lee, et al. Standards Track [Page 38] + +RFC 3986 URI Generic Syntax January 2005 + + +6.2. Comparison Ladder + + A variety of methods are used in practice to test URI equivalence. + These methods fall into a range, distinguished by the amount of + processing required and the degree to which the probability of false + negatives is reduced. As noted above, false negatives cannot be + eliminated. In practice, their probability can be reduced, but this + reduction requires more processing and is not cost-effective for all + applications. + + If this range of comparison practices is considered as a ladder, the + following discussion will climb the ladder, starting with practices + that are cheap but have a relatively higher chance of producing false + negatives, and proceeding to those that have higher computational + cost and lower risk of false negatives. + +6.2.1. Simple String Comparison + + If two URIs, when considered as character strings, are identical, + then it is safe to conclude that they are equivalent. This type of + equivalence test has very low computational cost and is in wide use + in a variety of applications, particularly in the domain of parsing. + + Testing strings for equivalence requires some basic precautions. + This procedure is often referred to as "bit-for-bit" or + "byte-for-byte" comparison, which is potentially misleading. Testing + strings for equality is normally based on pair comparison of the + characters that make up the strings, starting from the first and + proceeding until both strings are exhausted and all characters are + found to be equal, until a pair of characters compares unequal, or + until one of the strings is exhausted before the other. + + This character comparison requires that each pair of characters be + put in comparable form. For example, should one URI be stored in a + byte array in EBCDIC encoding and the second in a Java String object + (UTF-16), bit-for-bit comparisons applied naively will produce + errors. It is better to speak of equality on a character-for- + character basis rather than on a byte-for-byte or bit-for-bit basis. + In practical terms, character-by-character comparisons should be done + codepoint-by-codepoint after conversion to a common character + encoding. + + False negatives are caused by the production and use of URI aliases. + Unnecessary aliases can be reduced, regardless of the comparison + method, by consistently providing URI references in an already- + normalized form (i.e., a form identical to what would be produced + after normalization is applied, as described below). + + + + +Berners-Lee, et al. Standards Track [Page 39] + +RFC 3986 URI Generic Syntax January 2005 + + + Protocols and data formats often limit some URI comparisons to simple + string comparison, based on the theory that people and + implementations will, in their own best interest, be consistent in + providing URI references, or at least consistent enough to negate any + efficiency that might be obtained from further normalization. + +6.2.2. Syntax-Based Normalization + + Implementations may use logic based on the definitions provided by + this specification to reduce the probability of false negatives. + This processing is moderately higher in cost than character-for- + character string comparison. For example, an application using this + approach could reasonably consider the following two URIs equivalent: + + example://a/b/c/%7Bfoo%7D + eXAMPLE://a/./b/../b/%63/%7bfoo%7d + + Web user agents, such as browsers, typically apply this type of URI + normalization when determining whether a cached response is + available. Syntax-based normalization includes such techniques as + case normalization, percent-encoding normalization, and removal of + dot-segments. + +6.2.2.1. Case Normalization + + For all URIs, the hexadecimal digits within a percent-encoding + triplet (e.g., "%3a" versus "%3A") are case-insensitive and therefore + should be normalized to use uppercase letters for the digits A-F. + + When a URI uses components of the generic syntax, the component + syntax equivalence rules always apply; namely, that the scheme and + host are case-insensitive and therefore should be normalized to + lowercase. For example, the URI <HTTP://www.EXAMPLE.com/> is + equivalent to <http://www.example.com/>. The other generic syntax + components are assumed to be case-sensitive unless specifically + defined otherwise by the scheme (see Section 6.2.3). + +6.2.2.2. Percent-Encoding Normalization + + The percent-encoding mechanism (Section 2.1) is a frequent source of + variance among otherwise identical URIs. In addition to the case + normalization issue noted above, some URI producers percent-encode + octets that do not require percent-encoding, resulting in URIs that + are equivalent to their non-encoded counterparts. These URIs should + be normalized by decoding any percent-encoded octet that corresponds + to an unreserved character, as described in Section 2.3. + + + + + +Berners-Lee, et al. Standards Track [Page 40] + +RFC 3986 URI Generic Syntax January 2005 + + +6.2.2.3. Path Segment Normalization + + The complete path segments "." and ".." are intended only for use + within relative references (Section 4.1) and are removed as part of + the reference resolution process (Section 5.2). However, some + deployed implementations incorrectly assume that reference resolution + is not necessary when the reference is already a URI and thus fail to + remove dot-segments when they occur in non-relative paths. URI + normalizers should remove dot-segments by applying the + remove_dot_segments algorithm to the path, as described in + Section 5.2.4. + +6.2.3. Scheme-Based Normalization + + The syntax and semantics of URIs vary from scheme to scheme, as + described by the defining specification for each scheme. + Implementations may use scheme-specific rules, at further processing + cost, to reduce the probability of false negatives. For example, + because the "http" scheme makes use of an authority component, has a + default port of "80", and defines an empty path to be equivalent to + "/", the following four URIs are equivalent: + + http://example.com + http://example.com/ + http://example.com:/ + http://example.com:80/ + + In general, a URI that uses the generic syntax for authority with an + empty path should be normalized to a path of "/". Likewise, an + explicit ":port", for which the port is empty or the default for the + scheme, is equivalent to one where the port and its ":" delimiter are + elided and thus should be removed by scheme-based normalization. For + example, the second URI above is the normal form for the "http" + scheme. + + Another case where normalization varies by scheme is in the handling + of an empty authority component or empty host subcomponent. For many + scheme specifications, an empty authority or host is considered an + error; for others, it is considered equivalent to "localhost" or the + end-user's host. When a scheme defines a default for authority and a + URI reference to that default is desired, the reference should be + normalized to an empty authority for the sake of uniformity, brevity, + and internationalization. If, however, either the userinfo or port + subcomponents are non-empty, then the host should be given explicitly + even if it matches the default. + + Normalization should not remove delimiters when their associated + component is empty unless licensed to do so by the scheme + + + +Berners-Lee, et al. Standards Track [Page 41] + +RFC 3986 URI Generic Syntax January 2005 + + + specification. For example, the URI "http://example.com/?" cannot be + assumed to be equivalent to any of the examples above. Likewise, the + presence or absence of delimiters within a userinfo subcomponent is + usually significant to its interpretation. The fragment component is + not subject to any scheme-based normalization; thus, two URIs that + differ only by the suffix "#" are considered different regardless of + the scheme. + + Some schemes define additional subcomponents that consist of case- + insensitive data, giving an implicit license to normalizers to + convert this data to a common case (e.g., all lowercase). For + example, URI schemes that define a subcomponent of path to contain an + Internet hostname, such as the "mailto" URI scheme, cause that + subcomponent to be case-insensitive and thus subject to case + normalization (e.g., "mailto:[email protected]" is equivalent to + "mailto:[email protected]", even though the generic syntax considers + the path component to be case-sensitive). + + Other scheme-specific normalizations are possible. + +6.2.4. Protocol-Based Normalization + + Substantial effort to reduce the incidence of false negatives is + often cost-effective for web spiders. Therefore, they implement even + more aggressive techniques in URI comparison. For example, if they + observe that a URI such as + + http://example.com/data + + redirects to a URI differing only in the trailing slash + + http://example.com/data/ + + they will likely regard the two as equivalent in the future. This + kind of technique is only appropriate when equivalence is clearly + indicated by both the result of accessing the resources and the + common conventions of their scheme's dereference algorithm (in this + case, use of redirection by HTTP origin servers to avoid problems + with relative references). + + + + + + + + + + + + +Berners-Lee, et al. Standards Track [Page 42] + +RFC 3986 URI Generic Syntax January 2005 + + +7. Security Considerations + + A URI does not in itself pose a security threat. However, as URIs + are often used to provide a compact set of instructions for access to + network resources, care must be taken to properly interpret the data + within a URI, to prevent that data from causing unintended access, + and to avoid including data that should not be revealed in plain + text. + +7.1. Reliability and Consistency + + There is no guarantee that once a URI has been used to retrieve + information, the same information will be retrievable by that URI in + the future. Nor is there any guarantee that the information + retrievable via that URI in the future will be observably similar to + that retrieved in the past. The URI syntax does not constrain how a + given scheme or authority apportions its namespace or maintains it + over time. Such guarantees can only be obtained from the person(s) + controlling that namespace and the resource in question. A specific + URI scheme may define additional semantics, such as name persistence, + if those semantics are required of all naming authorities for that + scheme. + +7.2. Malicious Construction + + It is sometimes possible to construct a URI so that an attempt to + perform a seemingly harmless, idempotent operation, such as the + retrieval of a representation, will in fact cause a possibly damaging + remote operation. The unsafe URI is typically constructed by + specifying a port number other than that reserved for the network + protocol in question. The client unwittingly contacts a site running + a different protocol service, and data within the URI contains + instructions that, when interpreted according to this other protocol, + cause an unexpected operation. A frequent example of such abuse has + been the use of a protocol-based scheme with a port component of + "25", thereby fooling user agent software into sending an unintended + or impersonating message via an SMTP server. + + Applications should prevent dereference of a URI that specifies a TCP + port number within the "well-known port" range (0 - 1023) unless the + protocol being used to dereference that URI is compatible with the + protocol expected on that well-known port. Although IANA maintains a + registry of well-known ports, applications should make such + restrictions user-configurable to avoid preventing the deployment of + new services. + + + + + + +Berners-Lee, et al. Standards Track [Page 43] + +RFC 3986 URI Generic Syntax January 2005 + + + When a URI contains percent-encoded octets that match the delimiters + for a given resolution or dereference protocol (for example, CR and + LF characters for the TELNET protocol), these percent-encodings must + not be decoded before transmission across that protocol. Transfer of + the percent-encoding, which might violate the protocol, is less + harmful than allowing decoded octets to be interpreted as additional + operations or parameters, perhaps triggering an unexpected and + possibly harmful remote operation. + +7.3. Back-End Transcoding + + When a URI is dereferenced, the data within it is often parsed by + both the user agent and one or more servers. In HTTP, for example, a + typical user agent will parse a URI into its five major components, + access the authority's server, and send it the data within the + authority, path, and query components. A typical server will take + that information, parse the path into segments and the query into + key/value pairs, and then invoke implementation-specific handlers to + respond to the request. As a result, a common security concern for + server implementations that handle a URI, either as a whole or split + into separate components, is proper interpretation of the octet data + represented by the characters and percent-encodings within that URI. + + Percent-encoded octets must be decoded at some point during the + dereference process. Applications must split the URI into its + components and subcomponents prior to decoding the octets, as + otherwise the decoded octets might be mistaken for delimiters. + Security checks of the data within a URI should be applied after + decoding the octets. Note, however, that the "%00" percent-encoding + (NUL) may require special handling and should be rejected if the + application is not expecting to receive raw data within a component. + + Special care should be taken when the URI path interpretation process + involves the use of a back-end file system or related system + functions. File systems typically assign an operational meaning to + special characters, such as the "/", "\", ":", "[", and "]" + characters, and to special device names like ".", "..", "...", "aux", + "lpt", etc. In some cases, merely testing for the existence of such + a name will cause the operating system to pause or invoke unrelated + system calls, leading to significant security concerns regarding + denial of service and unintended data transfer. It would be + impossible for this specification to list all such significant + characters and device names. Implementers should research the + reserved names and characters for the types of storage device that + may be attached to their applications and restrict the use of data + obtained from URI components accordingly. + + + + + +Berners-Lee, et al. Standards Track [Page 44] + +RFC 3986 URI Generic Syntax January 2005 + + +7.4. Rare IP Address Formats + + Although the URI syntax for IPv4address only allows the common + dotted-decimal form of IPv4 address literal, many implementations + that process URIs make use of platform-dependent system routines, + such as gethostbyname() and inet_aton(), to translate the string + literal to an actual IP address. Unfortunately, such system routines + often allow and process a much larger set of formats than those + described in Section 3.2.2. + + For example, many implementations allow dotted forms of three + numbers, wherein the last part is interpreted as a 16-bit quantity + and placed in the right-most two bytes of the network address (e.g., + a Class B network). Likewise, a dotted form of two numbers means + that the last part is interpreted as a 24-bit quantity and placed in + the right-most three bytes of the network address (Class A), and a + single number (without dots) is interpreted as a 32-bit quantity and + stored directly in the network address. Adding further to the + confusion, some implementations allow each dotted part to be + interpreted as decimal, octal, or hexadecimal, as specified in the C + language (i.e., a leading 0x or 0X implies hexadecimal; a leading 0 + implies octal; otherwise, the number is interpreted as decimal). + + These additional IP address formats are not allowed in the URI syntax + due to differences between platform implementations. However, they + can become a security concern if an application attempts to filter + access to resources based on the IP address in string literal format. + If this filtering is performed, literals should be converted to + numeric form and filtered based on the numeric value, and not on a + prefix or suffix of the string form. + +7.5. Sensitive Information + + URI producers should not provide a URI that contains a username or + password that is intended to be secret. URIs are frequently + displayed by browsers, stored in clear text bookmarks, and logged by + user agent history and intermediary applications (proxies). A + password appearing within the userinfo component is deprecated and + should be considered an error (or simply ignored) except in those + rare cases where the 'password' parameter is intended to be public. + +7.6. Semantic Attacks + + Because the userinfo subcomponent is rarely used and appears before + the host in the authority component, it can be used to construct a + URI intended to mislead a human user by appearing to identify one + (trusted) naming authority while actually identifying a different + authority hidden behind the noise. For example + + + +Berners-Lee, et al. Standards Track [Page 45] + +RFC 3986 URI Generic Syntax January 2005 + + + ftp://cnn.example.com&[email protected]/top_story.htm + + might lead a human user to assume that the host is 'cnn.example.com', + whereas it is actually '10.0.0.1'. Note that a misleading userinfo + subcomponent could be much longer than the example above. + + A misleading URI, such as that above, is an attack on the user's + preconceived notions about the meaning of a URI rather than an attack + on the software itself. User agents may be able to reduce the impact + of such attacks by distinguishing the various components of the URI + when they are rendered, such as by using a different color or tone to + render userinfo if any is present, though there is no panacea. More + information on URI-based semantic attacks can be found in [Siedzik]. + +8. IANA Considerations + + URI scheme names, as defined by <scheme> in Section 3.1, form a + registered namespace that is managed by IANA according to the + procedures defined in [BCP35]. No IANA actions are required by this + document. + +9. Acknowledgements + + This specification is derived from RFC 2396 [RFC2396], RFC 1808 + [RFC1808], and RFC 1738 [RFC1738]; the acknowledgements in those + documents still apply. It also incorporates the update (with + corrections) for IPv6 literals in the host syntax, as defined by + Robert M. Hinden, Brian E. Carpenter, and Larry Masinter in + [RFC2732]. In addition, contributions by Gisle Aas, Reese Anschultz, + Daniel Barclay, Tim Bray, Mike Brown, Rob Cameron, Jeremy Carroll, + Dan Connolly, Adam M. Costello, John Cowan, Jason Diamond, Martin + Duerst, Stefan Eissing, Clive D.W. Feather, Al Gilman, Tony Hammond, + Elliotte Harold, Pat Hayes, Henry Holtzman, Ian B. Jacobs, Michael + Kay, John C. Klensin, Graham Klyne, Dan Kohn, Bruce Lilly, Andrew + Main, Dave McAlpin, Ira McDonald, Michael Mealling, Ray Merkert, + Stephen Pollei, Julian Reschke, Tomas Rokicki, Miles Sabin, Kai + Schaetzl, Mark Thomson, Ronald Tschalaer, Norm Walsh, Marc Warne, + Stuart Williams, and Henry Zongaro are gratefully acknowledged. + +10. References + +10.1. Normative References + + [ASCII] American National Standards Institute, "Coded Character + Set -- 7-bit American Standard Code for Information + Interchange", ANSI X3.4, 1986. + + + + + +Berners-Lee, et al. Standards Track [Page 46] + +RFC 3986 URI Generic Syntax January 2005 + + + [RFC2234] Crocker, D. and P. Overell, "Augmented BNF for Syntax + Specifications: ABNF", RFC 2234, November 1997. + + [STD63] Yergeau, F., "UTF-8, a transformation format of + ISO 10646", STD 63, RFC 3629, November 2003. + + [UCS] International Organization for Standardization, + "Information Technology - Universal Multiple-Octet Coded + Character Set (UCS)", ISO/IEC 10646:2003, December 2003. + +10.2. Informative References + + [BCP19] Freed, N. and J. Postel, "IANA Charset Registration + Procedures", BCP 19, RFC 2978, October 2000. + + [BCP35] Petke, R. and I. King, "Registration Procedures for URL + Scheme Names", BCP 35, RFC 2717, November 1999. + + [RFC0952] Harrenstien, K., Stahl, M., and E. Feinler, "DoD Internet + host table specification", RFC 952, October 1985. + + [RFC1034] Mockapetris, P., "Domain names - concepts and facilities", + STD 13, RFC 1034, November 1987. + + [RFC1123] Braden, R., "Requirements for Internet Hosts - Application + and Support", STD 3, RFC 1123, October 1989. + + [RFC1535] Gavron, E., "A Security Problem and Proposed Correction + With Widely Deployed DNS Software", RFC 1535, + October 1993. + + [RFC1630] Berners-Lee, T., "Universal Resource Identifiers in WWW: A + Unifying Syntax for the Expression of Names and Addresses + of Objects on the Network as used in the World-Wide Web", + RFC 1630, June 1994. + + [RFC1736] Kunze, J., "Functional Recommendations for Internet + Resource Locators", RFC 1736, February 1995. + + [RFC1737] Sollins, K. and L. Masinter, "Functional Requirements for + Uniform Resource Names", RFC 1737, December 1994. + + [RFC1738] Berners-Lee, T., Masinter, L., and M. McCahill, "Uniform + Resource Locators (URL)", RFC 1738, December 1994. + + [RFC1808] Fielding, R., "Relative Uniform Resource Locators", + RFC 1808, June 1995. + + + + +Berners-Lee, et al. Standards Track [Page 47] + +RFC 3986 URI Generic Syntax January 2005 + + + [RFC2046] Freed, N. and N. Borenstein, "Multipurpose Internet Mail + Extensions (MIME) Part Two: Media Types", RFC 2046, + November 1996. + + [RFC2141] Moats, R., "URN Syntax", RFC 2141, May 1997. + + [RFC2396] Berners-Lee, T., Fielding, R., and L. Masinter, "Uniform + Resource Identifiers (URI): Generic Syntax", RFC 2396, + August 1998. + + [RFC2518] Goland, Y., Whitehead, E., Faizi, A., Carter, S., and D. + Jensen, "HTTP Extensions for Distributed Authoring -- + WEBDAV", RFC 2518, February 1999. + + [RFC2557] Palme, J., Hopmann, A., and N. Shelness, "MIME + Encapsulation of Aggregate Documents, such as HTML + (MHTML)", RFC 2557, March 1999. + + [RFC2718] Masinter, L., Alvestrand, H., Zigmond, D., and R. Petke, + "Guidelines for new URL Schemes", RFC 2718, November 1999. + + [RFC2732] Hinden, R., Carpenter, B., and L. Masinter, "Format for + Literal IPv6 Addresses in URL's", RFC 2732, December 1999. + + [RFC3305] Mealling, M. and R. Denenberg, "Report from the Joint + W3C/IETF URI Planning Interest Group: Uniform Resource + Identifiers (URIs), URLs, and Uniform Resource Names + (URNs): Clarifications and Recommendations", RFC 3305, + August 2002. + + [RFC3490] Faltstrom, P., Hoffman, P., and A. Costello, + "Internationalizing Domain Names in Applications (IDNA)", + RFC 3490, March 2003. + + [RFC3513] Hinden, R. and S. Deering, "Internet Protocol Version 6 + (IPv6) Addressing Architecture", RFC 3513, April 2003. + + [Siedzik] Siedzik, R., "Semantic Attacks: What's in a URL?", + April 2001, <http://www.giac.org/practical/gsec/ + Richard_Siedzik_GSEC.pdf>. + + + + + + + + + + + +Berners-Lee, et al. Standards Track [Page 48] + +RFC 3986 URI Generic Syntax January 2005 + + +Appendix A. Collected ABNF for URI + + URI = scheme ":" hier-part [ "?" query ] [ "#" fragment ] + + hier-part = "//" authority path-abempty + / path-absolute + / path-rootless + / path-empty + + URI-reference = URI / relative-ref + + absolute-URI = scheme ":" hier-part [ "?" query ] + + relative-ref = relative-part [ "?" query ] [ "#" fragment ] + + relative-part = "//" authority path-abempty + / path-absolute + / path-noscheme + / path-empty + + scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." ) + + authority = [ userinfo "@" ] host [ ":" port ] + userinfo = *( unreserved / pct-encoded / sub-delims / ":" ) + host = IP-literal / IPv4address / reg-name + port = *DIGIT + + IP-literal = "[" ( IPv6address / IPvFuture ) "]" + + IPvFuture = "v" 1*HEXDIG "." 1*( unreserved / sub-delims / ":" ) + + IPv6address = 6( h16 ":" ) ls32 + / "::" 5( h16 ":" ) ls32 + / [ h16 ] "::" 4( h16 ":" ) ls32 + / [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32 + / [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32 + / [ *3( h16 ":" ) h16 ] "::" h16 ":" ls32 + / [ *4( h16 ":" ) h16 ] "::" ls32 + / [ *5( h16 ":" ) h16 ] "::" h16 + / [ *6( h16 ":" ) h16 ] "::" + + h16 = 1*4HEXDIG + ls32 = ( h16 ":" h16 ) / IPv4address + IPv4address = dec-octet "." dec-octet "." dec-octet "." dec-octet + + + + + + + +Berners-Lee, et al. Standards Track [Page 49] + +RFC 3986 URI Generic Syntax January 2005 + + + dec-octet = DIGIT ; 0-9 + / %x31-39 DIGIT ; 10-99 + / "1" 2DIGIT ; 100-199 + / "2" %x30-34 DIGIT ; 200-249 + / "25" %x30-35 ; 250-255 + + reg-name = *( unreserved / pct-encoded / sub-delims ) + + path = path-abempty ; begins with "/" or is empty + / path-absolute ; begins with "/" but not "//" + / path-noscheme ; begins with a non-colon segment + / path-rootless ; begins with a segment + / path-empty ; zero characters + + path-abempty = *( "/" segment ) + path-absolute = "/" [ segment-nz *( "/" segment ) ] + path-noscheme = segment-nz-nc *( "/" segment ) + path-rootless = segment-nz *( "/" segment ) + path-empty = 0<pchar> + + segment = *pchar + segment-nz = 1*pchar + segment-nz-nc = 1*( unreserved / pct-encoded / sub-delims / "@" ) + ; non-zero-length segment without any colon ":" + + pchar = unreserved / pct-encoded / sub-delims / ":" / "@" + + query = *( pchar / "/" / "?" ) + + fragment = *( pchar / "/" / "?" ) + + pct-encoded = "%" HEXDIG HEXDIG + + unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~" + reserved = gen-delims / sub-delims + gen-delims = ":" / "/" / "?" / "#" / "[" / "]" / "@" + sub-delims = "!" / "$" / "&" / "'" / "(" / ")" + / "*" / "+" / "," / ";" / "=" + +Appendix B. Parsing a URI Reference with a Regular Expression + + As the "first-match-wins" algorithm is identical to the "greedy" + disambiguation method used by POSIX regular expressions, it is + natural and commonplace to use a regular expression for parsing the + potential five components of a URI reference. + + The following line is the regular expression for breaking-down a + well-formed URI reference into its components. + + + +Berners-Lee, et al. Standards Track [Page 50] + +RFC 3986 URI Generic Syntax January 2005 + + + ^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\?([^#]*))?(#(.*))? + 12 3 4 5 6 7 8 9 + + The numbers in the second line above are only to assist readability; + they indicate the reference points for each subexpression (i.e., each + paired parenthesis). We refer to the value matched for subexpression + <n> as $<n>. For example, matching the above expression to + + http://www.ics.uci.edu/pub/ietf/uri/#Related + + results in the following subexpression matches: + + $1 = http: + $2 = http + $3 = //www.ics.uci.edu + $4 = www.ics.uci.edu + $5 = /pub/ietf/uri/ + $6 = <undefined> + $7 = <undefined> + $8 = #Related + $9 = Related + + where <undefined> indicates that the component is not present, as is + the case for the query component in the above example. Therefore, we + can determine the value of the five components as + + scheme = $2 + authority = $4 + path = $5 + query = $7 + fragment = $9 + + Going in the opposite direction, we can recreate a URI reference from + its components by using the algorithm of Section 5.3. + +Appendix C. Delimiting a URI in Context + + URIs are often transmitted through formats that do not provide a + clear context for their interpretation. For example, there are many + occasions when a URI is included in plain text; examples include text + sent in email, USENET news, and on printed paper. In such cases, it + is important to be able to delimit the URI from the rest of the text, + and in particular from punctuation marks that might be mistaken for + part of the URI. + + In practice, URIs are delimited in a variety of ways, but usually + within double-quotes "http://example.com/", angle brackets + <http://example.com/>, or just by using whitespace: + + + +Berners-Lee, et al. Standards Track [Page 51] + +RFC 3986 URI Generic Syntax January 2005 + + + http://example.com/ + + These wrappers do not form part of the URI. + + In some cases, extra whitespace (spaces, line-breaks, tabs, etc.) may + have to be added to break a long URI across lines. The whitespace + should be ignored when the URI is extracted. + + No whitespace should be introduced after a hyphen ("-") character. + Because some typesetters and printers may (erroneously) introduce a + hyphen at the end of line when breaking it, the interpreter of a URI + containing a line break immediately after a hyphen should ignore all + whitespace around the line break and should be aware that the hyphen + may or may not actually be part of the URI. + + Using <> angle brackets around each URI is especially recommended as + a delimiting style for a reference that contains embedded whitespace. + + The prefix "URL:" (with or without a trailing space) was formerly + recommended as a way to help distinguish a URI from other bracketed + designators, though it is not commonly used in practice and is no + longer recommended. + + For robustness, software that accepts user-typed URI should attempt + to recognize and strip both delimiters and embedded whitespace. + + For example, the text + + Yes, Jim, I found it under "http://www.w3.org/Addressing/", + but you can probably pick it up from <ftp://foo.example. + com/rfc/>. Note the warning in <http://www.ics.uci.edu/pub/ + ietf/uri/historical.html#WARNING>. + + contains the URI references + + http://www.w3.org/Addressing/ + ftp://foo.example.com/rfc/ + http://www.ics.uci.edu/pub/ietf/uri/historical.html#WARNING + + + + + + + + + + + + + +Berners-Lee, et al. Standards Track [Page 52] + +RFC 3986 URI Generic Syntax January 2005 + + +Appendix D. Changes from RFC 2396 + +D.1. Additions + + An ABNF rule for URI has been introduced to correspond to one common + usage of the term: an absolute URI with optional fragment. + + IPv6 (and later) literals have been added to the list of possible + identifiers for the host portion of an authority component, as + described by [RFC2732], with the addition of "[" and "]" to the + reserved set and a version flag to anticipate future versions of IP + literals. Square brackets are now specified as reserved within the + authority component and are not allowed outside their use as + delimiters for an IP literal within host. In order to make this + change without changing the technical definition of the path, query, + and fragment components, those rules were redefined to directly + specify the characters allowed. + + As [RFC2732] defers to [RFC3513] for definition of an IPv6 literal + address, which, unfortunately, lacks an ABNF description of + IPv6address, we created a new ABNF rule for IPv6address that matches + the text representations defined by Section 2.2 of [RFC3513]. + Likewise, the definition of IPv4address has been improved in order to + limit each decimal octet to the range 0-255. + + Section 6, on URI normalization and comparison, has been completely + rewritten and extended by using input from Tim Bray and discussion + within the W3C Technical Architecture Group. + +D.2. Modifications + + The ad-hoc BNF syntax of RFC 2396 has been replaced with the ABNF of + [RFC2234]. This change required all rule names that formerly + included underscore characters to be renamed with a dash instead. In + addition, a number of syntax rules have been eliminated or simplified + to make the overall grammar more comprehensible. Specifications that + refer to the obsolete grammar rules may be understood by replacing + those rules according to the following table: + + + + + + + + + + + + + +Berners-Lee, et al. Standards Track [Page 53] + +RFC 3986 URI Generic Syntax January 2005 + + + +----------------+--------------------------------------------------+ + | obsolete rule | translation | + +----------------+--------------------------------------------------+ + | absoluteURI | absolute-URI | + | relativeURI | relative-part [ "?" query ] | + | hier_part | ( "//" authority path-abempty / | + | | path-absolute ) [ "?" query ] | + | | | + | opaque_part | path-rootless [ "?" query ] | + | net_path | "//" authority path-abempty | + | abs_path | path-absolute | + | rel_path | path-rootless | + | rel_segment | segment-nz-nc | + | reg_name | reg-name | + | server | authority | + | hostport | host [ ":" port ] | + | hostname | reg-name | + | path_segments | path-abempty | + | param | *<pchar excluding ";"> | + | | | + | uric | unreserved / pct-encoded / ";" / "?" / ":" | + | | / "@" / "&" / "=" / "+" / "$" / "," / "/" | + | | | + | uric_no_slash | unreserved / pct-encoded / ";" / "?" / ":" | + | | / "@" / "&" / "=" / "+" / "$" / "," | + | | | + | mark | "-" / "_" / "." / "!" / "~" / "*" / "'" | + | | / "(" / ")" | + | | | + | escaped | pct-encoded | + | hex | HEXDIG | + | alphanum | ALPHA / DIGIT | + +----------------+--------------------------------------------------+ + + Use of the above obsolete rules for the definition of scheme-specific + syntax is deprecated. + + Section 2, on characters, has been rewritten to explain what + characters are reserved, when they are reserved, and why they are + reserved, even when they are not used as delimiters by the generic + syntax. The mark characters that are typically unsafe to decode, + including the exclamation mark ("!"), asterisk ("*"), single-quote + ("'"), and open and close parentheses ("(" and ")"), have been moved + to the reserved set in order to clarify the distinction between + reserved and unreserved and, hopefully, to answer the most common + question of scheme designers. Likewise, the section on + percent-encoded characters has been rewritten, and URI normalizers + are now given license to decode any percent-encoded octets + + + +Berners-Lee, et al. Standards Track [Page 54] + +RFC 3986 URI Generic Syntax January 2005 + + + corresponding to unreserved characters. In general, the terms + "escaped" and "unescaped" have been replaced with "percent-encoded" + and "decoded", respectively, to reduce confusion with other forms of + escape mechanisms. + + The ABNF for URI and URI-reference has been redesigned to make them + more friendly to LALR parsers and to reduce complexity. As a result, + the layout form of syntax description has been removed, along with + the uric, uric_no_slash, opaque_part, net_path, abs_path, rel_path, + path_segments, rel_segment, and mark rules. All references to + "opaque" URIs have been replaced with a better description of how the + path component may be opaque to hierarchy. The relativeURI rule has + been replaced with relative-ref to avoid unnecessary confusion over + whether they are a subset of URI. The ambiguity regarding the + parsing of URI-reference as a URI or a relative-ref with a colon in + the first segment has been eliminated through the use of five + separate path matching rules. + + The fragment identifier has been moved back into the section on + generic syntax components and within the URI and relative-ref rules, + though it remains excluded from absolute-URI. The number sign ("#") + character has been moved back to the reserved set as a result of + reintegrating the fragment syntax. + + The ABNF has been corrected to allow the path component to be empty. + This also allows an absolute-URI to consist of nothing after the + "scheme:", as is present in practice with the "dav:" namespace + [RFC2518] and with the "about:" scheme used internally by many WWW + browser implementations. The ambiguity regarding the boundary + between authority and path has been eliminated through the use of + five separate path matching rules. + + Registry-based naming authorities that use the generic syntax are now + defined within the host rule. This change allows current + implementations, where whatever name provided is simply fed to the + local name resolution mechanism, to be consistent with the + specification. It also removes the need to re-specify DNS name + formats here. Furthermore, it allows the host component to contain + percent-encoded octets, which is necessary to enable + internationalized domain names to be provided in URIs, processed in + their native character encodings at the application layers above URI + processing, and passed to an IDNA library as a registered name in the + UTF-8 character encoding. The server, hostport, hostname, + domainlabel, toplabel, and alphanum rules have been removed. + + The resolving relative references algorithm of [RFC2396] has been + rewritten with pseudocode for this revision to improve clarity and + fix the following issues: + + + +Berners-Lee, et al. Standards Track [Page 55] + +RFC 3986 URI Generic Syntax January 2005 + + + o [RFC2396] section 5.2, step 6a, failed to account for a base URI + with no path. + + o Restored the behavior of [RFC1808] where, if the reference + contains an empty path and a defined query component, the target + URI inherits the base URI's path component. + + o The determination of whether a URI reference is a same-document + reference has been decoupled from the URI parser, simplifying the + URI processing interface within applications in a way consistent + with the internal architecture of deployed URI processing + implementations. The determination is now based on comparison to + the base URI after transforming a reference to absolute form, + rather than on the format of the reference itself. This change + may result in more references being considered "same-document" + under this specification than there would be under the rules given + in RFC 2396, especially when normalization is used to reduce + aliases. However, it does not change the status of existing + same-document references. + + o Separated the path merge routine into two routines: merge, for + describing combination of the base URI path with a relative-path + reference, and remove_dot_segments, for describing how to remove + the special "." and ".." segments from a composed path. The + remove_dot_segments algorithm is now applied to all URI reference + paths in order to match common implementations and to improve the + normalization of URIs in practice. This change only impacts the + parsing of abnormal references and same-scheme references wherein + the base URI has a non-hierarchical path. + +Index + + A + ABNF 11 + absolute 27 + absolute-path 26 + absolute-URI 27 + access 9 + authority 17, 18 + + B + base URI 28 + + C + character encoding 4 + character 4 + characters 8, 11 + coded character set 4 + + + +Berners-Lee, et al. Standards Track [Page 56] + +RFC 3986 URI Generic Syntax January 2005 + + + D + dec-octet 20 + dereference 9 + dot-segments 23 + + F + fragment 16, 24 + + G + gen-delims 13 + generic syntax 6 + + H + h16 20 + hier-part 16 + hierarchical 10 + host 18 + + I + identifier 5 + IP-literal 19 + IPv4 20 + IPv4address 19, 20 + IPv6 19 + IPv6address 19, 20 + IPvFuture 19 + + L + locator 7 + ls32 20 + + M + merge 32 + + N + name 7 + network-path 26 + + P + path 16, 22, 26 + path-abempty 22 + path-absolute 22 + path-empty 22 + path-noscheme 22 + path-rootless 22 + path-abempty 16, 22, 26 + path-absolute 16, 22, 26 + path-empty 16, 22, 26 + + + +Berners-Lee, et al. Standards Track [Page 57] + +RFC 3986 URI Generic Syntax January 2005 + + + path-rootless 16, 22 + pchar 23 + pct-encoded 12 + percent-encoding 12 + port 22 + + Q + query 16, 23 + + R + reg-name 21 + registered name 20 + relative 10, 28 + relative-path 26 + relative-ref 26 + remove_dot_segments 33 + representation 9 + reserved 12 + resolution 9, 28 + resource 5 + retrieval 9 + + S + same-document 27 + sameness 9 + scheme 16, 17 + segment 22, 23 + segment-nz 23 + segment-nz-nc 23 + sub-delims 13 + suffix 27 + + T + transcription 8 + + U + uniform 4 + unreserved 13 + URI grammar + absolute-URI 27 + ALPHA 11 + authority 18 + CR 11 + dec-octet 20 + DIGIT 11 + DQUOTE 11 + fragment 24 + gen-delims 13 + + + +Berners-Lee, et al. Standards Track [Page 58] + +RFC 3986 URI Generic Syntax January 2005 + + + h16 20 + HEXDIG 11 + hier-part 16 + host 19 + IP-literal 19 + IPv4address 20 + IPv6address 20 + IPvFuture 19 + LF 11 + ls32 20 + OCTET 11 + path 22 + path-abempty 22 + path-absolute 22 + path-empty 22 + path-noscheme 22 + path-rootless 22 + pchar 23 + pct-encoded 12 + port 22 + query 24 + reg-name 21 + relative-ref 26 + reserved 13 + scheme 17 + segment 23 + segment-nz 23 + segment-nz-nc 23 + SP 11 + sub-delims 13 + unreserved 13 + URI 16 + URI-reference 25 + userinfo 18 + URI 16 + URI-reference 25 + URL 7 + URN 7 + userinfo 18 + + + + + + + + + + + + +Berners-Lee, et al. Standards Track [Page 59] + +RFC 3986 URI Generic Syntax January 2005 + + +Authors' Addresses + + Tim Berners-Lee + World Wide Web Consortium + Massachusetts Institute of Technology + 77 Massachusetts Avenue + Cambridge, MA 02139 + USA + + Phone: +1-617-253-5702 + Fax: +1-617-258-5999 + EMail: [email protected] + URI: http://www.w3.org/People/Berners-Lee/ + + + Roy T. Fielding + Day Software + 5251 California Ave., Suite 110 + Irvine, CA 92617 + USA + + Phone: +1-949-679-2960 + Fax: +1-949-679-2972 + EMail: [email protected] + URI: http://roy.gbiv.com/ + + + Larry Masinter + Adobe Systems Incorporated + 345 Park Ave + San Jose, CA 95110 + USA + + Phone: +1-408-536-3024 + EMail: [email protected] + URI: http://larry.masinter.net/ + + + + + + + + + + + + + + + +Berners-Lee, et al. Standards Track [Page 60] + +RFC 3986 URI Generic Syntax January 2005 + + +Full Copyright Statement + + Copyright (C) The Internet Society (2005). + + This document is subject to the rights, licenses and restrictions + contained in BCP 78, and except as set forth therein, the authors + retain all their rights. + + This document and the information contained herein are provided on an + "AS IS" basis and THE CONTRIBUTOR, THE ORGANIZATION HE/SHE REPRESENTS + OR IS SPONSORED BY (IF ANY), THE INTERNET SOCIETY AND THE INTERNET + ENGINEERING TASK FORCE DISCLAIM ALL WARRANTIES, EXPRESS OR IMPLIED, + INCLUDING BUT NOT LIMITED TO ANY WARRANTY THAT THE USE OF THE + INFORMATION HEREIN WILL NOT INFRINGE ANY RIGHTS OR ANY IMPLIED + WARRANTIES OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. + +Intellectual Property + + The IETF takes no position regarding the validity or scope of any + Intellectual Property Rights or other rights that might be claimed to + pertain to the implementation or use of the technology described in + this document or the extent to which any license under such rights + might or might not be available; nor does it represent that it has + made any independent effort to identify any such rights. Information + on the IETF's procedures with respect to rights in IETF Documents can + be found in BCP 78 and BCP 79. + + Copies of IPR disclosures made to the IETF Secretariat and any + assurances of licenses to be made available, or the result of an + attempt made to obtain a general license or permission for the use of + such proprietary rights by implementers or users of this + specification can be obtained from the IETF on-line IPR repository at + http://www.ietf.org/ipr. + + The IETF invites any interested party to bring to its attention any + copyrights, patents or patent applications, or other proprietary + rights that may cover technology that may be required to implement + this standard. Please address the information to the IETF at ietf- + + +Acknowledgement + + Funding for the RFC Editor function is currently provided by the + Internet Society. + + + + + + +Berners-Lee, et al. Standards Track [Page 61] + diff --git a/lib/inets/doc/src/Makefile b/lib/inets/doc/src/Makefile index e4cb0c4e48..82f2a5829f 100644 --- a/lib/inets/doc/src/Makefile +++ b/lib/inets/doc/src/Makefile @@ -26,16 +26,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk include ../../vsn.mk VSN=$(INETS_VSN) - -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -98,37 +88,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = \ - $(XML_PART_FILES:%.xml=%.tex) \ - $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_REF6_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -TOP_HTML_FILES = - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -141,8 +104,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man ldocs: local_docs @@ -156,33 +117,6 @@ html: gifs $(HTML_REF_MAN_FILE) clean clean_docs: clean_html clean_man clean_pdf rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(TOP_HTML_FILES) gifs - -clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - -clean: clean_tex clean_html clean_man - rm -f *.xmls_output *.xmls_errs - rm -f $(TOP_PDF_FILE) - rm -f errs core *~ -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -204,10 +138,7 @@ clean_man: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs - @echo "release_docs_spec(docs) when DOCSUPPORT=$DOCSUPPORT" $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf $(INSTALL_DIR) $(RELSYSDIR)/doc/html @@ -215,33 +146,6 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - @echo "release_docs_spec(pdf)" - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - @echo "release_docs_spec(ps)" - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - @echo "release_docs_spec(docs)" - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: diff --git a/lib/inets/doc/src/ftp.xml b/lib/inets/doc/src/ftp.xml index ca902d8d9d..f8f11ec705 100644 --- a/lib/inets/doc/src/ftp.xml +++ b/lib/inets/doc/src/ftp.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd"> <erlref> <header> <copyright> - <year>1997</year><year>2010</year> + <year>1997</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -141,11 +141,21 @@ <tag>{timeout, Timeout}</tag> <item> <marker id="timeout"></marker> - <p>Timeout = <c>integer() >= 0</c> </p> + <p>Timeout = <c>non_neg_integer()</c> </p> <p>Connection timeout. </p> <p>Default is 60000 (milliseconds). </p> </item> + <tag>{dtimeout, DTimeout}</tag> + <item> + <marker id="dtimeout"></marker> + <p>DTimeout = <c>non_neg_integer() | infinity</c> </p> + <p>Data Connect timeout. + The time the client will wait for the server to connect to the + data socket. </p> + <p>Default is infinity. </p> + </item> + <tag>{progress, Progress}</tag> <item> <marker id="progress"></marker> @@ -542,11 +552,12 @@ <v>verbose() = boolean() (defaults to false)</v> <v>debug() = disable | debug | trace (defaults to disable)</v> <!-- <v>open_options() = [open_option()]</v> --> - <v>open_option() = {ipfamily, ipfamily()} | {port, port()} | {mode, mode()} | {timeout, timeout()} | {progress, progress()}</v> + <v>open_option() = {ipfamily, ipfamily()} | {port, port()} | {mode, mode()} | {timeout, timeout()} | {dtimeout, dtimeout()} | {progress, progress()}</v> <v>ipfamily() = inet | inet6 | inet6fb4 (defaults to inet)</v> <v>port() = integer() > 0 (defaults to 21)</v> <v>mode() = active | passive (defaults to passive)</v> - <v>timeout() = integer() >= 0 (defaults to 60000 milliseconds)</v> + <v>timeout() = integer() > 0 (defaults to 60000 milliseconds)</v> + <v>dtimeout() = integer() > 0 | infinity (defaults to infinity)</v> <v>pogress() = ignore | {module(), function(), initial_data()} (defaults to ignore)</v> <v>module() = atom()</v> <v>function() = atom()</v> diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index d1671ac9bd..b1f964ae69 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -28,8 +28,10 @@ <date></date> <rev></rev> </header> + <module>httpc</module> <modulesummary>An HTTP/1.1 client </modulesummary> + <description> <p>This module provides the API to a HTTP/1.1 compatible client according to RFC 2616, caching is currently not supported.</p> @@ -167,7 +169,6 @@ filename() = string() <v>http_option() = {timeout, timeout()} | {connect_timeout, timeout()} | {ssl, ssloptions()} | - {ossl, ssloptions()} | {essl, ssloptions()} | {autoredirect, boolean()} | {proxy_auth, {userstring(), passwordstring()}} | @@ -206,6 +207,7 @@ filename() = string() to the <c>receiver</c> depending on that value. </p> <p>Http option (<c>http_option()</c>) details: </p> + <marker id="request2_http_options"></marker> <taglist> <tag><c><![CDATA[timeout]]></c></tag> <item> @@ -231,16 +233,9 @@ filename() = string() <p>Defaults to <c>[]</c>. </p> </item> - <tag><c><![CDATA[ossl]]></c></tag> - <item> - <p>If using the OpenSSL based (old) implementation of SSL, - these SSL-specific options are used. </p> - <p>Defaults to <c>[]</c>. </p> - </item> - <tag><c><![CDATA[essl]]></c></tag> <item> - <p>If using the Erlang based (new) implementation of SSL, + <p>If using the Erlang based implementation of SSL, these SSL-specific options are used. </p> <p>Defaults to <c>[]</c>. </p> </item> diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index edacb73b65..f88099a82e 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -148,13 +148,11 @@ in the apache like configuration file. </item> - <tag>{socket_type, ip_comm | ssl | ossl | essl}</tag> + <tag>{socket_type, ip_comm | ssl | essl}</tag> <item> - <p>When using ssl, there are several alternatives. - <c>ossl</c> specifically uses the OpenSSL based (old) SSL. - <c>essl</c> specifically uses the Erlang based (new) SSL. - When using <c>ssl</c> it <em>currently</em> defaults to - <c>essl</c>. </p> + <p>When using ssl, there are currently only one alternative. + <c>essl</c> specifically uses the Erlang based SSL. + <c>ssl</c> defaults to <c>essl</c>. </p> <p>Defaults to <c>ip_comm</c>. </p> </item> @@ -162,7 +160,7 @@ <item> <p>Defaults to <c>inet6fb4. </c> </p> <p>Note that this option is only used when the option - <c>socket_type</c> has the value <c>ip_comm</c>. </p> + <c>socket_type</c> has the value <c>ip_comm</c>. </p> </item> </taglist> diff --git a/lib/inets/doc/src/make.dep b/lib/inets/doc/src/make.dep deleted file mode 100644 index 8deb7e7a5a..0000000000 --- a/lib/inets/doc/src/make.dep +++ /dev/null @@ -1,47 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-2010. 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% -# -# - -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex ftp.tex ftp_client.tex httpc.tex http_client.tex \ - http_server.tex httpd.tex httpd_conf.tex httpd_socket.tex \ - httpd_util.tex inets.tex inets_services.tex \ - mod_alias.tex mod_auth.tex mod_esi.tex mod_security.tex \ - part.tex ref_man.tex tftp.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -ftp.tex: ../../../../system/doc/definitions/term.defs - -inets_services.tex: ../../../../system/doc/definitions/term.defs - diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index de934b91ea..59c2f8a2df 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -32,6 +32,73 @@ <file>notes.xml</file> </header> + <section><title>Inets 5.8</title> + + <section><title>Improvements and New Features</title> +<!-- + <p>-</p> +--> + + <list> + <item> + <p>[ftpc] Add a config option to specify a + <seealso marker="ftp#dtimeout">data connect timeout</seealso>. + That is how long the ftp client will wait for the server to connect + to the data socket. If this timeout occurs, an error will be + returned to the caller and the ftp client process will be + terminated. </p> + <p>Own Id: OTP-9545</p> + </item> + + </list> + + </section> + + <section><title>Fixed Bugs and Malfunctions</title> + <p>-</p> + +<!-- + <list> + <item> + <p>[httpc] Remove unnecessary usage of iolist_to_binary when + processing body (for PUT and POST). </p> + <p>Filipe David Manana</p> + <p>Own Id: OTP-9317</p> + </item> + + </list> +--> + + </section> + + <section> + <title>Incompatibilities</title> +<!-- + <p>-</p> +--> + + <list> + <item> + <p>[httpc] Deprecated interface module <c>http</c> has been removed. + It has (long) been replaced by http client interface module + <seealso marker="httpc#">httpc</seealso>. </p> + <p>Own Id: OTP-9359</p> + </item> + + <item> + <p>[httpc|httpd] The old ssl implementation (based on OpenSSL), + has been deprecated. The config option that specified usage of + this version of the ssl app, <c>ossl</c>, has been removed. </p> + <p>Own Id: OTP-9522</p> + </item> + + </list> + + </section> + + </section> <!-- 5.8 --> + + <section><title>Inets 5.7.2</title> <section><title>Improvements and New Features</title> <p>-</p> @@ -48,6 +115,31 @@ </section> + <section> + <title>Incompatibilities</title> +<!-- + <p>-</p> +--> + + <list> + <item> + <p>[httpc] Deprecated interface module <c>http</c> has been removed. + It has (long) been replaced by http client interface module + <seealso marker="httpc#">httpc</seealso>. </p> + <p>Own Id: OTP-9359</p> + </item> + + <item> + <p>[httpc|httpd] The old ssl implementation (based on OpenSSL), + has been deprecated. The config option that specified usage of + this version of the ssl app, <c>ossl</c>, has been removed. </p> + <p>Own Id: OTP-9522</p> + </item> + + </list> + + </section> + <section><title>Fixed Bugs and Malfunctions</title> <!-- <p>-</p> @@ -82,7 +174,7 @@ <list> <item> <p>[httpc|httpd] Added support for IPv6 with ssl. </p> - <p>Own Id: OTP-5566</p> + <p>Own Id: OTP-5566</p> </item> </list> @@ -98,24 +190,24 @@ <list> <item> <p>[httpc] Parsing of a cookie expire date should be more forgiving. - That is, if the parsing fails, the date should be ignored. - Also added support for (yet another) date format: - "Tue Jan 01 08:00:01 2036 GMT". </p> - <p>Own Id: OTP-9433</p> + That is, if the parsing fails, the date should be ignored. + Also added support for (yet another) date format: + "Tue Jan 01 08:00:01 2036 GMT". </p> + <p>Own Id: OTP-9433</p> </item> <item> <p>[httpc] Rewrote cookie parsing. Among other things solving - cookie processing from www.expedia.com. </p> - <p>Own Id: OTP-9434</p> + cookie processing from www.expedia.com. </p> + <p>Own Id: OTP-9434</p> </item> <item> <p>[httpd] Fix httpd directory traversal on Windows. - Directory traversal was possible on Windows where - backward slash is used as directory separator. </p> - <p>Andr�s Veres-Szentkir�lyi.</p> - <p>Own Id: OTP-9561</p> + Directory traversal was possible on Windows where + backward slash is used as directory separator. </p> + <p>Andr�s Veres-Szentkir�lyi.</p> + <p>Own Id: OTP-9561</p> </item> </list> @@ -1136,570 +1228,11 @@ </section> <!-- 5.1 --> + <!-- + <p>For information about older versions see + <url href="part_notes_history_frame.html">release notes history</url>.</p> + --> - <section><title>Inets 5.0.14</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [tftp] The callback watchdog has been removed, as it - turned out to be counter productive when the disk was - overloaded. Earlier a connection was aborted when a - callback (which performs the file access in the TFTP - server) took too long time.</p> - <p> - [tftp] The error message "Too many connections" has been - reclassified to be a warning.</p> - <p> - Own Id: OTP-7888</p> - </item> - </list> - </section> - - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p>[httpc] - Incorrect http version option check. </p> - <p>Mats Cronqvist</p> - <p>Own Id: OTP-7882</p> - </item> - - <item> - <p>[httpc] - Unnecessary error report when client - terminating as a result of the server closed the - socket unexpectedly. </p> - <p>Own Id: OTP-7883</p> - </item> - - <item> - <p>[httpc] - Failed transforming a relative URI to - an absolute URI. </p> - <p>[email protected]</p> - <p>Own Id: OTP-7950</p> - </item> - - <item> - <p>[httpd] - The HTTP server did not handle the config - option ssl_ca_certificate_file. </p> - <p>[email protected]</p> - <p>Own Id: OTP-7976</p> - </item> - - </list> - </section> - - </section> <!-- 5.0.14 --> - - - <section><title>Inets 5.0.13</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Ssl did not work correctly with the use of new style - configuration due to sn old internal format that was not - changed correctly in all places.</p> - <p> - Own Id: OTP-7723 Aux Id: seq11143 </p> - </item> - <item> - <p> - [httpc] - Now streams 200 and 206 results and not only - 200 results.</p> - <p> - Own Id: OTP-7857</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpc] - The inets http client will now use persistent - connections without pipelining as default and if a - pipeline timeout is set it will pipeline the requests on - the persistent connections.</p> - <p> - *** POTENTIAL INCOMPATIBILITY ***</p> - <p> - Own Id: OTP-7463</p> - </item> - <item> - <p> - [httpd] - added option ssl_password_callback_arguments.</p> - <p> - Own Id: OTP-7724 Aux Id: seq11151 </p> - </item> - <item> - <p> - Changed the socket use so that it will become more robust - to non-functional ipv6 and fallback on ipv4. This changes - may for very special os-configurations cause a problem - when used with erts-versions pre R13.</p> - <p> - Own Id: OTP-7726</p> - </item> - <item> - <p> - Removed deprecated function httpd_util:key1search/[2,3]</p> - <p> - Own Id: OTP-7815</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.12</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpd] - Updated inets so that it not uses the deprecated - function ssl:accept/[2,3].</p> - <p> - Own Id: OTP-7636 Aux Id: seq11086 </p> - </item> - </list> - </section> - - </section> - - - <section><title>Inets 5.0.11</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Transient bug related to hot code swap of the TFTP server is - now fixed. It could happen that the first TFTP server that was - started after a code upgrade to Inets-5.0.6 crashed with a - function clause error in tftp_engine:service_init/2.</p> - <p> Own Id: OTP-7574 Aux Id: seq11069 </p> - </item> - <item> - <p> - [httpd] - Validation of ssl_password_callback_module was - incorrect.</p> - <p> - Own Id: OTP-7597 Aux Id: seq11074 </p> - </item> - <item> - <p> - [httpd] - Misspelling in old apachelike configuration - directive TransferDiskLogSize has been corrected.</p> - <p> Own Id: OTP-7598 Aux Id: seq11059 </p> - </item> - <item> - <p> - Minor problems found by dialyzer has been fixed.</p> - <p> - Own Id: OTP-7605</p> - </item> - </list> - </section> - - </section> - -<section><title>Inets 5.0.10</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Enhanched an info report.</p> - <p> - Own Id: OTP-7450</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Changed errro message from - {wrong_type,{document_root,"/tmp/htdocs"}} to - {invalid_option,{non_existing, - document_root,"/tmp/htdocs"}}.</p> - <p> - Own Id: OTP-7454</p> - </item> - <item> - <p> - Relative paths in directory authentication did not work - as intended, this has now been fixed.</p> - <p> - Own Id: OTP-7490</p> - </item> - <item> - <p> - The query-string passed to the callback function was not - compliant with the documentation, it is now.</p> - <p> - Own Id: OTP-7512</p> - </item> - </list> - </section> - -</section> - - <section><title>Inets 5.0.9</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Parameters to error_logger:error_report/1 has been - corrected.</p> - <p> - Own Id: OTP-7257 Aux Id: OTP-7294, OTP-7258 </p> - </item> - <item> - <p> - [httpd] - If a Module/Function request matching an - erl_script_alias registration does not exist as a function in - the module registered a 404 error will now be issued instead of a - 500 error.</p> - <p> - Own Id: OTP-7323</p> - </item> - <item> - <p> - [httpd] -The option auth_type for mod_auth is no longer - mandatory, for backward-compatibility reasons.</p> - <p> - Own Id: OTP-7341</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.8</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - [httpd] - Spelling error caused client connection header - to be ignored.</p> - <p> - Own Id: OTP-7315 Aux Id: seq10951 </p> - </item> - <item> - <p> - [httpd] - Call to the function - mod_get:get_modification_date/1 was made too early - resulting in that httpd did not send the 404 file missing - response.</p> - <p> - Own Id: OTP-7321</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.7</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpc, httpd] - Now follows the recommendation regarding - line terminators in section 19.3 in RFC 2616 e.i: "The - line terminator for message-header fields is the sequence - CRLF. However, we recommend that applications, when - parsing such headers, recognize a single LF as a line - terminator and ignore the leading CR".</p> - <p> - Own Id: OTP-7304 Aux Id: seq10944 </p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.6</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [tftp] If a callback (which performs the file access in - the TFTP server) takes too long time (more than the - double TFTP timeout), the server will abort the - connection and send an error reply to the client. This - implies that the server will release resources attached - to the connection faster than before. The server simply - assumes that the client has given up.</p> - <p> - [tftp] If the TFTP server receives yet another request - from the same client (same host and port) while it - already has an active connection to the client, it will - simply ignore the new request if the request is equal - with the first one (same filename and options). This - implies that the (new) client will be served by the - already ongoing connection on the server side. By not - setting up yet another connection, in parallel with the - ongoing one, the server will consumer lesser resources.</p> - <p> - [tftp] netascii mode is now supported when the - client/server has native ascii support (Windows). The new - optional parameter native_ascii in the tftp_binary and - tftp_file callback modules can be used to override the - default behavior.</p> - <p> - [tftp] Yet another callback module has been added in - order to allow customized handling of error, warning and - info messages. See the new configuration parameter, - logger.</p> - <p> - [tftp] Yet another configuration parameter, max_retries, - has been added in order to control the number of times a - packet can be resent. The default is 5.</p> - <p> - [tftp] tftp:info/1 and tftp:change_config/2 can now be - applied to all daemons or all servers in one command - without bothering about their process identifiers.</p> - <p> - External TR HI89527.</p> - <p> - Own Id: OTP-7266</p> - </item> - </list> - </section> - -</section> - -<section><title>Inets 5.0.5</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [tftp] Blocks with too low block numbers are silently - discarded. For example if a server receives block #5 when - it expects block #7 it will discard the block without - interrupting the file transfer. Too high block numbers - does still imply an error. External TR HI96072.</p> - <p> - Own Id: OTP-7220</p> - </item> - <item> - <p> - [tftp] The problem with occasional case_clause errors in - tftp_engine:common_read/7 has been fixed. External TR - HI97362.</p> - <p> - Own Id: OTP-7221</p> - </item> - </list> - </section> - -</section> - - <section><title>Inets 5.0.4</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Changed calls to file open to concur with the API and not - use deprecated syntax.</p> - <p> - Own Id: OTP-7172</p> - </item> - <item> - <p> - [tftp] Server lost the first packet when the client timed - out</p> - <p> - Own Id: OTP-7173</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.3</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Updated copyright headers and fixed backwards - compatibility for an undocumented feature, for now. This - feature will later be removed and a new and documented - option will take its place.</p> - <p> - Own Id: OTP-7144</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.2</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpd] - Error logs now has a pretty and a compact - format and access logs can be written on the common log - format or the extended common log format.</p> - <p> - Own Id: OTP-6661 Aux Id: Seq 7764 </p> - </item> - <item> - <p> - [httpc] - Added acceptance of missing reason phrase to - the relaxed mode.</p> - <p> - Own Id: OTP-7024</p> - </item> - <item> - <p> - [httpc] - A new option has been added to enable the - client to act as lower version clients, by default the - client is an HTTP/1.1 client.</p> - <p> - Own Id: OTP-7043</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.1</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - [httpd] - Deprecated function httpd:start/1 did not - accept all inputs that it had done previously. This - should now work again.</p> - <p> - Own Id: OTP-7040</p> - </item> - </list> - </section> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpd] - Changed validity check on bind_address so that - it uses inet:getaddr instead of inet:gethostbyaddr as the - former puts a too hard restriction on the bind_address.</p> - <p> - Own Id: OTP-7041 Aux Id: seq10829 </p> - </item> - <item> - <p> - [httpc] - Internal process now does try-catch and - terminates normally in case of HTTP parse errors. - Semantical the client works just as before returning an - error message to the client, even if the error massage - has been enhanced, but there is no supervisor report in - the shell of a internal process crashing. (Which was the - expected behavior and not a fault.)</p> - <p> - Own Id: OTP-7042</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpd, httpc] - Deprecated base64 decode/encode - functions have been removed. Inets uses base64 in STDLIB - instead.</p> - <p> - *** POTENTIAL INCOMPATIBILITY ***</p> - <p> - Own Id: OTP-6485</p> - </item> - <item> - <p> - [httpd] - It is now possible to restrict the length of - acceptable URI:s in the HTTP server.</p> - <p> - Own Id: OTP-6572</p> - </item> - <item> - <p> - [httpc] - Profiles are now supported i.e. the options - available in set_options/1 can be set locally for a - certain profile and do not have to affect all - HTTP-requests issued in the Erlang node. Calls to the - HTTP client API functions not using the profile argument - will use the default profile.</p> - <p> - Own Id: OTP-6690</p> - </item> - <item> - <p> - A new uniform Inets interface provides a flexible way to - start/stop Inets services and get information about - running services. See inets(3). This also means that - inflexibilities in the HTTP server has been removed and - more default values has been added.</p> - <p> - Own Id: OTP-6705</p> - </item> - <item> - <p> - [tftp] Logged errors have been changed to be logged - warnings.</p> - <p> - Own Id: OTP-6916 Aux Id: seq10737 </p> - </item> - <item> - <p> - [httpc] - The client will now return the proper value - when receiving a HTTP 204 code instead of hanging.</p> - <p> - Own Id: OTP-6982</p> - </item> - <item> - <p> - The Inets application now has to be explicitly started - and stopped i.e. it will not automatically be started as - a temporary application as it did before. Although a - practical feature when testing things in the shell it is - not desirable that people take advantage of this and not - start the Inets application in a correct way in their - products. Added functions to the Inets API that call - application:start/stop.</p> - <p> - *** POTENTIAL INCOMPATIBILITY ***</p> - <p> - Own Id: OTP-6993</p> - </item> - </list> - </section> - - <!-- p>For information about older versions see - <url href="part_notes_history_frame.html">release notes history</url>.</p --> - </section> </chapter> diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl index ac72963347..b6da92947c 100644 --- a/lib/inets/src/ftp/ftp.erl +++ b/lib/inets/src/ftp/ftp.erl @@ -55,9 +55,10 @@ -include("ftp_internal.hrl"). %% Constante used in internal state definition --define(CONNECTION_TIMEOUT, 60*1000). --define(DEFAULT_MODE, passive). --define(PROGRESS_DEFAULT, ignore). +-define(CONNECTION_TIMEOUT, 60*1000). +-define(DATA_ACCEPT_TIMEOUT, infinity). +-define(DEFAULT_MODE, passive). +-define(PROGRESS_DEFAULT, ignore). %% Internal Constants -define(FTP_PORT, 21). @@ -88,7 +89,8 @@ %% data needed further on. caller = undefined, % term() ipfamily, % inet | inet6 | inet6fb4 - progress = ignore % ignore | pid() + progress = ignore, % ignore | pid() + dtimeout = ?DATA_ACCEPT_TIMEOUT % non_neg_integer() | infinity }). @@ -847,6 +849,7 @@ start_options(Options) -> %% host %% port %% timeout +%% dtimeout %% progress open_options(Options) -> ?fcrt("open_options", [{options, Options}]), @@ -875,7 +878,12 @@ open_options(Options) -> (_) -> false end, ValidateTimeout = - fun(Timeout) when is_integer(Timeout) andalso (Timeout > 0) -> true; + fun(Timeout) when is_integer(Timeout) andalso (Timeout >= 0) -> true; + (_) -> false + end, + ValidateDTimeout = + fun(DTimeout) when is_integer(DTimeout) andalso (DTimeout >= 0) -> true; + (infinity) -> true; (_) -> false end, ValidateProgress = @@ -893,6 +901,7 @@ open_options(Options) -> {port, ValidatePort, false, ?FTP_PORT}, {ipfamily, ValidateIpFamily, false, inet}, {timeout, ValidateTimeout, false, ?CONNECTION_TIMEOUT}, + {dtimeout, ValidateDTimeout, false, ?DATA_ACCEPT_TIMEOUT}, {progress, ValidateProgress, false, ?PROGRESS_DEFAULT}], validate_options(Options, ValidOptions, []). @@ -1037,13 +1046,15 @@ handle_call({_, {open, ip_comm, Opts}}, From, State) -> Mode = key_search(mode, Opts, ?DEFAULT_MODE), Port = key_search(port, Opts, ?FTP_PORT), Timeout = key_search(timeout, Opts, ?CONNECTION_TIMEOUT), + DTimeout = key_search(dtimeout, Opts, ?DATA_ACCEPT_TIMEOUT), Progress = key_search(progress, Opts, ignore), IpFamily = key_search(ipfamily, Opts, inet), - + State2 = State#state{client = From, mode = Mode, progress = progress(Progress), - ipfamily = IpFamily}, + ipfamily = IpFamily, + dtimeout = DTimeout}, ?fcrd("handle_call(open) -> setup ctrl connection with", [{host, Host}, {port, Port}, {timeout, Timeout}]), @@ -1064,11 +1075,13 @@ handle_call({_, {open, ip_comm, Host, Opts}}, From, State) -> Mode = key_search(mode, Opts, ?DEFAULT_MODE), Port = key_search(port, Opts, ?FTP_PORT), Timeout = key_search(timeout, Opts, ?CONNECTION_TIMEOUT), + DTimeout = key_search(dtimeout, Opts, ?DATA_ACCEPT_TIMEOUT), Progress = key_search(progress, Opts, ignore), State2 = State#state{client = From, mode = Mode, - progress = progress(Progress)}, + progress = progress(Progress), + dtimeout = DTimeout}, case setup_ctrl_connection(Host, Port, Timeout, State2) of {ok, State3, WaitTimeout} -> @@ -1657,9 +1670,19 @@ handle_ctrl_result({pos_compl, Lines}, %%-------------------------------------------------------------------------- %% Directory listing handle_ctrl_result({pos_prel, _}, #state{caller = {dir, Dir}} = State) -> - NewState = accept_data_connection(State), - activate_data_connection(NewState), - {noreply, NewState#state{caller = {handle_dir_result, Dir}}}; + case accept_data_connection(State) of + {ok, NewState} -> + activate_data_connection(NewState), + {noreply, NewState#state{caller = {handle_dir_result, Dir}}}; + {error, _Reason} = ERROR -> + case State#state.client of + undefined -> + {stop, ERROR, State}; + From -> + gen_server:reply(From, ERROR), + {stop, normal, State#state{client = undefined}} + end + end; handle_ctrl_result({pos_compl, _}, #state{caller = {handle_dir_result, Dir, Data}, client = From} @@ -1756,9 +1779,19 @@ handle_ctrl_result({Status, _}, %%-------------------------------------------------------------------------- %% File handling - recv_bin handle_ctrl_result({pos_prel, _}, #state{caller = recv_bin} = State) -> - NewState = accept_data_connection(State), - activate_data_connection(NewState), - {noreply, NewState}; + case accept_data_connection(State) of + {ok, NewState} -> + activate_data_connection(NewState), + {noreply, NewState}; + {error, _Reason} = ERROR -> + case State#state.client of + undefined -> + {stop, ERROR, State}; + From -> + gen_server:reply(From, ERROR), + {stop, normal, State#state{client = undefined}} + end + end; handle_ctrl_result({pos_compl, _}, #state{caller = {recv_bin, Data}, client = From} = State) -> @@ -1780,16 +1813,37 @@ handle_ctrl_result({Status, _}, #state{caller = {recv_bin, _}} = State) -> handle_ctrl_result({pos_prel, _}, #state{client = From, caller = start_chunk_transfer} = State) -> - NewState = accept_data_connection(State), - gen_server:reply(From, ok), - {noreply, NewState#state{chunk = true, client = undefined, - caller = undefined}}; + case accept_data_connection(State) of + {ok, NewState} -> + gen_server:reply(From, ok), + {noreply, NewState#state{chunk = true, client = undefined, + caller = undefined}}; + {error, _Reason} = ERROR -> + case State#state.client of + undefined -> + {stop, ERROR, State}; + From -> + gen_server:reply(From, ERROR), + {stop, normal, State#state{client = undefined}} + end + end; + %%-------------------------------------------------------------------------- %% File handling - recv_file handle_ctrl_result({pos_prel, _}, #state{caller = {recv_file, _}} = State) -> - NewState = accept_data_connection(State), - activate_data_connection(NewState), - {noreply, NewState}; + case accept_data_connection(State) of + {ok, NewState} -> + activate_data_connection(NewState), + {noreply, NewState}; + {error, _Reason} = ERROR -> + case State#state.client of + undefined -> + {stop, ERROR, State}; + From -> + gen_server:reply(From, ERROR), + {stop, normal, State#state{client = undefined}} + end + end; handle_ctrl_result({Status, _}, #state{caller = {recv_file, Fd}} = State) -> file_close(Fd), @@ -1800,17 +1854,38 @@ handle_ctrl_result({Status, _}, #state{caller = {recv_file, Fd}} = State) -> %% File handling - transfer_* handle_ctrl_result({pos_prel, _}, #state{caller = {transfer_file, Fd}} = State) -> - NewState = accept_data_connection(State), - send_file(Fd, NewState); + case accept_data_connection(State) of + {ok, NewState} -> + send_file(Fd, NewState); + {error, _Reason} = ERROR -> + case State#state.client of + undefined -> + {stop, ERROR, State}; + From -> + gen_server:reply(From, ERROR), + {stop, normal, State#state{client = undefined}} + end + end; handle_ctrl_result({pos_prel, _}, #state{caller = {transfer_data, Bin}} = State) -> - NewState = accept_data_connection(State), - send_data_message(NewState, Bin), - close_data_connection(NewState), - activate_ctrl_connection(NewState), - {noreply, NewState#state{caller = transfer_data_second_phase, - dsock = undefined}}; + case accept_data_connection(State) of + {ok, NewState} -> + send_data_message(NewState, Bin), + close_data_connection(NewState), + activate_ctrl_connection(NewState), + {noreply, NewState#state{caller = transfer_data_second_phase, + dsock = undefined}}; + {error, _Reason} = ERROR -> + case State#state.client of + undefined -> + {stop, ERROR, State}; + From -> + gen_server:reply(From, ERROR), + {stop, normal, State#state{client = undefined}} + end + end; + %%-------------------------------------------------------------------------- %% Default handle_ctrl_result({Status, Lines}, #state{client = From} = State) @@ -2009,16 +2084,20 @@ connect2(Host, Port, IpFam, Timeout) -> Error end. - -accept_data_connection(#state{mode = active, - dsock = {lsock, LSock}} = State) -> - {ok, Socket} = gen_tcp:accept(LSock), - gen_tcp:close(LSock), - State#state{dsock = Socket}; +accept_data_connection(#state{mode = active, + dtimeout = DTimeout, + dsock = {lsock, LSock}} = State) -> + case gen_tcp:accept(LSock, DTimeout) of + {ok, Socket} -> + gen_tcp:close(LSock), + {ok, State#state{dsock = Socket}}; + {error, Reason} -> + {error, {data_connect_failed, Reason}} + end; accept_data_connection(#state{mode = passive} = State) -> - State. + {ok, State}. send_ctrl_message(#state{csock = Socket, verbose = Verbose}, Message) -> %% io:format("send control message: ~n~p~n", [lists:flatten(Message)]), diff --git a/lib/inets/src/http_client/Makefile b/lib/inets/src/http_client/Makefile index 0397b48ab2..3960c36d00 100644 --- a/lib/inets/src/http_client/Makefile +++ b/lib/inets/src/http_client/Makefile @@ -41,7 +41,6 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- MODULES = \ - http \ httpc \ httpc_cookie \ httpc_handler \ diff --git a/lib/inets/src/http_client/http.erl b/lib/inets/src/http_client/http.erl deleted file mode 100644 index bbe2fec267..0000000000 --- a/lib/inets/src/http_client/http.erl +++ /dev/null @@ -1,132 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2010. 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% -%% -%% - -%%% Description: OLD API MODULE - USE httpc INSTEAD - --module(http). - --deprecated({request, 1, next_major_release}). --deprecated({request, 2, next_major_release}). --deprecated({request, 4, next_major_release}). --deprecated({request, 5, next_major_release}). --deprecated({cancel_request, 1, next_major_release}). --deprecated({cancel_request, 2, next_major_release}). --deprecated({set_option, 2, next_major_release}). --deprecated({set_option, 3, next_major_release}). --deprecated({set_options, 1, next_major_release}). --deprecated({set_options, 2, next_major_release}). --deprecated({verify_cookies, 2, next_major_release}). --deprecated({verify_cookies, 3, next_major_release}). --deprecated({cookie_header, 1, next_major_release}). --deprecated({cookie_header, 2, next_major_release}). --deprecated({stream_next, 1, next_major_release}). --deprecated({default_profile, 0, next_major_release}). - -%% Deprecated --export([ - request/1, request/2, request/4, request/5, - cancel_request/1, cancel_request/2, - set_option/2, set_option/3, - set_options/1, set_options/2, - verify_cookies/2, verify_cookies/3, - cookie_header/1, cookie_header/2, - stream_next/1, - default_profile/0 - ]). - - -%%%========================================================================= -%%% API -%%%========================================================================= - -%%-------------------------------------------------------------------------- -%% request(Url [, Profile]) -> -%% request(Method, Request, HTTPOptions, Options [, Profile]) -%%-------------------------------------------------------------------------- - -request(Url) -> httpc:request(Url). -request(Url, Profile) -> httpc:request(Url, Profile). - -request(Method, Request, HttpOptions, Options) -> - httpc:request(Method, Request, HttpOptions, Options). -request(Method, Request, HttpOptions, Options, Profile) -> - httpc:request(Method, Request, HttpOptions, Options, Profile). - - -%%-------------------------------------------------------------------------- -%% cancel_request(RequestId [, Profile]) -%%------------------------------------------------------------------------- - -cancel_request(RequestId) -> - httpc:cancel_request(RequestId). -cancel_request(RequestId, Profile) -> - httpc:cancel_request(RequestId, Profile). - - -%%-------------------------------------------------------------------------- -%% set_options(Options [, Profile]) -%% set_option(Key, Value [, Profile]) -%%------------------------------------------------------------------------- - -set_options(Options) -> - httpc:set_options(Options). -set_options(Options, Profile) -> - httpc:set_options(Options, Profile). - -set_option(Key, Value) -> - httpc:set_option(Key, Value). -set_option(Key, Value, Profile) -> - httpc:set_option(Key, Value, Profile). - - -%%-------------------------------------------------------------------------- -%% verify_cookies(SetCookieHeaders, Url [, Profile]) -%%------------------------------------------------------------------------- - -verify_cookies(SetCookieHeaders, Url) -> - httpc:store_cookies(SetCookieHeaders, Url). -verify_cookies(SetCookieHeaders, Url, Profile) -> - httpc:store_cookies(SetCookieHeaders, Url, Profile). - - -%%-------------------------------------------------------------------------- -%% cookie_header(Url [, Profile]) -%%------------------------------------------------------------------------- - -cookie_header(Url) -> - httpc:cookie_header(Url). -cookie_header(Url, Profile) -> - httpc:cookie_header(Url, Profile). - - -%%-------------------------------------------------------------------------- -%% stream_next(Pid) -%%------------------------------------------------------------------------- - -stream_next(Pid) -> - httpc:stream_next(Pid). - - -%%-------------------------------------------------------------------------- -%% default_profile() -%%------------------------------------------------------------------------- - -default_profile() -> - httpc:default_profile(). diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index fe8e93af1f..d72c34fa6b 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -105,7 +105,6 @@ request(Url, Profile) -> %% {ssl, SSLOptions} | {proxy_auth, {User, Password}} %% Ssloptions = ssl_options() | %% {ssl, ssl_options()} | -%% {ossl, ssl_options()} | %% {essl, ssl_options()} %% ssl_options() = [ssl_option()] %% ssl_option() = {verify, code()} | @@ -142,7 +141,9 @@ request(Url, Profile) -> request(Method, Request, HttpOptions, Options) -> request(Method, Request, HttpOptions, Options, default_profile()). -request(Method, {Url, Headers}, HTTPOptions, Options, Profile) +request(Method, + {Url, Headers}, + HTTPOptions, Options, Profile) when (Method =:= options) orelse (Method =:= get) orelse (Method =:= head) orelse @@ -155,15 +156,17 @@ request(Method, {Url, Headers}, HTTPOptions, Options, Profile) {http_options, HTTPOptions}, {options, Options}, {profile, Profile}]), - case http_uri:parse(Url) of + case http_uri:parse(Url, Options) of {error, Reason} -> {error, Reason}; - ParsedUrl -> + {ok, ParsedUrl} -> handle_request(Method, Url, ParsedUrl, Headers, [], [], HTTPOptions, Options, Profile) end; -request(Method, {Url,Headers,ContentType,Body}, HTTPOptions, Options, Profile) +request(Method, + {Url, Headers, ContentType, Body}, + HTTPOptions, Options, Profile) when ((Method =:= post) orelse (Method =:= put)) andalso (is_atom(Profile) orelse is_pid(Profile)) -> ?hcrt("request", [{method, Method}, @@ -174,10 +177,10 @@ request(Method, {Url,Headers,ContentType,Body}, HTTPOptions, Options, Profile) {http_options, HTTPOptions}, {options, Options}, {profile, Profile}]), - case http_uri:parse(Url) of + case http_uri:parse(Url, Options) of {error, Reason} -> {error, Reason}; - ParsedUrl -> + {ok, ParsedUrl} -> handle_request(Method, Url, ParsedUrl, Headers, ContentType, Body, HTTPOptions, Options, Profile) @@ -268,7 +271,10 @@ store_cookies(SetCookieHeaders, Url, Profile) {profile, Profile}]), try begin - {_, _, Host, Port, Path, _} = http_uri:parse(Url), + %% Since the Address part is not actually used + %% by the manager when storing cookies, we dont + %% care about ipv6-host-with-brackets. + {ok, {_, _, Host, Port, Path, _}} = http_uri:parse(Url), Address = {Host, Port}, ProfileName = profile_name(Profile), Cookies = httpc_cookie:cookies(SetCookieHeaders, Path, Host), @@ -465,6 +471,8 @@ handle_request(Method, Url, HeadersRecord = header_record(NewHeaders, Host2, HTTPOptions), Receiver = proplists:get_value(receiver, Options), SocketOpts = proplists:get_value(socket_opts, Options), + BracketedHost = proplists:get_value(ipv6_host_with_brackets, + Options), MaybeEscPath = maybe_encode_uri(HTTPOptions, Path), MaybeEscQuery = maybe_encode_uri(HTTPOptions, Query), AbsUri = maybe_encode_uri(HTTPOptions, Url), @@ -483,7 +491,8 @@ handle_request(Method, Url, stream = Stream, headers_as_is = headers_as_is(Headers0, Options), socket_opts = SocketOpts, - started = Started}, + started = Started, + ipv6_host_with_brackets = BracketedHost}, case httpc_manager:request(Request, profile_name(Profile)) of {ok, RequestId} -> @@ -644,8 +653,6 @@ http_options_default() -> {ok, {?HTTP_DEFAULT_SSL_KIND, Value}}; ({ssl, SslOptions}) when is_list(SslOptions) -> {ok, {?HTTP_DEFAULT_SSL_KIND, SslOptions}}; - ({ossl, SslOptions}) when is_list(SslOptions) -> - {ok, {ossl, SslOptions}}; ({essl, SslOptions}) when is_list(SslOptions) -> {ok, {essl, SslOptions}}; (_) -> @@ -742,14 +749,17 @@ request_options_defaults() -> error end, + VerifyBrackets = VerifyBoolean, + [ - {sync, true, VerifySync}, - {stream, none, VerifyStream}, - {body_format, string, VerifyBodyFormat}, - {full_result, true, VerifyFullResult}, - {headers_as_is, false, VerifyHeaderAsIs}, - {receiver, self(), VerifyReceiver}, - {socket_opts, undefined, VerifySocketOpts} + {sync, true, VerifySync}, + {stream, none, VerifyStream}, + {body_format, string, VerifyBodyFormat}, + {full_result, true, VerifyFullResult}, + {headers_as_is, false, VerifyHeaderAsIs}, + {receiver, self(), VerifyReceiver}, + {socket_opts, undefined, VerifySocketOpts}, + {ipv6_host_with_brackets, false, VerifyBrackets} ]. request_options(Options) -> diff --git a/lib/inets/src/http_client/httpc_internal.hrl b/lib/inets/src/http_client/httpc_internal.hrl index 1d8a5b6a92..e4127d992d 100644 --- a/lib/inets/src/http_client/httpc_internal.hrl +++ b/lib/inets/src/http_client/httpc_internal.hrl @@ -90,25 +90,28 @@ %%% All data associated to a specific HTTP request -record(request, { - id, % ref() - Request Id - from, % pid() - Caller - redircount = 0,% Number of redirects made for this request - scheme, % http | https - address, % ({Host,Port}) Destination Host and Port - path, % string() - Path of parsed URL - pquery, % string() - Rest of parsed URL - method, % atom() - HTTP request Method - headers, % #http_request_h{} - content, % {ContentType, Body} - Current HTTP request - settings, % #http_options{} - User defined settings - abs_uri, % string() ex: "http://www.erlang.org" - userinfo, % string() - optinal "<userinfo>@<host>:<port>" - stream, % Boolean() - stream async reply? - headers_as_is, % Boolean() - workaround for servers that does - % not honor the http standard, can also be used for testing purposes. - started, % integer() > 0 - When we started processing the request - timer, % undefined | ref() - socket_opts % undefined | [socket_option()] + id, % ref() - Request Id + from, % pid() - Caller + redircount = 0,% Number of redirects made for this request + scheme, % http | https + address, % ({Host,Port}) Destination Host and Port + path, % string() - Path of parsed URL + pquery, % string() - Rest of parsed URL + method, % atom() - HTTP request Method + headers, % #http_request_h{} + content, % {ContentType, Body} - Current HTTP request + settings, % #http_options{} - User defined settings + abs_uri, % string() ex: "http://www.erlang.org" + userinfo, % string() - optinal "<userinfo>@<host>:<port>" + stream, % boolean() - stream async reply? + headers_as_is, % boolean() - workaround for servers that does + % not honor the http standard, can also be used + % for testing purposes. + started, % integer() > 0 - When we started processing the + % request + timer, % undefined | ref() + socket_opts, % undefined | [socket_option()] + ipv6_host_with_brackets % boolean() } ). diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index 9015bf1ce2..ab575d867e 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -256,19 +256,27 @@ reset_cookies(ProfileName) -> %%-------------------------------------------------------------------- -%% Function: which_cookies(Url, ProfileName) -> [cookie()] +%% Function: which_cookies(ProfileName) -> [cookie()] +%% which_cookies(Url, ProfileName) -> [cookie()] +%% which_cookies(Url, Options, ProfileName) -> [cookie()] %% %% Url = string() +%% Options = [option()] %% ProfileName = atom() +%% option() = {ipv6_host_with_brackets, boolean()} %% %% Description: Retrieves the cookies that would be sent when %% requesting <Url>. %%-------------------------------------------------------------------- -which_cookies(ProfileName) -> +which_cookies(ProfileName) when is_atom(ProfileName) -> call(ProfileName, which_cookies). -which_cookies(Url, ProfileName) -> - call(ProfileName, {which_cookies, Url}). +which_cookies(Url, ProfileName) + when is_list(Url) andalso is_atom(ProfileName) -> + call(ProfileName, {which_cookies, Url, []}). +which_cookies(Url, Options, ProfileName) + when is_list(Url) andalso is_list(Options) andalso is_atom(ProfileName) -> + call(ProfileName, {which_cookies, Url, Options}). %%-------------------------------------------------------------------- @@ -395,15 +403,16 @@ handle_call(which_cookies, _, #state{cookie_db = CookieDb} = State) -> CookieHeaders = httpc_cookie:which_cookies(CookieDb), {reply, CookieHeaders, State}; -handle_call({which_cookies, Url}, _, #state{cookie_db = CookieDb} = State) -> - ?hcrv("which cookies", [{url, Url}]), - case http_uri:parse(Url) of - {Scheme, _, Host, Port, Path, _} -> +handle_call({which_cookies, Url, Options}, _, + #state{cookie_db = CookieDb} = State) -> + ?hcrv("which cookies", [{url, Url}, {options, Options}]), + case http_uri:parse(Url, Options) of + {ok, {Scheme, _, Host, Port, Path, _}} -> CookieHeaders = httpc_cookie:header(CookieDb, Scheme, {Host, Port}, Path), {reply, CookieHeaders, State}; - Msg -> - {reply, Msg, State} + {error, _} = ERROR -> + {reply, ERROR, State} end; handle_call(info, _, State) -> diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl index 207b96271c..2414ed0911 100644 --- a/lib/inets/src/http_client/httpc_response.erl +++ b/lib/inets/src/http_client/httpc_response.erl @@ -340,7 +340,9 @@ redirect(Response = {StatusLine, Headers, Body}, Request) -> undefined -> transparent(Response, Request); RedirUrl -> - case http_uri:parse(RedirUrl) of + UrlParseOpts = [{ipv6_host_with_brackets, + Request#request.ipv6_host_with_brackets}], + case http_uri:parse(RedirUrl, UrlParseOpts) of {error, no_scheme} when (Request#request.settings)#http_options.relaxed -> NewLocation = fix_relative_uri(Request, RedirUrl), @@ -350,10 +352,9 @@ redirect(Response = {StatusLine, Headers, Body}, Request) -> {error, Reason} -> {ok, error(Request, Reason), Data}; %% Automatic redirection - {Scheme, _, Host, Port, Path, Query} -> + {ok, {Scheme, _, Host, Port, Path, Query}} -> NewHeaders = - (Request#request.headers)#http_request_h{host = - Host}, + (Request#request.headers)#http_request_h{host = Host}, NewRequest = Request#request{redircount = Request#request.redircount+1, diff --git a/lib/inets/src/http_lib/http_internal.hrl b/lib/inets/src/http_lib/http_internal.hrl index 2e924667c6..97cf474ab9 100644 --- a/lib/inets/src/http_lib/http_internal.hrl +++ b/lib/inets/src/http_lib/http_internal.hrl @@ -28,7 +28,6 @@ -define(HTTP_MAX_URI_SIZE, nolimit). -ifndef(HTTP_DEFAULT_SSL_KIND). -%% -define(HTTP_DEFAULT_SSL_KIND, ossl). -define(HTTP_DEFAULT_SSL_KIND, essl). -endif. % -ifdef(HTTP_DEFAULT_SSL_KIND). diff --git a/lib/inets/src/http_lib/http_transport.erl b/lib/inets/src/http_lib/http_transport.erl index 9b8190ebed..5eb827032f 100644 --- a/lib/inets/src/http_lib/http_transport.erl +++ b/lib/inets/src/http_lib/http_transport.erl @@ -62,8 +62,6 @@ start(ip_comm) -> %% This is just for backward compatibillity start({ssl, _}) -> do_start_ssl(); -start({ossl, _}) -> - do_start_ssl(); start({essl, _}) -> do_start_ssl(). @@ -126,22 +124,6 @@ connect(ip_comm = _SocketType, {Host, Port}, Opts0, Timeout) connect({ssl, SslConfig}, Address, Opts, Timeout) -> connect({?HTTP_DEFAULT_SSL_KIND, SslConfig}, Address, Opts, Timeout); -connect({ossl, SslConfig}, {Host, Port}, _, Timeout) -> - Opts = [binary, {active, false}, {ssl_imp, old}] ++ SslConfig, - ?hlrt("connect using ossl", - [{host, Host}, - {port, Port}, - {ssl_config, SslConfig}, - {timeout, Timeout}]), - case (catch ssl:connect(Host, Port, Opts, Timeout)) of - {'EXIT', Reason} -> - {error, {eoptions, Reason}}; - {ok, _} = OK -> - OK; - {error, _} = ERROR -> - ERROR - end; - connect({essl, SslConfig}, {Host, Port}, Opts0, Timeout) -> Opts = [binary, {active, false}, {ssl_imp, new} | Opts0] ++ SslConfig, ?hlrt("connect using essl", @@ -187,13 +169,6 @@ listen({ssl, SSLConfig}, Addr, Port) -> {ssl_config, SSLConfig}]), listen({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Addr, Port); -listen({ossl, SSLConfig}, Addr, Port) -> - ?hlrt("listen (ossl)", - [{addr, Addr}, - {port, Port}, - {ssl_config, SSLConfig}]), - listen_ssl(Addr, Port, [{ssl_imp, old} | SSLConfig]); - listen({essl, SSLConfig}, Addr, Port) -> ?hlrt("listen (essl)", [{addr, Addr}, @@ -353,8 +328,6 @@ accept(ip_comm, ListenSocket, Timeout) -> accept({ssl, SSLConfig}, ListenSocket, Timeout) -> accept({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, ListenSocket, Timeout); -accept({ossl, _SSLConfig}, ListenSocket, Timeout) -> - ssl:transport_accept(ListenSocket, Timeout); accept({essl, _SSLConfig}, ListenSocket, Timeout) -> ssl:transport_accept(ListenSocket, Timeout). @@ -374,9 +347,6 @@ controlling_process(ip_comm, Socket, NewOwner) -> controlling_process({ssl, SSLConfig}, Socket, NewOwner) -> controlling_process({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, NewOwner); -controlling_process({ossl, _}, Socket, NewOwner) -> - ssl:controlling_process(Socket, NewOwner); - controlling_process({essl, _}, Socket, NewOwner) -> ssl:controlling_process(Socket, NewOwner). @@ -397,13 +367,6 @@ setopts(ip_comm, Socket, Options) -> setopts({ssl, SSLConfig}, Socket, Options) -> setopts({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Options); -setopts({ossl, _}, Socket, Options) -> - ?hlrt("[o]ssl setopts", [{socket, Socket}, {options, Options}]), - Reason = (catch ssl:setopts(Socket, Options)), - ?hlrt("[o]ssl setopts result", [{reason, Reason}]), - Reason; - - setopts({essl, _}, Socket, Options) -> ?hlrt("[e]ssl setopts", [{socket, Socket}, {options, Options}]), Reason = (catch ssl:setopts(Socket, Options)), @@ -435,10 +398,6 @@ getopts(ip_comm, Socket, Options) -> getopts({ssl, SSLConfig}, Socket, Options) -> getopts({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Options); -getopts({ossl, _}, Socket, Options) -> - ?hlrt("ssl getopts", [{socket, Socket}, {options, Options}]), - getopts_ssl(Socket, Options); - getopts({essl, _}, Socket, Options) -> ?hlrt("essl getopts", [{socket, Socket}, {options, Options}]), getopts_ssl(Socket, Options). @@ -472,9 +431,6 @@ getstat(ip_comm = _SocketType, Socket) -> getstat({ssl, SSLConfig}, Socket) -> getstat({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); -getstat({ossl, _} = _SocketType, _Socket) -> - []; - getstat({essl, _} = _SocketType, _Socket) -> []. @@ -493,9 +449,6 @@ send(ip_comm, Socket, Message) -> send({ssl, SSLConfig}, Socket, Message) -> send({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Message); -send({ossl, _}, Socket, Message) -> - ssl:send(Socket, Message); - send({essl, _}, Socket, Message) -> ssl:send(Socket, Message). @@ -514,9 +467,6 @@ close(ip_comm, Socket) -> close({ssl, SSLConfig}, Socket) -> close({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); -close({ossl, _}, Socket) -> - ssl:close(Socket); - close({essl, _}, Socket) -> ssl:close(Socket). @@ -538,9 +488,6 @@ peername(ip_comm, Socket) -> peername({ssl, SSLConfig}, Socket) -> peername({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); -peername({ossl, _}, Socket) -> - do_peername(ssl:peername(Socket)); - peername({essl, _}, Socket) -> do_peername(ssl:peername(Socket)). @@ -573,9 +520,6 @@ sockname(ip_comm, Socket) -> sockname({ssl, SSLConfig}, Socket) -> sockname({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); -sockname({ossl, _}, Socket) -> - do_sockname(ssl:sockname(Socket)); - sockname({essl, _}, Socket) -> do_sockname(ssl:sockname(Socket)). @@ -651,9 +595,6 @@ negotiate(ip_comm,_,_) -> negotiate({ssl, SSLConfig}, Socket, Timeout) -> ?hlrt("negotiate(ssl)", []), negotiate({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Timeout); -negotiate({ossl, _}, Socket, Timeout) -> - ?hlrt("negotiate(ossl)", []), - negotiate_ssl(Socket, Timeout); negotiate({essl, _}, Socket, Timeout) -> ?hlrt("negotiate(essl)", []), negotiate_ssl(Socket, Timeout). diff --git a/lib/inets/src/http_lib/http_uri.erl b/lib/inets/src/http_lib/http_uri.erl index 607475c359..32c6305a79 100644 --- a/lib/inets/src/http_lib/http_uri.erl +++ b/lib/inets/src/http_lib/http_uri.erl @@ -16,25 +16,30 @@ %% %% %CopyrightEnd% %% -%% +%% +%% RFC 3986 +%% -module(http_uri). --export([parse/1]). --export([encode/1, decode/1]). +-export([parse/1, parse/2, + encode/1, decode/1]). %%%========================================================================= %%% API %%%========================================================================= parse(AbsURI) -> + parse(AbsURI, []). + +parse(AbsURI, Opts) -> case parse_scheme(AbsURI) of {error, Reason} -> {error, Reason}; {Scheme, Rest} -> - case (catch parse_uri_rest(Scheme, Rest)) of + case (catch parse_uri_rest(Scheme, Rest, Opts)) of {UserInfo, Host, Port, Path, Query} -> - {Scheme, UserInfo, Host, Port, Path, Query}; + {ok, {Scheme, UserInfo, Host, Port, Path, Query}}; _ -> {error, {malformed_url, AbsURI}} end @@ -68,15 +73,14 @@ parse_scheme(AbsURI) -> {error, no_scheme}; {StrScheme, Rest} -> case list_to_atom(http_util:to_lower(StrScheme)) of - Scheme when Scheme == http; Scheme == https -> + Scheme when (Scheme =:= http) orelse (Scheme =:= https) -> {Scheme, Rest}; Scheme -> {error, {not_supported_scheme, Scheme}} end end. -parse_uri_rest(Scheme, "//" ++ URIPart) -> - +parse_uri_rest(Scheme, "//" ++ URIPart, Opts) -> {Authority, PathQuery} = case split_uri(URIPart, "/", URIPart, 1, 0) of Split = {_, _} -> @@ -91,8 +95,8 @@ parse_uri_rest(Scheme, "//" ++ URIPart) -> end, {UserInfo, HostPort} = split_uri(Authority, "@", {"", Authority}, 1, 1), - {Host, Port} = parse_host_port(Scheme, HostPort), - {Path, Query} = parse_path_query(PathQuery), + {Host, Port} = parse_host_port(Scheme, HostPort, Opts), + {Path, Query} = parse_path_query(PathQuery), {UserInfo, Host, Port, Path, Query}. @@ -100,13 +104,14 @@ parse_path_query(PathQuery) -> {Path, Query} = split_uri(PathQuery, "\\?", {PathQuery, ""}, 1, 0), {path(Path), Query}. -parse_host_port(Scheme,"[" ++ HostPort) -> %ipv6 +parse_host_port(Scheme,"[" ++ HostPort, Opts) -> %ipv6 DefaultPort = default_port(Scheme), {Host, ColonPort} = split_uri(HostPort, "\\]", {HostPort, ""}, 1, 1), + Host2 = maybe_ipv6_host_with_brackets(Host, Opts), {_, Port} = split_uri(ColonPort, ":", {"", DefaultPort}, 0, 1), - {Host, int_port(Port)}; + {Host2, int_port(Port)}; -parse_host_port(Scheme, HostPort) -> +parse_host_port(Scheme, HostPort, _Opts) -> DefaultPort = default_port(Scheme), {Host, Port} = split_uri(HostPort, ":", {HostPort, DefaultPort}, 1, 1), {Host, int_port(Port)}. @@ -120,6 +125,14 @@ split_uri(UriPart, SplitChar, NoMatchResult, SkipLeft, SkipRight) -> NoMatchResult end. +maybe_ipv6_host_with_brackets(Host, Opts) -> + case lists:keysearch(ipv6_host_with_brackets, 1, Opts) of + {value, {ipv6_host_with_brackets, true}} -> + "[" ++ Host ++ "]"; + _ -> + Host + end. + default_port(http) -> 80; default_port(https) -> diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index 5352eb8bb9..7646300409 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -219,9 +219,8 @@ load("ServerName " ++ ServerName, []) -> load("SocketType " ++ SocketType, []) -> %% ssl is the same as HTTP_DEFAULT_SSL_KIND - %% ossl is ssl based on OpenSSL (the "old" ssl) %% essl is the pure Erlang-based ssl (the "new" ssl) - case check_enum(clean(SocketType), ["ssl", "ossl", "essl", "ip_comm"]) of + case check_enum(clean(SocketType), ["ssl", "essl", "ip_comm"]) of {ok, ValidSocketType} -> {ok, [], {socket_type, ValidSocketType}}; {error,_} -> @@ -541,7 +540,6 @@ validate_config_params([{server_name, Value} | _]) -> validate_config_params([{socket_type, Value} | Rest]) when (Value =:= ip_comm) orelse (Value =:= ssl) orelse - (Value =:= ossl) orelse (Value =:= essl) -> validate_config_params(Rest); validate_config_params([{socket_type, Value} | _]) -> @@ -811,7 +809,7 @@ lookup_socket_type(ConfigDB) -> case httpd_util:lookup(ConfigDB, socket_type, ip_comm) of ip_comm -> ip_comm; - SSL when (SSL =:= ssl) orelse (SSL =:= ossl) orelse (SSL =:= essl) -> + SSL when (SSL =:= ssl) orelse (SSL =:= essl) -> SSLTag = if (SSL =:= ssl) -> diff --git a/lib/inets/src/inets_app/Makefile b/lib/inets/src/inets_app/Makefile index 20e22917e2..63ab0a5bae 100644 --- a/lib/inets/src/inets_app/Makefile +++ b/lib/inets/src/inets_app/Makefile @@ -30,6 +30,7 @@ include ../../vsn.mk VSN = $(INETS_VSN) + # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -41,8 +42,8 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # ---------------------------------------------------- MODULES = \ - inets_service \ inets \ + inets_service \ inets_app \ inets_sup \ inets_regexp diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index cb036157a5..4d0defb329 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -34,8 +34,7 @@ ftp_sup, %% HTTP client: - http, %% Old client API module - httpc, %% New client API module + httpc, httpc_handler, httpc_handler_sup, httpc_manager, diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index fb605351b4..779dd8e439 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -18,127 +18,47 @@ {"%VSN%", [ - {"5.7.1", - [ - {load_module, http_uri, soft_purge, soft_purge, []}, - {load_module, http_util, soft_purge, soft_purge, []}, - {load_module, httpd_util, soft_purge, soft_purge, [http_util]}, - {load_module, httpd_file, soft_purge, soft_purge, []}, - {load_module, httpd_request, soft_purge, soft_purge, []}, - {load_module, mod_responsecontrol, soft_purge, soft_purge, []}, - {load_module, httpd_response, soft_purge, soft_purge, [mod_responsecontrol]} - ] - }, - {"5.7", - [ - {load_module, http_uri, soft_purge, soft_purge, []}, - {load_module, httpd_util, soft_purge, soft_purge, [http_util]}, - {load_module, httpd_file, soft_purge, soft_purge, []}, - {load_module, httpd_request, soft_purge, soft_purge, []}, - {load_module, httpc_cookie, soft_purge, soft_purge, [http_util]}, - {load_module, http_util, soft_purge, soft_purge, []}, - {load_module, mod_responsecontrol, soft_purge, soft_purge, []}, - {load_module, httpd_response, soft_purge, soft_purge, [mod_responsecontrol]} - ] - }, - {"5.6", - [ - {load_module, http_uri, soft_purge, soft_purge, []}, - {load_module, httpd_util, soft_purge, soft_purge, [http_util]}, - {load_module, httpd_file, soft_purge, soft_purge, []}, - {load_module, httpd_request, soft_purge, soft_purge, []}, - {load_module, httpc, soft_purge, soft_purge, [httpc_manager]}, - {load_module, http_transport, soft_purge, soft_purge, [http_transport]}, - {load_module, httpc_cookie, soft_purge, soft_purge, [http_util]}, - {load_module, http_util, soft_purge, soft_purge, []}, - {load_module, mod_responsecontrol, soft_purge, soft_purge, []}, - {load_module, httpd_response, soft_purge, soft_purge, [mod_responsecontrol]}, - {update, httpc_handler, soft, soft_purge, soft_purge, []}, - {update, httpc_manager, soft, soft_purge, soft_purge, [httpc_handler]}, - {update, ftp, soft, soft_purge, soft_purge, []} - ] - }, - {"5.5.2", + {"5.7.2", [ {restart_application, inets} ] }, - {"5.5.1", + {"5.7.1", [ {restart_application, inets} ] }, - {"5.5", + {"5.7", [ {restart_application, inets} ] }, - {"5.4", + {"5.6", [ {restart_application, inets} ] } ], [ - {"5.7.1", - [ - {load_module, http_uri, soft_purge, soft_purge, []}, - {load_module, http_util, soft_purge, soft_purge, []}, - {load_module, httpd_util, soft_purge, soft_purge, [http_util]}, - {load_module, httpd_file, soft_purge, soft_purge, []}, - {load_module, httpd_request, soft_purge, soft_purge, []}, - {load_module, mod_responsecontrol, soft_purge, soft_purge, []}, - {load_module, httpd_response, soft_purge, soft_purge, [mod_responsecontrol]} - ] - }, - {"5.7", - [ - {load_module, http_uri, soft_purge, soft_purge, []}, - {load_module, httpd_util, soft_purge, soft_purge, [http_util]}, - {load_module, httpd_file, soft_purge, soft_purge, []}, - {load_module, httpd_request, soft_purge, soft_purge, []}, - {load_module, httpc_cookie, soft_purge, soft_purge, [http_util]}, - {load_module, http_util, soft_purge, soft_purge, []}, - {load_module, mod_responsecontrol, soft_purge, soft_purge, []}, - {load_module, httpd_response, soft_purge, soft_purge, [mod_responsecontrol]} - ] - }, - {"5.6", - [ - {load_module, http_uri, soft_purge, soft_purge, []}, - {load_module, httpd_util, soft_purge, soft_purge, [http_util]}, - {load_module, httpd_file, soft_purge, soft_purge, []}, - {load_module, httpd_request, soft_purge, soft_purge, []}, - {load_module, httpc, soft_purge, soft_purge, [httpc_manager]}, - {load_module, http_transport, soft_purge, soft_purge, [http_transport]}, - {load_module, httpc_cookie, soft_purge, soft_purge, [http_util]}, - {load_module, http_util, soft_purge, soft_purge, []}, - {load_module, mod_responsecontrol, soft_purge, soft_purge, []}, - {load_module, httpd_response, soft_purge, soft_purge, [mod_responsecontrol]}, - {update, httpc_handler, soft, soft_purge, soft_purge, []}, - {update, httpc_manager, soft, soft_purge, soft_purge, [httpc_handler]}, - {update, ftp, soft, soft_purge, soft_purge, []} - ] - }, - {"5.5.2", + {"5.7.2", [ {restart_application, inets} ] - }, - {"5.5.1", + }, + {"5.7.1", [ {restart_application, inets} ] }, - {"5.5", + {"5.7", [ {restart_application, inets} ] - }, - {"5.4", + }, + {"5.6", [ {restart_application, inets} ] - } + } ] }. diff --git a/lib/inets/src/inets_app/inets.mk b/lib/inets/src/inets_app/inets.mk index b6e9fe1d96..35fb0d7eca 100644 --- a/lib/inets/src/inets_app/inets.mk +++ b/lib/inets/src/inets_app/inets.mk @@ -33,6 +33,10 @@ ifeq ($(WARN_UNUSED_WARS), true) ERL_COMPILE_FLAGS += +warn_unused_vars endif +ifeq ($(shell erl -noshell -eval 'io:format("~4s", [erlang:system_info(otp_release)])' -s init stop), R14B) +INETS_ERL_COMPILE_FLAGS += -D'OTP-R14B-COMPILER' +endif + INETS_APP_VSN_COMPILE_FLAGS = \ +'{parse_transform,sys_pre_attributes}' \ +'{attribute,insert,app_vsn,$(APP_VSN)}' diff --git a/lib/inets/src/inets_app/inets_service.erl b/lib/inets/src/inets_app/inets_service.erl index e9eb9892f2..a057a51e2c 100644 --- a/lib/inets/src/inets_app/inets_service.erl +++ b/lib/inets/src/inets_app/inets_service.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% Copyright Ericsson AB 2007-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 @@ -20,24 +20,35 @@ -module(inets_service). +-ifdef('OTP-R14B-COMPILER'). + -export([behaviour_info/1]). behaviour_info(callbacks) -> - [{start_standalone, 1}, - {start_service, 1}, - {stop_service, 1}, - {services, 0}, - {service_info, 1}]; + [{start_standalone, 1}, + {start_service, 1}, + {stop_service, 1}, + {services, 0}, + {service_info, 1}]; behaviour_info(_) -> - undefined. + undefined. + +-else. %% Starts service stand-alone %% start_standalone(Config) -> % {ok, Pid} | {error, Reason} %% <service>:start_link(Config). +-callback start_standalone(Config :: term()) -> + {ok, pid()} | {error, Reason :: term()}. + %% Starts service as part of inets %% start_service(Config) -> % {ok, Pid} | {error, Reason} %% <service_sup>:start_child(Config). + +-callback start_service(Config :: term()) -> + {ok, pid()} | {error, Reason :: term()}. + %% Stop service %% stop_service(Pid) -> % ok | {error, Reason} %% <service_sup>:stop_child(maybe_map_pid_to_other_ref(Pid)). @@ -51,6 +62,9 @@ behaviour_info(_) -> %% Error %% end. +-callback stop_service(Service :: term()) -> + ok | {error, Reason :: term()}. + %% Returns list of running services. Services started as stand alone %% are not listed %% services() -> % [{Service, Pid}] @@ -59,7 +73,14 @@ behaviour_info(_) -> %% [{httpc, Pid} || {_, Pid, _, _} <- %% supervisor:which_children(httpc_profile_sup)]. +-callback services() -> + [{Service :: term(), pid()}]. -%% service_info() -> [{Property, Value}] | {error, Reason} +%% service_info() -> {ok, [{Property, Value}]} | {error, Reason} %% ex: httpc:service_info() -> [{profile, ProfileName}] %% httpd:service_info() -> [{host, Host}, {port, Port}] + +-callback service_info(Service :: term()) -> + {ok, [{Property :: term(), Value :: term()}]} | {error, Reason :: term()}. + +-endif. diff --git a/lib/inets/src/tftp/tftp.erl b/lib/inets/src/tftp/tftp.erl index bfdb4c0030..8d8fce388d 100644 --- a/lib/inets/src/tftp/tftp.erl +++ b/lib/inets/src/tftp/tftp.erl @@ -215,8 +215,6 @@ start/0 ]). --export([behaviour_info/1]). - %% Application local functions -export([ start_standalone/1, @@ -226,14 +224,67 @@ service_info/1 ]). +-ifdef('OTP-R14B-COMPILER'). + +-export([behaviour_info/1]). behaviour_info(callbacks) -> - [{prepare, 6}, {open, 6}, {read, 1}, {write, 2}, {abort, 3}]; + [{prepare, 6}, + {open, 6}, + {read, 1}, + {write, 2}, + {abort, 3}]; behaviour_info(_) -> undefined. +-else. + +-type peer() :: {PeerType :: inet | inet6, + PeerHost :: inet:ip_address(), + PeerPort :: port()}. + +-type access() :: read | write. + +-type options() :: [{Key :: string(), Value :: string()}]. + +-type error_code() :: undef | enoent | eacces | enospc | + badop | eexist | baduser | badopt | + integer(). + +-callback prepare(Peer :: peer(), + Access :: access(), + Filename :: file:name(), + Mode :: string(), + SuggestedOptions :: options(), + InitialState :: [] | [{root_dir, string()}]) -> + {ok, AcceptedOptions :: options(), NewState :: term()} | + {error, {Code :: error_code(), string()}}. + +-callback open(Peer :: peer(), + Access :: access(), + Filename :: file:name(), + Mode :: string(), + SuggestedOptions :: options(), + State :: [] | [{root_dir, string()}] | term()) -> + {ok, AcceptedOptions :: options(), NewState :: term()} | + {error, {Code :: error_code(), string()}}. + +-callback read(State :: term()) -> {more, binary(), NewState :: term()} | + {last, binary(), integer()} | + {error, {Code :: error_code(), string()}}. + +-callback write(binary(), State :: term()) -> + {more, NewState :: term()} | + {last, FileSize :: integer()} | + {error, {Code :: error_code(), string()}}. + +-callback abort(Code :: error_code(), string(), State :: term()) -> 'ok'. + +-endif. + -include("tftp.hrl"). + %%------------------------------------------------------------------- %% read_file(RemoteFilename, LocalFilename, Options) -> %% {ok, LastCallbackState} | {error, Reason} diff --git a/lib/inets/test/ftp_suite_lib.erl b/lib/inets/test/ftp_suite_lib.erl index 3ebd02229e..ffb58c91b6 100644 --- a/lib/inets/test/ftp_suite_lib.erl +++ b/lib/inets/test/ftp_suite_lib.erl @@ -196,7 +196,9 @@ test_filenames() -> %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- init_per_testcase(Case, Config) - when (Case =:= open) orelse (Case =:= open_port) -> + when (Case =:= open) orelse + (Case =:= open_port) -> + put(ftp_testcase, Case), io:format(user, "~n~n*** INIT ~w:~w ***~n~n", [?MODULE, Case]), inets:start(), NewConfig = data_dir(Config), @@ -266,7 +268,7 @@ do_init_per_testcase(Case, Config) -> end, Opts2 = case string:tokens(atom_to_list(Case), [$_]) of - [_, "active" | _] -> + ["active" | _] -> [{mode, active} | Opts1]; _ -> [{mode, passive} | Opts1] @@ -367,8 +369,11 @@ open(Config) when is_list(Config) -> tc_open(Host) -> + p("tc_open -> entry with" + "~n Host: ~p", [Host]), {ok, Pid} = ?ftp_open(Host, []), ok = ftp:close(Pid), + p("tc_open -> try (ok) open 1"), {ok, Pid1} = ftp:open({option_list, [{host,Host}, {port, ?FTP_PORT}, @@ -376,11 +381,13 @@ tc_open(Host) -> {timeout, 30000}]}), ok = ftp:close(Pid1), + p("tc_open -> try (fail) open 2"), {error, ehost} = ftp:open({option_list, [{port, ?FTP_PORT}, {flags, [verbose]}]}), {ok, Pid2} = ftp:open(Host), ok = ftp:close(Pid2), + p("tc_open -> try (ok) open 3"), {ok, NewHost} = inet:getaddr(Host, inet), {ok, Pid3} = ftp:open(NewHost), ftp:user(Pid3, ?FTP_USER, ?FTP_PASS), @@ -392,33 +399,68 @@ tc_open(Host) -> %% Bad input that has default values are ignored and the defult %% is used. + p("tc_open -> try (ok) open 4"), {ok, Pid4} = - ftp:open({option_list, [{host, Host}, {port, badarg}, - {flags, [verbose]}, + ftp:open({option_list, [{host, Host}, + {port, badarg}, + {flags, [verbose]}, {timeout, 30000}]}), test_server:sleep(100), ok = ftp:close(Pid4), + + p("tc_open -> try (ok) open 5"), {ok, Pid5} = - ftp:open({option_list, [{host, Host}, {port, ?FTP_PORT}, - {flags, [verbose]}, + ftp:open({option_list, [{host, Host}, + {port, ?FTP_PORT}, + {flags, [verbose]}, {timeout, -42}]}), test_server:sleep(100), ok = ftp:close(Pid5), + + p("tc_open -> try (ok) open 6"), {ok, Pid6} = - ftp:open({option_list, [{host, Host}, {port, ?FTP_PORT}, + ftp:open({option_list, [{host, Host}, + {port, ?FTP_PORT}, {flags, [verbose]}, - {mode, cool}]}), + {mode, cool}]}), test_server:sleep(100), ok = ftp:close(Pid6), + p("tc_open -> try (ok) open 7"), {ok, Pid7} = ftp:open(Host, [{port, ?FTP_PORT}, {verbose, true}, {timeout, 30000}]), ok = ftp:close(Pid7), + p("tc_open -> try (ok) open 8"), {ok, Pid8} = ftp:open(Host, ?FTP_PORT), ok = ftp:close(Pid8), + p("tc_open -> try (ok) open 9"), + {ok, Pid9} = + ftp:open(Host, [{port, ?FTP_PORT}, + {verbose, true}, + {timeout, 30000}, + {dtimeout, -99}]), + ok = ftp:close(Pid9), + + p("tc_open -> try (ok) open 10"), + {ok, Pid10} = + ftp:open(Host, [{port, ?FTP_PORT}, + {verbose, true}, + {timeout, 30000}, + {dtimeout, "foobar"}]), + ok = ftp:close(Pid10), + + p("tc_open -> try (ok) open 11"), + {ok, Pid11} = + ftp:open(Host, [{port, ?FTP_PORT}, + {verbose, true}, + {timeout, 30000}, + {dtimeout, 1}]), + ok = ftp:close(Pid11), + + p("tc_open -> done"), ok. @@ -445,7 +487,7 @@ passive_user(suite) -> []; passive_user(Config) when is_list(Config) -> Pid = ?config(ftp, Config), - io:format("Pid: ~p~n",[Pid]), + p("Pid: ~p",[Pid]), do_user(Pid). @@ -967,13 +1009,13 @@ api_missuse(doc)-> ["Test that behaviour of the ftp process if the api is abused"]; api_missuse(suite) -> []; api_missuse(Config) when is_list(Config) -> - io:format("api_missuse -> entry~n", []), + p("api_missuse -> entry"), Flag = process_flag(trap_exit, true), Pid = ?config(ftp, Config), Host = ftp_host(Config), %% Serious programming fault, connetion will be shut down - io:format("api_missuse -> verify bad call termination (~p)~n", [Pid]), + p("api_missuse -> verify bad call termination (~p)", [Pid]), case (catch gen_server:call(Pid, {self(), foobar, 10}, infinity)) of {error, {connection_terminated, 'API_violation'}} -> ok; @@ -983,23 +1025,23 @@ api_missuse(Config) when is_list(Config) -> test_server:sleep(500), undefined = process_info(Pid, status), - io:format("api_missuse -> start new client~n", []), + p("api_missuse -> start new client"), {ok, Pid2} = ?ftp_open(Host, []), %% Serious programming fault, connetion will be shut down - io:format("api_missuse -> verify bad cast termination~n", []), + p("api_missuse -> verify bad cast termination"), gen_server:cast(Pid2, {self(), foobar, 10}), test_server:sleep(500), undefined = process_info(Pid2, status), - io:format("api_missuse -> start new client~n", []), + p("api_missuse -> start new client"), {ok, Pid3} = ?ftp_open(Host, []), %% Could be an innocent misstake the connection lives. - io:format("api_missuse -> verify bad bang~n", []), + p("api_missuse -> verify bad bang"), Pid3 ! foobar, test_server:sleep(500), {status, _} = process_info(Pid3, status), process_flag(trap_exit, Flag), - io:format("api_missuse -> done~n", []), + p("api_missuse -> done"), ok. @@ -1567,9 +1609,9 @@ split([], I, Is) -> lists:reverse([lists:reverse(I)| Is]). do_ftp_open(Host, Opts) -> - io:format("do_ftp_open -> entry with" - "~n Host: ~p" - "~n Opts: ~p", [Host, Opts]), + p("do_ftp_open -> entry with" + "~n Host: ~p" + "~n Opts: ~p", [Host, Opts]), case ftp:open(Host, Opts) of {ok, _} = OK -> OK; @@ -1595,7 +1637,7 @@ passwd() -> ftpd_hosts(Config) -> DataDir = ?config(data_dir, Config), FileName = filename:join([DataDir, "../ftp_SUITE_data/", ftpd_hosts]), - io:format("FileName: ~p~n", [FileName]), + p("FileName: ~p", [FileName]), case file:consult(FileName) of {ok, [Hosts]} when is_list(Hosts) -> Hosts; diff --git a/lib/inets/test/ftp_windows_2003_server_test.erl b/lib/inets/test/ftp_windows_2003_server_test.erl index 57f1ae8358..32f25713f8 100644 --- a/lib/inets/test/ftp_windows_2003_server_test.erl +++ b/lib/inets/test/ftp_windows_2003_server_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-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 @@ -87,14 +87,22 @@ end_per_testcase(Case, Config) -> %% Description: Returns a list of all test cases in this test suite %%-------------------------------------------------------------------- all() -> - [open, open_port, {group, passive}, {group, active}, - api_missuse, not_owner, {group, progress_report}]. + [ + open, + open_port, + {group, passive}, + {group, active}, + api_missuse, + not_owner, + {group, progress_report} + ]. groups() -> - [{passive, [], ftp_suite_lib:passive(suite)}, - {active, [], ftp_suite_lib:active(suite)}, - {progress_report, [], - ftp_suite_lib:progress_report(suite)}]. + [ + {passive, [], ftp_suite_lib:passive(suite)}, + {active, [], ftp_suite_lib:active(suite)}, + {progress_report, [], ftp_suite_lib:progress_report(suite)} + ]. init_per_group(_GroupName, Config) -> Config. diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index be5d100ecc..d86e52f3d5 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -113,13 +113,10 @@ groups() -> proxy_page_does_not_exist, proxy_https_not_supported]}, {ssl, [], [ssl_head, - ossl_head, essl_head, ssl_get, - ossl_get, essl_get, ssl_trace, - ossl_trace, essl_trace]}, {stream, [], [http_stream, http_stream_once, @@ -273,10 +270,6 @@ init_per_testcase(Case, Timeout, Config) -> init_per_testcase_ssl(ssl, PrivDir, SslConfFile, [{watchdog, Dog} | TmpConfig]); - [$o, $s, $s, $l | _] -> - init_per_testcase_ssl(ossl, PrivDir, SslConfFile, - [{watchdog, Dog} | TmpConfig]); - [$e, $s, $s, $l | _] -> init_per_testcase_ssl(essl, PrivDir, SslConfFile, [{watchdog, Dog} | TmpConfig]); @@ -1078,13 +1071,6 @@ ssl_head(suite) -> ssl_head(Config) when is_list(Config) -> ssl_head(ssl, Config). -ossl_head(doc) -> - ["Same as http_head/1 but over ssl sockets."]; -ossl_head(suite) -> - []; -ossl_head(Config) when is_list(Config) -> - ssl_head(ossl, Config). - essl_head(doc) -> ["Same as http_head/1 but over ssl sockets."]; essl_head(suite) -> @@ -1107,8 +1093,6 @@ ssl_head(SslTag, Config) -> case SslTag of ssl -> SSLOptions; - ossl -> - {ossl, SSLOptions}; essl -> {essl, SSLOptions} end, @@ -1133,13 +1117,6 @@ ssl_get(suite) -> ssl_get(Config) when is_list(Config) -> ssl_get(ssl, Config). -ossl_get(doc) -> - ["Same as http_get/1 but over ssl sockets."]; -ossl_get(suite) -> - []; -ossl_get(Config) when is_list(Config) -> - ssl_get(ossl, Config). - essl_get(doc) -> ["Same as http_get/1 but over ssl sockets."]; essl_get(suite) -> @@ -1159,8 +1136,6 @@ ssl_get(SslTag, Config) when is_list(Config) -> case SslTag of ssl -> SSLOptions; - ossl -> - {ossl, SSLOptions}; essl -> {essl, SSLOptions} end, @@ -1186,13 +1161,6 @@ ssl_trace(suite) -> ssl_trace(Config) when is_list(Config) -> ssl_trace(ssl, Config). -ossl_trace(doc) -> - ["Same as http_trace/1 but over ssl sockets."]; -ossl_trace(suite) -> - []; -ossl_trace(Config) when is_list(Config) -> - ssl_trace(ossl, Config). - essl_trace(doc) -> ["Same as http_trace/1 but over ssl sockets."]; essl_trace(suite) -> @@ -1212,8 +1180,6 @@ ssl_trace(SslTag, Config) when is_list(Config) -> case SslTag of ssl -> SSLOptions; - ossl -> - {ossl, SSLOptions}; essl -> {essl, SSLOptions} end, @@ -1914,22 +1880,31 @@ parse_url(suite) -> []; parse_url(Config) when is_list(Config) -> %% ipv6 - {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]} - = http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html"), + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html"), + {ok, {http,[],"[2010:836B:4179::836B:4179]",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{ipv6_host_with_brackets, true}]), + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{ipv6_host_with_brackets, false}]), + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{foo, false}]), {error, {malformed_url,"http://2010:836B:4179::836B:4179/foobar.html"}} = http_uri:parse("http://2010:836B:4179::836B:4179/foobar.html"), %% ipv4 - {http,[],"127.0.0.1",80,"/foobar.html",[]} = + {ok, {http,[],"127.0.0.1",80,"/foobar.html",[]}} = http_uri:parse("http://127.0.0.1/foobar.html"), %% host - {http,[],"localhost",8888,"/foobar.html",[]} = + {ok, {http,[],"localhost",8888,"/foobar.html",[]}} = http_uri:parse("http://localhost:8888/foobar.html"), %% Userinfo - {http,"nisse:foobar","localhost",8888,"/foobar.html",[]} = + {ok, {http,"nisse:foobar","localhost",8888,"/foobar.html",[]}} = http_uri:parse("http://nisse:foobar@localhost:8888/foobar.html"), %% Scheme error @@ -1938,18 +1913,20 @@ parse_url(Config) when is_list(Config) -> http_uri:parse("localhost:8888/foobar.html"), %% Query - {http,[],"localhost",8888,"/foobar.html","?foo=bar&foobar=42"} = + {ok, {http,[],"localhost",8888,"/foobar.html","?foo=bar&foobar=42"}} = http_uri:parse("http://localhost:8888/foobar.html?foo=bar&foobar=42"), %% Esc chars - {http,[],"www.somedomain.com",80,"/%2Eabc",[]} = + {ok, {http,[],"www.somedomain.com",80,"/%2Eabc",[]}} = http_uri:parse("http://www.somedomain.com/%2Eabc"), - {http,[],"www.somedomain.com",80,"/%252Eabc",[]} = + {ok, {http,[],"www.somedomain.com",80,"/%252Eabc",[]}} = http_uri:parse("http://www.somedomain.com/%252Eabc"), - {http,[],"www.somedomain.com",80,"/%25abc",[]} = + {ok, {http,[],"www.somedomain.com",80,"/%25abc",[]}} = http_uri:parse("http://www.somedomain.com/%25abc"), - {http,[],"www.somedomain.com",80,"/%25abc", "?foo=bar"} = + {ok, {http,[],"www.somedomain.com",80,"/%25abc", "?foo=bar"}} = http_uri:parse("http://www.somedomain.com/%25abc?foo=bar"), + + ok. @@ -2094,12 +2071,14 @@ http_invalid_http(Config) when is_list(Config) -> %%------------------------------------------------------------------------- +-define(GOOGLE, "www.google.com"). + hexed_query_otp_6191(doc) -> []; hexed_query_otp_6191(suite) -> []; hexed_query_otp_6191(Config) when is_list(Config) -> - Google = "www.google.com", + Google = ?GOOGLE, GoogleSearch = "http://" ++ Google ++ "/search", Search1 = "?hl=en&q=a%D1%85%D1%83%D0%B9&btnG=Google+Search", URI1 = GoogleSearch ++ Search1, @@ -2108,11 +2087,32 @@ hexed_query_otp_6191(Config) when is_list(Config) -> Search3 = "?hl=en&q=%foo", URI3 = GoogleSearch ++ Search3, - {http, [], Google, 80, "/search", _} = http_uri:parse(URI1), - {http, [], Google, 80, "/search", _} = http_uri:parse(URI2), - {http, [], Google, 80, "/search", _} = http_uri:parse(URI3), + Verify1 = + fun({http, [], ?GOOGLE, 80, "/search", _}) -> ok; + (_) -> error + end, + Verify2 = Verify1, + Verify3 = Verify1, + verify_uri(URI1, Verify1), + verify_uri(URI2, Verify2), + verify_uri(URI3, Verify3), ok. +verify_uri(URI, Verify) -> + case http_uri:parse(URI) of + {ok, ParsedURI} -> + case Verify(ParsedURI) of + ok -> + ok; + error -> + Reason = {unexpected_parse_result, URI, ParsedURI}, + ERROR = {error, Reason}, + throw(ERROR) + end; + {error, _} = ERROR -> + throw(ERROR) + end. + %%------------------------------------------------------------------------- @@ -3040,10 +3040,6 @@ dummy_server_init(Caller, essl, IpV, SSLOptions) -> BaseOpts = [{ssl_imp, new}, {backlog, 128}, binary, {reuseaddr,true}, {active, false} | SSLOptions], - dummy_ssl_server_init(Caller, BaseOpts, IpV); -dummy_server_init(Caller, ossl, IpV, SSLOptions) -> - BaseOpts = [{ssl_imp, old}, - {backlog, 128}, binary, {active, false} | SSLOptions], dummy_ssl_server_init(Caller, BaseOpts, IpV). dummy_ssl_server_init(Caller, BaseOpts, IpV) -> diff --git a/lib/inets/test/httpc_cookie_SUITE.erl b/lib/inets/test/httpc_cookie_SUITE.erl index 866fa9d525..93dbc270c5 100644 --- a/lib/inets/test/httpc_cookie_SUITE.erl +++ b/lib/inets/test/httpc_cookie_SUITE.erl @@ -55,7 +55,7 @@ init_per_testcase(session_cookies_only = Case, Config0) -> "~n Config0: ~p", [Case, Config0]), Config = init_workdir(Case, Config0), application:start(inets), - http:set_options([{cookies, verify}]), + httpc:set_options([{cookies, verify}]), watch_dog(Config); init_per_testcase(Case, Config0) -> @@ -66,7 +66,7 @@ init_per_testcase(Case, Config0) -> application:load(inets), application:set_env(inets, services, [{httpc, {default, CaseDir}}]), application:start(inets), - http:set_options([{cookies, verify}]), + httpc:set_options([{cookies, verify}]), watch_dog(Config). watch_dog(Config) -> @@ -160,12 +160,12 @@ session_cookies_only(Config) when is_list(Config) -> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" ";max-age=60000"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} - = http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), application:stop(inets), application:start(inets), - {"cookie",""} = http:cookie_header(?URL), + {"cookie", ""} = httpc:cookie_header(?URL), tsp("session_cookies_only -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -180,9 +180,9 @@ netscape_cookies(Config) when is_list(Config) -> Expires = future_netscape_date(), SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/; " "expires=" ++ Expires}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} = - http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), tsp("netscape_cookies -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -197,13 +197,13 @@ cookie_cancel(Config) when is_list(Config) -> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" "max-age=60000"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} - = http:cookie_header(?URL), - NewSetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" - "max-age=0"}], - http:verify_cookies(NewSetCookieHeaders, ?URL), - {"cookie", ""} = http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), + NewSetCookieHeaders = + [{"set-cookie", "test_cookie=true; path=/;max-age=0"}], + httpc:store_cookies(NewSetCookieHeaders, ?URL), + {"cookie", ""} = httpc:cookie_header(?URL), tsp("cookie_cancel -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -217,11 +217,11 @@ cookie_expires(Config) when is_list(Config) -> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" "max-age=5"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} - = http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), test_server:sleep(10000), - {"cookie", ""} = http:cookie_header(?URL), + {"cookie", ""} = httpc:cookie_header(?URL), tsp("cookie_expires -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -235,16 +235,16 @@ persistent_cookie(Config) when is_list(Config)-> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" "max-age=60000"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} = - http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), CaseDir = ?config(case_top_dir, Config), application:stop(inets), application:load(inets), application:set_env(inets, services, [{httpc, {default, CaseDir}}]), application:start(inets), - http:set_options([{cookies, enabled}]), - {"cookie","$Version=0; test_cookie=true; $Path=/"} = http:cookie_header(?URL), + httpc:set_options([{cookies, enabled}]), + {"cookie","$Version=0; test_cookie=true; $Path=/"} = httpc:cookie_header(?URL), tsp("persistent_cookie -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -259,10 +259,10 @@ domain_cookie(Config) when is_list(Config) -> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" "domain=.cookie.test.org"}], - http:verify_cookies(SetCookieHeaders, ?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), {"cookie","$Version=0; test_cookie=true; $Path=/; " "$Domain=.cookie.test.org"} = - http:cookie_header(?URL_DOMAIN), + httpc:cookie_header(?URL_DOMAIN), tsp("domain_cookie -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -283,8 +283,8 @@ secure_cookie(Config) when is_list(Config) -> tsp("secure_cookie -> Cookies 1: ~p", [httpc:which_cookies()]), SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/; secure"}], - tsp("secure_cookie -> verify cookies (1)"), - ok = http:verify_cookies(SetCookieHeaders, ?URL), + tsp("secure_cookie -> store cookies (1)"), + ok = httpc:store_cookies(SetCookieHeaders, ?URL), tsp("secure_cookie -> Cookies 2: ~p", [httpc:which_cookies()]), @@ -294,9 +294,9 @@ secure_cookie(Config) when is_list(Config) -> tsp("secure_cookie -> check cookie (plain)"), check_cookie("", ?URL), - tsp("secure_cookie -> verify cookies (2)"), + tsp("secure_cookie -> store cookies (2)"), SetCookieHeaders1 = [{"set-cookie", "test1_cookie=true; path=/; secure"}], - ok = http:verify_cookies(SetCookieHeaders1, ?URL), + ok = httpc:store_cookies(SetCookieHeaders1, ?URL), tsp("secure_cookie -> Cookies 3: ~p", [httpc:which_cookies()]), @@ -305,7 +305,7 @@ secure_cookie(Config) when is_list(Config) -> "test1_cookie=true; $Path=/", ?URL_SECURE), %% {"cookie","$Version=0; test_cookie=true; $Path=/; " -%% "test1_cookie=true; $Path=/"} = http:cookie_header(?URL_SECURE), +%% "test1_cookie=true; $Path=/"} = httpc:cookie_header(?URL_SECURE), tsp("secure_cookie -> Cookies 4: ~p", [httpc:which_cookies()]), @@ -411,8 +411,8 @@ cookie_attributes(Config) when is_list(Config) -> "comment=foobar; "%% Comment "foo=bar;" %% Nonsense should be ignored "max-age=60000"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=1; test_cookie=true"} = http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie","$Version=1; test_cookie=true"} = httpc:cookie_header(?URL), ok. @@ -421,7 +421,7 @@ cookie_attributes(Config) when is_list(Config) -> %%-------------------------------------------------------------------- check_cookie(Expect, URL) -> - case http:cookie_header(URL) of + case httpc:cookie_header(URL) of {"cookie", Expect} -> ok; {"cookie", Unexpected} -> diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index ccc7aea2aa..ba31788ccc 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -68,127 +68,96 @@ -export([ pssl_mod_alias/1, - ossl_mod_alias/1, essl_mod_alias/1, pssl_mod_actions/1, - ossl_mod_actions/1, essl_mod_actions/1, pssl_mod_security/1, - ossl_mod_security/1, essl_mod_security/1, pssl_mod_auth/1, - ossl_mod_auth/1, essl_mod_auth/1, pssl_mod_auth_api/1, - ossl_mod_auth_api/1, essl_mod_auth_api/1, pssl_mod_auth_mnesia_api/1, - ossl_mod_auth_mnesia_api/1, essl_mod_auth_mnesia_api/1, pssl_mod_htaccess/1, - ossl_mod_htaccess/1, essl_mod_htaccess/1, pssl_mod_cgi/1, - ossl_mod_cgi/1, essl_mod_cgi/1, pssl_mod_esi/1, - ossl_mod_esi/1, essl_mod_esi/1, pssl_mod_get/1, - ossl_mod_get/1, essl_mod_get/1, pssl_mod_head/1, - ossl_mod_head/1, essl_mod_head/1, pssl_mod_all/1, - ossl_mod_all/1, essl_mod_all/1, pssl_load_light/1, - ossl_load_light/1, essl_load_light/1, pssl_load_medium/1, - ossl_load_medium/1, essl_load_medium/1, pssl_load_heavy/1, - ossl_load_heavy/1, essl_load_heavy/1, pssl_dos_hostname/1, - ossl_dos_hostname/1, essl_dos_hostname/1, pssl_time_test/1, - ossl_time_test/1, essl_time_test/1, pssl_restart_no_block/1, - ossl_restart_no_block/1, essl_restart_no_block/1, pssl_restart_disturbing_block/1, - ossl_restart_disturbing_block/1, essl_restart_disturbing_block/1, pssl_restart_non_disturbing_block/1, - ossl_restart_non_disturbing_block/1, essl_restart_non_disturbing_block/1, pssl_block_disturbing_idle/1, - ossl_block_disturbing_idle/1, essl_block_disturbing_idle/1, pssl_block_non_disturbing_idle/1, - ossl_block_non_disturbing_idle/1, essl_block_non_disturbing_idle/1, pssl_block_503/1, - ossl_block_503/1, essl_block_503/1, pssl_block_disturbing_active/1, - ossl_block_disturbing_active/1, essl_block_disturbing_active/1, pssl_block_non_disturbing_active/1, - ossl_block_non_disturbing_active/1, essl_block_non_disturbing_active/1, pssl_block_disturbing_active_timeout_not_released/1, - ossl_block_disturbing_active_timeout_not_released/1, essl_block_disturbing_active_timeout_not_released/1, pssl_block_disturbing_active_timeout_released/1, - ossl_block_disturbing_active_timeout_released/1, essl_block_disturbing_active_timeout_released/1, pssl_block_non_disturbing_active_timeout_not_released/1, - ossl_block_non_disturbing_active_timeout_not_released/1, essl_block_non_disturbing_active_timeout_not_released/1, pssl_block_non_disturbing_active_timeout_released/1, - ossl_block_non_disturbing_active_timeout_released/1, essl_block_non_disturbing_active_timeout_released/1, pssl_block_disturbing_blocker_dies/1, - ossl_block_disturbing_blocker_dies/1, essl_block_disturbing_blocker_dies/1, pssl_block_non_disturbing_blocker_dies/1, - ossl_block_non_disturbing_blocker_dies/1, essl_block_non_disturbing_blocker_dies/1 ]). @@ -272,8 +241,7 @@ groups() -> ip_block_non_disturbing_active_timeout_released, ip_block_disturbing_blocker_dies, ip_block_non_disturbing_blocker_dies]}, - {ssl, [], - [{group, pssl}, {group, ossl}, {group, essl}]}, + {ssl, [], [{group, pssl}, {group, essl}]}, {pssl, [], [pssl_mod_alias, pssl_mod_actions, pssl_mod_security, pssl_mod_auth, pssl_mod_auth_api, @@ -293,25 +261,6 @@ groups() -> pssl_block_non_disturbing_active_timeout_released, pssl_block_disturbing_blocker_dies, pssl_block_non_disturbing_blocker_dies]}, - {ossl, [], - [ossl_mod_alias, ossl_mod_actions, ossl_mod_security, - ossl_mod_auth, ossl_mod_auth_api, - ossl_mod_auth_mnesia_api, ossl_mod_htaccess, - ossl_mod_cgi, ossl_mod_esi, ossl_mod_get, ossl_mod_head, - ossl_mod_all, ossl_load_light, ossl_load_medium, - ossl_load_heavy, ossl_dos_hostname, ossl_time_test, - ossl_restart_no_block, ossl_restart_disturbing_block, - ossl_restart_non_disturbing_block, - ossl_block_disturbing_idle, - ossl_block_non_disturbing_idle, ossl_block_503, - ossl_block_disturbing_active, - ossl_block_non_disturbing_active, - ossl_block_disturbing_active_timeout_not_released, - ossl_block_disturbing_active_timeout_released, - ossl_block_non_disturbing_active_timeout_not_released, - ossl_block_non_disturbing_active_timeout_released, - ossl_block_disturbing_blocker_dies, - ossl_block_non_disturbing_blocker_dies]}, {essl, [], [essl_mod_alias, essl_mod_actions, essl_mod_security, essl_mod_auth, essl_mod_auth_api, @@ -493,7 +442,6 @@ init_per_testcase2(Case, Config) -> [X, $s, $s, $l | _] -> case X of $p -> ssl; - $o -> ossl; $e -> essl end; _ -> @@ -636,7 +584,6 @@ init_per_testcase3(Case, Config) -> SslTag = case X of $p -> ssl; % plain - $o -> ossl; % OpenSSL based ssl $e -> essl % Erlang based ssl end, case inets_test_lib:start_http_server_ssl( @@ -653,7 +600,6 @@ init_per_testcase3(Case, Config) -> SslTag = case X of $p -> ssl; - $o -> ossl; $e -> essl end, case inets_test_lib:start_http_server_ssl( @@ -1171,13 +1117,6 @@ pssl_mod_alias(suite) -> pssl_mod_alias(Config) when is_list(Config) -> ssl_mod_alias(ssl, Config). -ossl_mod_alias(doc) -> - ["Module test: mod_alias - using new of configure old SSL"]; -ossl_mod_alias(suite) -> - []; -ossl_mod_alias(Config) when is_list(Config) -> - ssl_mod_alias(ossl, Config). - essl_mod_alias(doc) -> ["Module test: mod_alias - using new of configure new SSL"]; essl_mod_alias(suite) -> @@ -1201,13 +1140,6 @@ pssl_mod_actions(suite) -> pssl_mod_actions(Config) when is_list(Config) -> ssl_mod_actions(ssl, Config). -ossl_mod_actions(doc) -> - ["Module test: mod_actions - using new of configure old SSL"]; -ossl_mod_actions(suite) -> - []; -ossl_mod_actions(Config) when is_list(Config) -> - ssl_mod_actions(ossl, Config). - essl_mod_actions(doc) -> ["Module test: mod_actions - using new of configure new SSL"]; essl_mod_actions(suite) -> @@ -1233,13 +1165,6 @@ pssl_mod_security(suite) -> pssl_mod_security(Config) when is_list(Config) -> ssl_mod_security(ssl, Config). -ossl_mod_security(doc) -> - ["Module test: mod_security - using new of configure old SSL"]; -ossl_mod_security(suite) -> - []; -ossl_mod_security(Config) when is_list(Config) -> - ssl_mod_security(ossl, Config). - essl_mod_security(doc) -> ["Module test: mod_security - using new of configure new SSL"]; essl_mod_security(suite) -> @@ -1266,13 +1191,6 @@ pssl_mod_auth(suite) -> pssl_mod_auth(Config) when is_list(Config) -> ssl_mod_auth(ssl, Config). -ossl_mod_auth(doc) -> - ["Module test: mod_auth - using new of configure old SSL"]; -ossl_mod_auth(suite) -> - []; -ossl_mod_auth(Config) when is_list(Config) -> - ssl_mod_auth(ossl, Config). - essl_mod_auth(doc) -> ["Module test: mod_auth - using new of configure new SSL"]; essl_mod_auth(suite) -> @@ -1297,13 +1215,6 @@ pssl_mod_auth_api(suite) -> pssl_mod_auth_api(Config) when is_list(Config) -> ssl_mod_auth_api(ssl, Config). -ossl_mod_auth_api(doc) -> - ["Module test: mod_auth - using new of configure old SSL"]; -ossl_mod_auth_api(suite) -> - []; -ossl_mod_auth_api(Config) when is_list(Config) -> - ssl_mod_auth_api(ossl, Config). - essl_mod_auth_api(doc) -> ["Module test: mod_auth - using new of configure new SSL"]; essl_mod_auth_api(suite) -> @@ -1330,13 +1241,6 @@ pssl_mod_auth_mnesia_api(suite) -> pssl_mod_auth_mnesia_api(Config) when is_list(Config) -> ssl_mod_auth_mnesia_api(ssl, Config). -ossl_mod_auth_mnesia_api(doc) -> - ["Module test: mod_auth_mnesia_api - using new of configure old SSL"]; -ossl_mod_auth_mnesia_api(suite) -> - []; -ossl_mod_auth_mnesia_api(Config) when is_list(Config) -> - ssl_mod_auth_mnesia_api(ossl, Config). - essl_mod_auth_mnesia_api(doc) -> ["Module test: mod_auth_mnesia_api - using new of configure new SSL"]; essl_mod_auth_mnesia_api(suite) -> @@ -1361,13 +1265,6 @@ pssl_mod_htaccess(suite) -> pssl_mod_htaccess(Config) when is_list(Config) -> ssl_mod_htaccess(ssl, Config). -ossl_mod_htaccess(doc) -> - ["Module test: mod_htaccess - using new of configure old SSL"]; -ossl_mod_htaccess(suite) -> - []; -ossl_mod_htaccess(Config) when is_list(Config) -> - ssl_mod_htaccess(ossl, Config). - essl_mod_htaccess(doc) -> ["Module test: mod_htaccess - using new of configure new SSL"]; essl_mod_htaccess(suite) -> @@ -1392,13 +1289,6 @@ pssl_mod_cgi(suite) -> pssl_mod_cgi(Config) when is_list(Config) -> ssl_mod_cgi(ssl, Config). -ossl_mod_cgi(doc) -> - ["Module test: mod_cgi - using new of configure old SSL"]; -ossl_mod_cgi(suite) -> - []; -ossl_mod_cgi(Config) when is_list(Config) -> - ssl_mod_cgi(ossl, Config). - essl_mod_cgi(doc) -> ["Module test: mod_cgi - using new of configure new SSL"]; essl_mod_cgi(suite) -> @@ -1428,13 +1318,6 @@ pssl_mod_esi(suite) -> pssl_mod_esi(Config) when is_list(Config) -> ssl_mod_esi(ssl, Config). -ossl_mod_esi(doc) -> - ["Module test: mod_esi - using new of configure old SSL"]; -ossl_mod_esi(suite) -> - []; -ossl_mod_esi(Config) when is_list(Config) -> - ssl_mod_esi(ossl, Config). - essl_mod_esi(doc) -> ["Module test: mod_esi - using new of configure new SSL"]; essl_mod_esi(suite) -> @@ -1459,13 +1342,6 @@ pssl_mod_get(suite) -> pssl_mod_get(Config) when is_list(Config) -> ssl_mod_get(ssl, Config). -ossl_mod_get(doc) -> - ["Module test: mod_get - using new of configure old SSL"]; -ossl_mod_get(suite) -> - []; -ossl_mod_get(Config) when is_list(Config) -> - ssl_mod_get(ossl, Config). - essl_mod_get(doc) -> ["Module test: mod_get - using new of configure new SSL"]; essl_mod_get(suite) -> @@ -1490,13 +1366,6 @@ pssl_mod_head(suite) -> pssl_mod_head(Config) when is_list(Config) -> ssl_mod_head(ssl, Config). -ossl_mod_head(doc) -> - ["Module test: mod_head - using new of configure old SSL"]; -ossl_mod_head(suite) -> - []; -ossl_mod_head(Config) when is_list(Config) -> - ssl_mod_head(ossl, Config). - essl_mod_head(doc) -> ["Module test: mod_head - using new of configure new SSL"]; essl_mod_head(suite) -> @@ -1521,13 +1390,6 @@ pssl_mod_all(suite) -> pssl_mod_all(Config) when is_list(Config) -> ssl_mod_all(ssl, Config). -ossl_mod_all(doc) -> - ["All modules test - using new of configure old SSL"]; -ossl_mod_all(suite) -> - []; -ossl_mod_all(Config) when is_list(Config) -> - ssl_mod_all(ossl, Config). - essl_mod_all(doc) -> ["All modules test - using new of configure new SSL"]; essl_mod_all(suite) -> @@ -1552,13 +1414,6 @@ pssl_load_light(suite) -> pssl_load_light(Config) when is_list(Config) -> ssl_load_light(ssl, Config). -ossl_load_light(doc) -> - ["Test light load - using new of configure old SSL"]; -ossl_load_light(suite) -> - []; -ossl_load_light(Config) when is_list(Config) -> - ssl_load_light(ossl, Config). - essl_load_light(doc) -> ["Test light load - using new of configure new SSL"]; essl_load_light(suite) -> @@ -1584,13 +1439,6 @@ pssl_load_medium(suite) -> pssl_load_medium(Config) when is_list(Config) -> ssl_load_medium(ssl, Config). -ossl_load_medium(doc) -> - ["Test medium load - using new of configure old SSL"]; -ossl_load_medium(suite) -> - []; -ossl_load_medium(Config) when is_list(Config) -> - ssl_load_medium(ossl, Config). - essl_load_medium(doc) -> ["Test medium load - using new of configure new SSL"]; essl_load_medium(suite) -> @@ -1622,13 +1470,6 @@ pssl_load_heavy(suite) -> pssl_load_heavy(Config) when is_list(Config) -> ssl_load_heavy(ssl, Config). -ossl_load_heavy(doc) -> - ["Test heavy load - using new of configure old SSL"]; -ossl_load_heavy(suite) -> - []; -ossl_load_heavy(Config) when is_list(Config) -> - ssl_load_heavy(ossl, Config). - essl_load_heavy(doc) -> ["Test heavy load - using new of configure new SSL"]; essl_load_heavy(suite) -> @@ -1660,13 +1501,6 @@ pssl_dos_hostname(suite) -> pssl_dos_hostname(Config) when is_list(Config) -> ssl_dos_hostname(ssl, Config). -ossl_dos_hostname(doc) -> - ["Denial Of Service (DOS) attack test case - using new of configure old SSL"]; -ossl_dos_hostname(suite) -> - []; -ossl_dos_hostname(Config) when is_list(Config) -> - ssl_dos_hostname(ossl, Config). - essl_dos_hostname(doc) -> ["Denial Of Service (DOS) attack test case - using new of configure new SSL"]; essl_dos_hostname(suite) -> @@ -1692,13 +1526,6 @@ pssl_time_test(suite) -> pssl_time_test(Config) when is_list(Config) -> ssl_time_test(ssl, Config). -ossl_time_test(doc) -> - ["using new of configure old SSL"]; -ossl_time_test(suite) -> - []; -ossl_time_test(Config) when is_list(Config) -> - ssl_time_test(ossl, Config). - essl_time_test(doc) -> ["using new of configure new SSL"]; essl_time_test(suite) -> @@ -1738,14 +1565,6 @@ pssl_block_503(suite) -> pssl_block_503(Config) when is_list(Config) -> ssl_block_503(ssl, Config). -ossl_block_503(doc) -> - ["Check that you will receive status code 503 when the server" - " is blocked and 200 when its not blocked - using new of configure old SSL."]; -ossl_block_503(suite) -> - []; -ossl_block_503(Config) when is_list(Config) -> - ssl_block_503(ossl, Config). - essl_block_503(doc) -> ["Check that you will receive status code 503 when the server" " is blocked and 200 when its not blocked - using new of configure new SSL."]; @@ -1773,15 +1592,6 @@ pssl_block_disturbing_idle(suite) -> pssl_block_disturbing_idle(Config) when is_list(Config) -> ssl_block_disturbing_idle(ssl, Config). -ossl_block_disturbing_idle(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "distribing does not really make a difference in this case." - "Using new of configure old SSL"]; -ossl_block_disturbing_idle(suite) -> - []; -ossl_block_disturbing_idle(Config) when is_list(Config) -> - ssl_block_disturbing_idle(ossl, Config). - essl_block_disturbing_idle(doc) -> ["Check that you can block/unblock an idle server. The strategy " "distribing does not really make a difference in this case." @@ -1810,15 +1620,6 @@ pssl_block_non_disturbing_idle(suite) -> pssl_block_non_disturbing_idle(Config) when is_list(Config) -> ssl_block_non_disturbing_idle(ssl, Config). -ossl_block_non_disturbing_idle(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "non distribing does not really make a difference in this case." - "Using new of configure old SSL"]; -ossl_block_non_disturbing_idle(suite) -> - []; -ossl_block_non_disturbing_idle(Config) when is_list(Config) -> - ssl_block_non_disturbing_idle(ossl, Config). - essl_block_non_disturbing_idle(doc) -> ["Check that you can block/unblock an idle server. The strategy " "non distribing does not really make a difference in this case." @@ -1847,15 +1648,6 @@ pssl_block_disturbing_active(suite) -> pssl_block_disturbing_active(Config) when is_list(Config) -> ssl_block_disturbing_active(ssl, Config). -ossl_block_disturbing_active(doc) -> - ["Check that you can block/unblock an active server. The strategy " - "distribing means ongoing requests should be terminated." - "Using new of configure old SSL"]; -ossl_block_disturbing_active(suite) -> - []; -ossl_block_disturbing_active(Config) when is_list(Config) -> - ssl_block_disturbing_active(ossl, Config). - essl_block_disturbing_active(doc) -> ["Check that you can block/unblock an active server. The strategy " "distribing means ongoing requests should be terminated." @@ -1884,15 +1676,6 @@ pssl_block_non_disturbing_active(suite) -> pssl_block_non_disturbing_active(Config) when is_list(Config) -> ssl_block_non_disturbing_active(ssl, Config). -ossl_block_non_disturbing_active(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "non distribing means the ongoing requests should be compleated." - "Using new of configure old SSL"]; -ossl_block_non_disturbing_active(suite) -> - []; -ossl_block_non_disturbing_active(Config) when is_list(Config) -> - ssl_block_non_disturbing_active(ossl, Config). - essl_block_non_disturbing_active(doc) -> ["Check that you can block/unblock an idle server. The strategy " "non distribing means the ongoing requests should be compleated." @@ -1923,17 +1706,6 @@ pssl_block_disturbing_active_timeout_not_released(Config) when is_list(Config) -> ssl_block_disturbing_active_timeout_not_released(ssl, Config). -ossl_block_disturbing_active_timeout_not_released(doc) -> - ["Check that you can block an active server. The strategy " - "distribing means ongoing requests should be compleated" - "if the timeout does not occur." - "Using new of configure old SSL"]; -ossl_block_disturbing_active_timeout_not_released(suite) -> - []; -ossl_block_disturbing_active_timeout_not_released(Config) - when is_list(Config) -> - ssl_block_disturbing_active_timeout_not_released(ossl, Config). - essl_block_disturbing_active_timeout_not_released(doc) -> ["Check that you can block an active server. The strategy " "distribing means ongoing requests should be compleated" @@ -1967,17 +1739,6 @@ pssl_block_disturbing_active_timeout_released(Config) when is_list(Config) -> ssl_block_disturbing_active_timeout_released(ssl, Config). -ossl_block_disturbing_active_timeout_released(doc) -> - ["Check that you can block an active server. The strategy " - "distribing means ongoing requests should be terminated when" - "the timeout occurs." - "Using new of configure old SSL"]; -ossl_block_disturbing_active_timeout_released(suite) -> - []; -ossl_block_disturbing_active_timeout_released(Config) - when is_list(Config) -> - ssl_block_disturbing_active_timeout_released(ossl, Config). - essl_block_disturbing_active_timeout_released(doc) -> ["Check that you can block an active server. The strategy " "distribing means ongoing requests should be terminated when" @@ -2012,16 +1773,6 @@ pssl_block_non_disturbing_active_timeout_not_released(Config) when is_list(Config) -> ssl_block_non_disturbing_active_timeout_not_released(ssl, Config). -ossl_block_non_disturbing_active_timeout_not_released(doc) -> - ["Check that you can block an active server. The strategy " - "non non distribing means ongoing requests should be completed." - "Using new of configure old SSL"]; -ossl_block_non_disturbing_active_timeout_not_released(suite) -> - []; -ossl_block_non_disturbing_active_timeout_not_released(Config) - when is_list(Config) -> - ssl_block_non_disturbing_active_timeout_not_released(ossl, Config). - essl_block_non_disturbing_active_timeout_not_released(doc) -> ["Check that you can block an active server. The strategy " "non non distribing means ongoing requests should be completed." @@ -2056,17 +1807,6 @@ pssl_block_non_disturbing_active_timeout_released(Config) when is_list(Config) -> ssl_block_non_disturbing_active_timeout_released(ssl, Config). -ossl_block_non_disturbing_active_timeout_released(doc) -> - ["Check that you can block an active server. The strategy " - "non distribing means ongoing requests should be completed. " - "When the timeout occurs the block operation sohould be canceled." - "Using new of configure old SSL"]; -ossl_block_non_disturbing_active_timeout_released(suite) -> - []; -ossl_block_non_disturbing_active_timeout_released(Config) - when is_list(Config) -> - ssl_block_non_disturbing_active_timeout_released(ossl, Config). - essl_block_non_disturbing_active_timeout_released(doc) -> ["Check that you can block an active server. The strategy " "non distribing means ongoing requests should be completed. " @@ -2100,13 +1840,6 @@ pssl_block_disturbing_blocker_dies(suite) -> pssl_block_disturbing_blocker_dies(Config) when is_list(Config) -> ssl_block_disturbing_blocker_dies(ssl, Config). -ossl_block_disturbing_blocker_dies(doc) -> - ["using new of configure old SSL"]; -ossl_block_disturbing_blocker_dies(suite) -> - []; -ossl_block_disturbing_blocker_dies(Config) when is_list(Config) -> - ssl_block_disturbing_blocker_dies(ossl, Config). - essl_block_disturbing_blocker_dies(doc) -> ["using new of configure new SSL"]; essl_block_disturbing_blocker_dies(suite) -> @@ -2131,13 +1864,6 @@ pssl_block_non_disturbing_blocker_dies(suite) -> pssl_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> ssl_block_non_disturbing_blocker_dies(ssl, Config). -ossl_block_non_disturbing_blocker_dies(doc) -> - ["using new of configure old SSL"]; -ossl_block_non_disturbing_blocker_dies(suite) -> - []; -ossl_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> - ssl_block_non_disturbing_blocker_dies(ossl, Config). - essl_block_non_disturbing_blocker_dies(doc) -> ["using new of configure new SSL"]; essl_block_non_disturbing_blocker_dies(suite) -> @@ -2162,13 +1888,6 @@ pssl_restart_no_block(suite) -> pssl_restart_no_block(Config) when is_list(Config) -> ssl_restart_no_block(ssl, Config). -ossl_restart_no_block(doc) -> - ["using new of configure old SSL"]; -ossl_restart_no_block(suite) -> - []; -ossl_restart_no_block(Config) when is_list(Config) -> - ssl_restart_no_block(ossl, Config). - essl_restart_no_block(doc) -> ["using new of configure new SSL"]; essl_restart_no_block(suite) -> @@ -2193,13 +1912,6 @@ pssl_restart_disturbing_block(suite) -> pssl_restart_disturbing_block(Config) when is_list(Config) -> ssl_restart_disturbing_block(ssl, Config). -ossl_restart_disturbing_block(doc) -> - ["using new of configure old SSL"]; -ossl_restart_disturbing_block(suite) -> - []; -ossl_restart_disturbing_block(Config) when is_list(Config) -> - ssl_restart_disturbing_block(ossl, Config). - essl_restart_disturbing_block(doc) -> ["using new of configure new SSL"]; essl_restart_disturbing_block(suite) -> @@ -2257,13 +1969,6 @@ pssl_restart_non_disturbing_block(suite) -> pssl_restart_non_disturbing_block(Config) when is_list(Config) -> ssl_restart_non_disturbing_block(ssl, Config). -ossl_restart_non_disturbing_block(doc) -> - ["using new of configure old SSL"]; -ossl_restart_non_disturbing_block(suite) -> - []; -ossl_restart_non_disturbing_block(Config) when is_list(Config) -> - ssl_restart_non_disturbing_block(ossl, Config). - essl_restart_non_disturbing_block(doc) -> ["using new of configure new SSL"]; essl_restart_non_disturbing_block(suite) -> @@ -2659,7 +2364,6 @@ create_config(Config, Access, FileName) -> SSL = if (Type =:= ssl) orelse - (Type =:= ossl) orelse (Type =:= essl) -> [cline(["SSLCertificateFile ", filename:join(ServerRoot, "ssl/ssl_server.pem")]), @@ -3054,7 +2758,6 @@ create_ipv6_config(Config, FileName, Ipv6Address) -> SSL = if (SockType =:= ssl) orelse - (SockType =:= ossl) orelse (SockType =:= essl) -> [cline(["SSLCertificateFile ", filename:join(ServerRoot, "ssl/ssl_server.pem")]), diff --git a/lib/inets/test/httpd_time_test.erl b/lib/inets/test/httpd_time_test.erl index f39f9faff0..c54674be36 100644 --- a/lib/inets/test/httpd_time_test.erl +++ b/lib/inets/test/httpd_time_test.erl @@ -19,7 +19,7 @@ %% -module(httpd_time_test). --export([t/3, t1/2, t2/2, t3/2, t4/2]). +-export([t/3, t1/2, t2/2, t4/2]). -export([do/1, do/2, do/3, do/4, do/5]). @@ -45,10 +45,6 @@ t2(Host, Port) -> t(ssl, Host, Port). -t3(Host, Port) -> - t(ossl, Host, Port). - - t4(Host, Port) -> t(essl, Host, Port). diff --git a/lib/inets/test/inets_test_lib.erl b/lib/inets/test/inets_test_lib.erl index 2e19c41f16..ddb1a49394 100644 --- a/lib/inets/test/inets_test_lib.erl +++ b/lib/inets/test/inets_test_lib.erl @@ -340,9 +340,6 @@ connect_bin(SockType, Host, Port) -> connect_bin(ssl, Host, Port, Opts0) -> Opts = [binary, {packet,0} | Opts0], connect(ssl, Host, Port, Opts); -connect_bin(ossl, Host, Port, Opts0) -> - Opts = [{ssl_imp, old}, binary, {packet,0} | Opts0], - connect(ssl, Host, Port, Opts); connect_bin(essl, Host, Port, Opts0) -> Opts = [{ssl_imp, new}, binary, {packet,0}, {reuseaddr, true} | Opts0], connect(ssl, Host, Port, Opts); @@ -357,9 +354,6 @@ connect_byte(SockType, Host, Port) -> connect_byte(ssl, Host, Port, Opts0) -> Opts = [{packet,0} | Opts0], connect(ssl, Host, Port, Opts); -connect_byte(ossl, Host, Port, Opts0) -> - Opts = [{ssl_imp, old}, {packet,0} | Opts0], - connect(ssl, Host, Port, Opts); connect_byte(essl, Host, Port, Opts0) -> Opts = [{ssl_imp, new}, {packet,0} | Opts0], connect(ssl, Host, Port, Opts); @@ -421,8 +415,6 @@ connect(ip_comm, Host, Port, Opts) -> send(ssl, Socket, Data) -> ssl:send(Socket, Data); -send(ossl, Socket, Data) -> - ssl:send(Socket, Data); send(essl, Socket, Data) -> ssl:send(Socket, Data); send(ip_comm,Socket,Data) -> @@ -431,8 +423,6 @@ send(ip_comm,Socket,Data) -> close(ssl,Socket) -> catch ssl:close(Socket); -close(ossl,Socket) -> - catch ssl:close(Socket); close(essl,Socket) -> catch ssl:close(Socket); close(ip_comm,Socket) -> diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index d294d0006e..1df4558e45 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.7.2 +INETS_VSN = 5.8 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/inviso/doc/src/make.dep b/lib/inviso/doc/src/make.dep deleted file mode 100644 index 9459f74e6d..0000000000 --- a/lib/inviso/doc/src/make.dep +++ /dev/null @@ -1,27 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex inviso.tex inviso_as_lib.tex inviso_chapter.tex \ - inviso_lfm.tex inviso_lfm_tpfreader.tex inviso_rt.tex \ - inviso_rt_meta.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: inviso_users_guide_pic1.ps - diff --git a/lib/inviso/src/inviso_tool_lib.erl b/lib/inviso/src/inviso_tool_lib.erl index 7953acedd6..f221c4b6de 100644 --- a/lib/inviso/src/inviso_tool_lib.erl +++ b/lib/inviso/src/inviso_tool_lib.erl @@ -19,7 +19,7 @@ %% Support module to the inviso tool.
%%
%% Authors:
-%% Lennart �hman, [email protected]
+%% Lennart Öhman, [email protected]
%% -----------------------------------------------------------------------------
-module(inviso_tool_lib).
@@ -145,10 +145,10 @@ expand_module_names_2(Nodes,DirStr,ModStr,Opts) -> %% Always returns a regexp or {error,Reason}.
expand_module_names_special_regexp(Str) ->
StrLen=length(Str),
- case regexp:first_match(Str,"[0-9a-zA-Z_/]*") of
- {match,1,StrLen} -> % Ok, it is the special case.
+ case re:run(Str,"[0-9a-zA-Z_/]*") of
+ {match,[{0,StrLen}]} -> % Ok, it is the special case.
{ok,".*"++Str++".*"}; % Convert it to a proper regexp.
- {match,_,_} ->
+ {match,_} ->
{ok,Str}; % Keep it and hope it is a regexp.
nomatch ->
{ok,Str}; % Keep it and hope it is a regexp.
diff --git a/lib/jinterface/doc/src/make.dep b/lib/jinterface/doc/src/make.dep deleted file mode 100644 index a1b3c322c6..0000000000 --- a/lib/jinterface/doc/src/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex jinterface.tex jinterface_users_guide.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/jinterface/java_src/Makefile b/lib/jinterface/java_src/Makefile index 755ef46a8b..19f99831eb 100644 --- a/lib/jinterface/java_src/Makefile +++ b/lib/jinterface/java_src/Makefile @@ -29,9 +29,7 @@ VSN=$(JINTERFACE_VSN) # Common Macros # ---------------------------------------------------- -# call recursive make explicitly below -# due to separate makefiles for Ronja & OTP -# SUB_DIRECTORIES = com/ericsson/otp/erlang +SUB_DIRECTORIES = com/ericsson/otp/erlang SPECIAL_TARGETS = @@ -51,15 +49,5 @@ POM_SRC= $(POM_FILE).src $(POM_TARGET): $(POM_SRC) ../vsn.mk sed -e 's;%VSN%;$(VSN);' $< > $@ -# ---------------------------------------------------- -# Default Subdir Targets -# ---------------------------------------------------- - -.PHONY: debug opt instr release docs release_docs tests release_tests clean depend - -debug opt instr release docs release_docs tests release_tests clean depend: $(TARGET_FILES) - set -e; set -x; \ - case "$(MAKE)" in *clearmake*) tflag="-T";; *) tflag="";; esac; \ - if test -f com/ericsson/otp/erlang/ignore_config_record.inf; then xflag=$$tflag; fi; \ - (cd com/ericsson/otp/erlang && $(MAKE) -f Makefile.otp $$xflag $@) +include $(ERL_TOP)/make/otp_subdir.mk diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile.otp b/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile index d0ff9cda34..e772a2b0a5 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile.otp +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile @@ -96,7 +96,7 @@ docs: # include $(ERL_TOP)/make/otp_release_targets.mk release release_docs release_tests release_html: - $(MAKE) -f Makefile.otp $(MFLAGS) RELEASE_PATH=$(RELEASE_PATH) $(TARGET_MAKEFILE) $@_spec + $(MAKE) $(MFLAGS) RELEASE_PATH=$(RELEASE_PATH) $(TARGET_MAKEFILE) $@_spec release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/java_src/com/ericsson/otp/erlang diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java index 19ee92e0d0..23734bf83b 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java @@ -166,7 +166,7 @@ public class OtpErlangString extends OtpErlangObject implements Serializable, /** * Validate a code point according to Erlang definition; Unicode 3.0. * That is; valid in the range U+0..U+10FFFF, but not in the range - * U+D800..U+DFFF (surrogat pairs), nor U+FFFE..U+FFFF (non-characters). + * U+D800..U+DFFF (surrogat pairs). * * @param cp * the code point value to validate @@ -179,8 +179,7 @@ public class OtpErlangString extends OtpErlangObject implements Serializable, // Erlang definition of valid Unicode code points; // Unicode 3.0, XML, et.al. return (cp>>>16) <= 0x10 // in 0..10FFFF; Unicode range - && (cp & ~0x7FF) != 0xD800 // not in D800..DFFF; surrogate range - && (cp & ~1) != 0xFFFE; // not in FFFE..FFFF; non-characters + && (cp & ~0x7FF) != 0xD800; // not in D800..DFFF; surrogate range } /** diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/ignore_config_record.inf b/lib/jinterface/java_src/com/ericsson/otp/erlang/ignore_config_record.inf deleted file mode 100644 index 0a5053eba3..0000000000 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/ignore_config_record.inf +++ /dev/null @@ -1 +0,0 @@ -This file makes clearmake use the -T switch for this subdirectory diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml index e2dbcbe63d..26d1e27822 100644 --- a/lib/kernel/doc/src/heart.xml +++ b/lib/kernel/doc/src/heart.xml @@ -42,7 +42,7 @@ system.</p> <p>An Erlang runtime system to be monitored by a heart program, should be started with the command line flag <c>-heart</c> (see - also <seealso marker="erts:erl">erl(1)</seealso>. The <c>heart</c> + also <seealso marker="erts:erl">erl(1)</seealso>). The <c>heart</c> process is then started automatically:</p> <pre> % <input>erl -heart ...</input></pre> diff --git a/lib/kernel/doc/src/make.dep b/lib/kernel/doc/src/make.dep deleted file mode 100644 index f79d1c6367..0000000000 --- a/lib/kernel/doc/src/make.dep +++ /dev/null @@ -1,28 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: app.tex application.tex auth.tex book.tex \ - code.tex config.tex disk_log.tex erl_boot_server.tex \ - erl_ddll.tex erl_prim_loader_stub.tex erlang_stub.tex \ - error_handler.tex error_logger.tex file.tex \ - gen_sctp.tex gen_tcp.tex gen_udp.tex global.tex \ - global_group.tex heart.tex inet.tex inet_res.tex \ - init_stub.tex kernel_app.tex net_adm.tex net_kernel.tex \ - os.tex packages.tex pg2.tex ref_man.tex rpc.tex \ - seq_trace.tex user.tex wrap_log_reader.tex \ - zlib_stub.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/kernel/src/dist.hrl b/lib/kernel/include/dist.hrl index aea1ab81ba..aea1ab81ba 100644 --- a/lib/kernel/src/dist.hrl +++ b/lib/kernel/include/dist.hrl diff --git a/lib/kernel/src/dist_util.hrl b/lib/kernel/include/dist_util.hrl index f2b0598532..f2b0598532 100644 --- a/lib/kernel/src/dist_util.hrl +++ b/lib/kernel/include/dist_util.hrl diff --git a/lib/kernel/src/net_address.hrl b/lib/kernel/include/net_address.hrl index 5342076507..5342076507 100644 --- a/lib/kernel/src/net_address.hrl +++ b/lib/kernel/include/net_address.hrl diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 9db6014a7d..02be6b5036 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -118,11 +118,14 @@ MODULES = \ user_sup \ wrap_log_reader -HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl +HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl \ + ../include/dist.hrl ../include/dist_util.hrl \ + ../include/net_address.hrl + INTERNAL_HRL_FILES= application_master.hrl disk_log.hrl \ - net_address.hrl inet_dns.hrl inet_res.hrl \ + inet_dns.hrl inet_res.hrl \ inet_boot.hrl inet_config.hrl inet_int.hrl \ - dist.hrl dist_util.hrl inet_dns_record_adts.hrl + inet_dns_record_adts.hrl ERL_FILES= $(MODULES:%=%.erl) @@ -215,7 +218,7 @@ $(EBIN)/code_server.beam: ../include/file.hrl $(EBIN)/disk_log.beam: disk_log.hrl $(EBIN)/disk_log_1.beam: disk_log.hrl ../include/file.hrl $(EBIN)/disk_log_server.beam: disk_log.hrl -$(EBIN)/dist_util.beam: dist_util.hrl dist.hrl +$(EBIN)/dist_util.beam: ../include/dist_util.hrl ../include/dist.hrl $(EBIN)/erl_boot_server.beam: inet_boot.hrl $(EBIN)/erl_epmd.beam: inet_int.hrl erl_epmd.hrl $(EBIN)/file.beam: ../include/file.hrl @@ -226,7 +229,7 @@ $(EBIN)/global.beam: ../../stdlib/include/ms_transform.hrl $(EBIN)/hipe_unified_loader.beam: ../../hipe/main/hipe.hrl hipe_ext_format.hrl $(EBIN)/inet.beam: ../include/inet.hrl inet_int.hrl ../include/inet_sctp.hrl $(EBIN)/inet6_tcp.beam: inet_int.hrl -$(EBIN)/inet6_tcp_dist.beam: net_address.hrl dist.hrl dist_util.hrl +$(EBIN)/inet6_tcp_dist.beam: ../include/net_address.hrl ../include/dist.hrl ../include/dist_util.hrl $(EBIN)/inet6_udp.beam: inet_int.hrl $(EBIN)/inet6_sctp.beam: inet_int.hrl $(EBIN)/inet_config.beam: inet_config.hrl ../include/inet.hrl @@ -237,10 +240,10 @@ $(EBIN)/inet_hosts.beam: ../include/inet.hrl $(EBIN)/inet_parse.beam: ../include/file.hrl $(EBIN)/inet_res.beam: ../include/inet.hrl inet_res.hrl inet_dns.hrl inet_int.hrl $(EBIN)/inet_tcp.beam: inet_int.hrl -$(EBIN)/inet_udp_dist.beam: net_address.hrl dist.hrl dist_util.hrl +$(EBIN)/inet_udp_dist.beam: ../include/net_address.hrl ../include/dist.hrl ../include/dist_util.hrl $(EBIN)/inet_udp.beam: inet_int.hrl $(EBIN)/inet_sctp.beam: inet_int.hrl ../include/inet_sctp.hrl -$(EBIN)/net_kernel.beam: net_address.hrl +$(EBIN)/net_kernel.beam: ../include/net_address.hrl $(EBIN)/os.beam: ../include/file.hrl $(EBIN)/ram_file.beam: ../include/file.hrl $(EBIN)/wrap_log_reader.beam: disk_log.hrl ../include/file.hrl diff --git a/lib/kernel/src/application.erl b/lib/kernel/src/application.erl index fa3a4c3d36..caac4d926c 100644 --- a/lib/kernel/src/application.erl +++ b/lib/kernel/src/application.erl @@ -28,8 +28,6 @@ -export([get_application/0, get_application/1, info/0]). -export([start_type/0]). --export([behaviour_info/1]). - %%%----------------------------------------------------------------- -type start_type() :: 'normal' @@ -59,12 +57,12 @@ %%------------------------------------------------------------------ --spec behaviour_info(atom()) -> 'undefined' | [{atom(), byte()}]. +-callback start(StartType :: normal | {takeover, node()} | {failover, node()}, + StartArgs :: term()) -> + {ok, pid()} | {ok, pid(), State :: term()} | {error, Reason :: term}. -behaviour_info(callbacks) -> - [{start,2},{stop,1}]; -behaviour_info(_Other) -> - undefined. +-callback stop(State :: term()) -> + term(). %%%----------------------------------------------------------------- %%% This module is API towards application_controller and diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index 9b8d2db437..d6bc23be6d 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -1240,20 +1240,29 @@ is_owner(Pid, L) -> %% ok | throw(Error) rename_file(File, NewFile, halt) -> - file:rename(File, NewFile); + case file:rename(File, NewFile) of + ok -> + ok; + Else -> + file_error(NewFile, Else) + end; rename_file(File, NewFile, wrap) -> rename_file(wrap_file_extensions(File), File, NewFile, ok). -rename_file([Ext|Exts], File, NewFile, Res) -> - NRes = case file:rename(add_ext(File, Ext), add_ext(NewFile, Ext)) of +rename_file([Ext|Exts], File, NewFile0, Res) -> + NewFile = add_ext(NewFile0, Ext), + NRes = case file:rename(add_ext(File, Ext), NewFile) of ok -> Res; Else -> - Else + file_error(NewFile, Else) end, - rename_file(Exts, File, NewFile, NRes); + rename_file(Exts, File, NewFile0, NRes); rename_file([], _File, _NewFiles, Res) -> Res. +file_error(FileName, {error, Error}) -> + {error, {file_error, FileName, Error}}. + %% "Old" error messages have been kept, arg_mismatch has been added. %%-spec compare_arg(dlog_options(), #arg{}, compare_arg([], _A, none, _OrigHead) -> @@ -1947,7 +1956,8 @@ monitor_request(Pid, Req) -> receive {'DOWN', Ref, process, Pid, _Info} -> {error, no_such_log}; - {disk_log, Pid, Reply} -> + {disk_log, Pid, Reply} when not is_tuple(Reply) orelse + element(2, Reply) =/= disk_log_stopped -> erlang:demonitor(Ref), receive {'DOWN', Ref, process, Pid, _Reason} -> diff --git a/lib/kernel/src/error_handler.erl b/lib/kernel/src/error_handler.erl index e1f99bf417..a67b11a888 100644 --- a/lib/kernel/src/error_handler.erl +++ b/lib/kernel/src/error_handler.erl @@ -88,12 +88,12 @@ int() -> int. -spec crash(atom(), [term()]) -> no_return(). crash(Fun, Args) -> - crash({Fun,Args}). + crash({Fun,Args,[]}). -spec crash(atom(), atom(), arity()) -> no_return(). crash(M, F, A) -> - crash({M,F,A}). + crash({M,F,A,[]}). -spec crash(tuple()) -> no_return(). @@ -101,7 +101,8 @@ crash(Tuple) -> try erlang:error(undef) catch error:undef -> - erlang:raise(error, undef, [Tuple|tl(erlang:get_stacktrace())]) + Stk = [Tuple|tl(erlang:get_stacktrace())], + erlang:raise(error, undef, Stk) end. %% If the code_server has not been started yet dynamic code loading @@ -127,7 +128,7 @@ ensure_loaded(Module) -> -spec stub_function(atom(), atom(), [_]) -> no_return(). stub_function(Mod, Func, Args) -> - exit({undef,[{Mod,Func,Args}]}). + exit({undef,[{Mod,Func,Args,[]}]}). check_inheritance(Module, Args) -> Attrs = erlang:get_module_info(Module, attributes), diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 5e4e1b0ba8..706c60caaf 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -1163,7 +1163,7 @@ path_open_first([Path|Rest], Name, Mode, LastError) -> {error, _} = Error -> Error; FilePath -> - FileName = filename:join(FilePath, Name), + FileName = fname_join(FilePath, Name), case open(FileName, Mode) of {ok, Fd} -> {ok, Fd, FileName}; @@ -1176,6 +1176,11 @@ path_open_first([Path|Rest], Name, Mode, LastError) -> path_open_first([], _Name, _Mode, LastError) -> {error, LastError}. +fname_join(".", Name) -> + Name; +fname_join(Dir, Name) -> + filename:join(Dir, Name). + %%%----------------------------------------------------------------- %%% Utility functions. diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index c34f2ddeb0..e33b4830ab 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -117,8 +117,9 @@ server1(Iport, Oport, Shell) -> {Curr,Shell1} = case init:get_argument(remsh) of {ok,[[Node]]} -> - RShell = {list_to_atom(Node),shell,start,[]}, - RGr = group:start(self(), RShell), + ANode = list_to_atom(Node), + RShell = {ANode,shell,start,[]}, + RGr = group:start(self(), RShell, rem_sh_opts(ANode)), {RGr,RShell}; E when E =:= error ; E =:= {ok,[[]]} -> {group:start(self(), Shell),Shell} @@ -134,6 +135,9 @@ server1(Iport, Oport, Shell) -> %% Enter the server loop. server_loop(Iport, Oport, Curr, User, Gr). +rem_sh_opts(Node) -> + [{expand_fun,fun(B)-> rpc:call(Node,edlin_expand,expand,[B]) end}]. + %% start_user() %% Start a group leader process and register it as 'user', unless, %% of course, a 'user' already exists. diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index b677f34ed0..10ab3e4370 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -995,9 +995,9 @@ purge_stacktrace(Config) when is_list(Config) -> error:function_clause -> ?line code:load_file(code_b_test), ?line case erlang:get_stacktrace() of - [{?MODULE,_,[a]}, - {code_b_test,call,2}, - {?MODULE,purge_stacktrace,1}|_] -> + [{?MODULE,_,[a],_}, + {code_b_test,call,2,_}, + {?MODULE,purge_stacktrace,1,_}|_] -> ?line false = code:purge(code_b_test), ?line [] = erlang:get_stacktrace() end @@ -1007,8 +1007,8 @@ purge_stacktrace(Config) when is_list(Config) -> error:function_clause -> ?line code:load_file(code_b_test), ?line case erlang:get_stacktrace() of - [{code_b_test,call,[nofun,2]}, - {?MODULE,purge_stacktrace,1}|_] -> + [{code_b_test,call,[nofun,2],_}, + {?MODULE,purge_stacktrace,1,_}|_] -> ?line false = code:purge(code_b_test), ?line [] = erlang:get_stacktrace() end @@ -1019,8 +1019,8 @@ purge_stacktrace(Config) when is_list(Config) -> error:badarg -> ?line code:load_file(code_b_test), ?line case erlang:get_stacktrace() of - [{code_b_test,call,Args}, - {?MODULE,purge_stacktrace,1}|_] -> + [{code_b_test,call,Args,_}, + {?MODULE,purge_stacktrace,1,_}|_] -> ?line false = code:purge(code_b_test), ?line [] = erlang:get_stacktrace() end @@ -1481,7 +1481,7 @@ do_on_load_error(ReturnValue) -> ?line ErrorPid ! ReturnValue, receive {'DOWN',Ref,process,_,Exit} -> - ?line {undef,[{on_load_error,main,[]}|_]} = Exit + ?line {undef,[{on_load_error,main,[],_}|_]} = Exit end. native_early_modules(suite) -> []; diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl index ee1e2319b5..ad987fe7a7 100644 --- a/lib/kernel/test/disk_log_SUITE.erl +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -1831,11 +1831,16 @@ block_queue2(Conf) when is_list(Conf) -> %% Asynchronous stuff is ignored. ?line ok = disk_log:balog_terms(n, [<<"foo">>,<<"bar">>]), ?line ok = disk_log:balog_terms(n, [<<"more">>,<<"terms">>]), + Parent = self(), ?line Fun = - fun() -> {error,disk_log_stopped} = disk_log:sync(n) + fun() -> + {error,no_such_log} = disk_log:sync(n), + receive {disk_log, _, {error, disk_log_stopped}} -> ok end, + Parent ! disk_log_stopped_ok end, ?line spawn(Fun), ?line ok = sync_do(Pid, close), + ?line receive disk_log_stopped_ok -> ok end, ?line sync_do(Pid, terminate), ?line {ok,<<>>} = file:read_file(File ++ ".1"), ?line del(File, No), @@ -2708,7 +2713,7 @@ error_log(Conf) when is_list(Conf) -> % reopen (rename) fails, the log is terminated, ./File.2/ exists ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, {format, external},{size, 100000}]), - ?line {error, eisdir} = disk_log:reopen(n, LDir), + ?line {error, {file_error, _, eisdir}} = disk_log:reopen(n, LDir), ?line true = (P0 == pps()), ?line file:delete(File), @@ -2719,7 +2724,7 @@ error_log(Conf) when is_list(Conf) -> ?line {ok, n} = disk_log:open([{name, n}, {file, File2}, {type, wrap}, {format, external},{size, {100, No}}]), ?line ok = disk_log:blog_terms(n, [B,B,B]), - ?line {error, eisdir} = disk_log:reopen(n, File), + ?line {error, {file_error, _, eisdir}} = disk_log:reopen(n, File), ?line {error, no_such_log} = disk_log:close(n), ?line del(File2, No), ?line del(File, No), diff --git a/lib/kernel/test/pg2_SUITE.erl b/lib/kernel/test/pg2_SUITE.erl index 0ac34e735c..520b53b4e4 100644 --- a/lib/kernel/test/pg2_SUITE.erl +++ b/lib/kernel/test/pg2_SUITE.erl @@ -47,6 +47,7 @@ init_per_testcase(Case, Config) -> [{?TESTCASE, Case}, {watchdog, Dog} | Config]. end_per_testcase(_Case, _Config) -> + test_server_ctrl:kill_slavenodes(), Dog = ?config(watchdog, _Config), test_server:timetrap_cancel(Dog), ok. diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl index 4ad9c6923d..74bafe8935 100644 --- a/lib/kernel/test/zlib_SUITE.erl +++ b/lib/kernel/test/zlib_SUITE.erl @@ -42,8 +42,8 @@ end end()). --define(BARG, {'EXIT',{badarg,[{zlib,_,_}|_]}}). --define(DATA_ERROR, {'EXIT',{data_error,[{zlib,_,_}|_]}}). +-define(BARG, {'EXIT',{badarg,[{zlib,_,_,_}|_]}}). +-define(DATA_ERROR, {'EXIT',{data_error,[{zlib,_,_,_}|_]}}). init_per_testcase(_Func, Config) -> Dog = test_server:timetrap(test_server:seconds(60)), diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index 8be265e79d..76c62ece67 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 2.14.5 +KERNEL_VSN = 2.15 diff --git a/lib/megaco/.gitignore b/lib/megaco/.gitignore new file mode 100644 index 0000000000..1c5979cd62 --- /dev/null +++ b/lib/megaco/.gitignore @@ -0,0 +1,3 @@ +examples/meas/Makefile +examples/meas/meas.sh.skel +examples/meas/mstone1.sh.skel diff --git a/lib/megaco/configure.in b/lib/megaco/configure.in index 8f94a4efcf..b88e17ec85 100644 --- a/lib/megaco/configure.in +++ b/lib/megaco/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script. -*-m4-*- dnl dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 2001-2010. All Rights Reserved. +dnl Copyright Ericsson AB 2001-2011. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in @@ -273,5 +273,6 @@ if test "$PERL" = no_perl; then AC_MSG_ERROR([Perl is required to build the flex scanner!]) fi +AC_OUTPUT(examples/meas/Makefile:examples/meas/Makefile.in) AC_OUTPUT(src/flex/$host/Makefile:src/flex/Makefile.in) diff --git a/lib/megaco/doc/src/Makefile b/lib/megaco/doc/src/Makefile index 4b3c117b20..f782afc3f6 100644 --- a/lib/megaco/doc/src/Makefile +++ b/lib/megaco/doc/src/Makefile @@ -27,14 +27,6 @@ VSN=$(MEGACO_VSN) APPLICATION=megaco # ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - -# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) @@ -73,35 +65,10 @@ EXTRA_FILES = \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi $(APP_FILE) - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - - -TOP_HTML_FILES = $(INDEX_TARGET) - -endif - INDEX_FILE = index.html INDEX_SRC = $(INDEX_FILE).src INDEX_TARGET = $(DOCDIR)/$(INDEX_FILE) @@ -131,8 +98,6 @@ $(HTMLDIR)/%.jpg: %.jpg $(HTMLDIR)/%.png: %.png $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man ldocs: local_docs $(INDEX_TARGET) @@ -147,41 +112,6 @@ clean clean_docs: clean_html clean_man rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html imgs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: imgs $(HTML_FILES) $(TOP_HTML_FILES) - -mhtml: html $(HTML_REF3_FILES) $(HTML_CHAPTER_FILES) - -clean: clean_html clean_man clean_pdf - rm -f core *~ - rm -f *.aux *.cites *.citeshd *.dvi *.idx *.ilg *.ind - rm -f *.indhd *.lof *.lofhd *.lot *.lothd *.otpdef - rm -f *.otpuse *.terms *.termshd *.toc *.makeindexlog *.dvipslog - rm -f *.bib *.bbl *.blg *.bibhd - -clean_pdf: - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f $(TEX_FILES_USERS_GUIDE) - rm -f $(TEX_FILES_REF_MAN) - rm -f $(TEX_FILES_BOOK) - -endif - clean_man: rm -f $(MAN3DIR)/* @@ -203,8 +133,6 @@ debug opt: info: @echo "->Makefile<-" @echo "" - @echo "DOCSUPPORT = $(DOCSUPPORT)" - @echo "" @echo "INDEX_FILE = $(INDEX_FILE)" @echo "INDEX_SRC = $(INDEX_SRC)" @echo "INDEX_TARGET = $(INDEX_TARGET)" @@ -216,10 +144,6 @@ info: @echo "" @echo "IMG_FILES = $(IMG_FILES)" @echo "" - @echo "TEX_FILES_USERS_GUIDE = $(TEX_FILES_USERS_GUIDE)" - @echo "TEX_FILES_REF_MAN = $(TEX_FILES_REF_MAN)" - @echo "TEX_FILES_BOOK = $(TEX_FILES_BOOK)" - @echo "" @echo "MAN3_FILES = $(MAN3_FILES)" @echo "" @echo "HTML_FILES = $(HTML_FILES)" @@ -236,8 +160,6 @@ info: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -250,33 +172,6 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/standard $(INSTALL_DATA) $(STANDARDS) $(RELSYSDIR)/doc/standard -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(IMG_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(TOP_HTML_FILES) $(RELSYSDIR)/doc - $(INSTALL_DIR) $(RELSYSDIR)/doc/standard - $(INSTALL_DATA) $(STANDARDS) $(RELSYSDIR)/doc/standard -endif -endif - -endif - release_spec: $(HTMLDIR)/megaco_architecture.html: megaco_architecture.xml diff --git a/lib/megaco/doc/src/make.dep b/lib/megaco/doc/src/make.dep deleted file mode 100644 index 0e2040ab50..0000000000 --- a/lib/megaco/doc/src/make.dep +++ /dev/null @@ -1,59 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %CopyrightBegin% -# -# Copyright Ericsson AB 2001-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% - -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex megaco.tex megaco_architecture.tex \ - megaco_codec_meas.tex \ - megaco_codec_mstone1.tex megaco_codec_mstone2.tex \ - megaco_codec_transform.tex \ - megaco_debug.tex megaco_edist_compress.tex \ - megaco_encode.tex megaco_encoder.tex megaco_examples.tex \ - megaco_flex_scanner.tex megaco_intro.tex megaco_mib.tex \ - megaco_performance.tex megaco_run.tex megaco_tcp.tex \ - megaco_transport.tex megaco_transport_mechanisms.tex \ - megaco_udp.tex megaco_user.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: call_flow.ps call_flow_cont.ps distr_node_config.ps \ - megaco_sys_arch.ps single_node_config.ps - -book.dvi: mstone1.ps - -book.dvi: MG-startup_flow_noMID.ps MGC_startup_call_flow.ps \ - MG_startup_call_flow.ps - diff --git a/lib/megaco/doc/src/notes.xml b/lib/megaco/doc/src/notes.xml index 2aba8db71b..baf8c6a201 100644 --- a/lib/megaco/doc/src/notes.xml +++ b/lib/megaco/doc/src/notes.xml @@ -36,6 +36,61 @@ section is the version number of Megaco.</p> + <section><title>Megaco 3.15.1.2</title> + + <p>Version 3.15.1.2 supports code replacement in runtime from/to + version 3.15.1.1, 3.15.1 and 3.15.</p> + + <section> + <title>Improvements and new features</title> + +<!-- + <p>-</p> +--> + + <list type="bulleted"> + <item> + <p>Minor improvemnts to the emasurement tool mstone1. </p> + <p>Own Id: OTP-9604</p> + </item> + + <item> + <p>ASN.1 no longer makes use of a driver to accelerate encode/decode, + instead it uses NIFs. The encoding config option is <em>still</em> + the same, i.e. <c>driver</c>. </p> + <p>Own Id: OTP-9672</p> + </item> + + <item> + <p>The profiling test tool has been rewritten. </p> + <p>Håkan Mattsson</p> + <p>Own Id: OTP-9679</p> + </item> + + </list> + + </section> + + <section> + <title>Fixed bugs and malfunctions</title> + + <p>-</p> + + <!-- + <list type="bulleted"> + <item> + <p>Fixing miscellaneous things detected by dialyzer. </p> + <p>Own Id: OTP-9075</p> + </item> + + </list> + --> + + </section> + + </section> <!-- 3.15.1.2 --> + + <section><title>Megaco 3.15.1.1</title> <p>Version 3.15.1.1 supports code replacement in runtime from/to diff --git a/lib/megaco/examples/meas/Makefile b/lib/megaco/examples/meas/Makefile.in index 0a6cbb44a6..6af7ef6c65 100644 --- a/lib/megaco/examples/meas/Makefile +++ b/lib/megaco/examples/meas/Makefile.in @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# Copyright Ericsson AB 2002-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 @@ -35,12 +35,19 @@ VSN=$(MEGACO_VSN) # ---------------------------------------------------- +# Configured variables +# ---------------------------------------------------- +PERL = @PERL@ + + +# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/megaco-$(VSN) EXAMPLE_RELSYSDIR = $(RELSYSDIR)/examples MEAS_RELSYSDIR = $(EXAMPLE_RELSYSDIR)/meas + # ---------------------------------------------------- # Target Specs # ---------------------------------------------------- @@ -49,9 +56,13 @@ include modules.mk ERL_FILES = $(MODULES:%=%.erl) -TARGET_FILES = \ +SCRIPT_SKELETONS = $(SCRIPT_SKELETON_SRC:%.src=%) + +ERL_TARGETS = \ $(ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) +TARGET_FILES = $(SCRIPT_SKELETONS) $(ERL_TARGETS) + # ---------------------------------------------------- # FLAGS @@ -91,12 +102,27 @@ debug: opt: $(TARGET_FILES) +script_skeletons: $(SCRIPT_SKELETONS) + +info: + @echo "MODULES = $(MODULES)" + @echo "ERL_FILED = $(ERL_FILES)" + @echo "" + @echo "SCRIPT_SKELETON_SRC = $(SCRIPT_SKELETON_SRC)" + @echo "SCRIPT_SKELETONS = $(SCRIPT_SKELETONS)" + @echo "" + @echo "TARGET_FILES = $(TARGET_FILES)" + @echo "" + clean: rm -f $(TARGET_FILES) rm -f errs core *~ docs: +conf: + cd ../..; $(MAKE) conf + # ---------------------------------------------------- # Release Target @@ -120,6 +146,14 @@ release_docs_spec: # Include dependencies # ---------------------------------------------------- +meas.sh.skel: meas.sh.skel.src + @echo "transforming $< to $@" + $(PERL) -p -e 's?%VSN%?$(VSN)? ' < $< > $@ + +mstone1.sh.skel: mstone1.sh.skel.src + @echo "transforming $< to $@" + $(PERL) -p -e 's?%VSN%?$(VSN)? ' < $< > $@ + megaco_codec_transform.$(EMULATOR): megaco_codec_transform.erl megaco_codec_meas.$(EMULATOR): megaco_codec_meas.erl diff --git a/lib/megaco/examples/meas/meas.sh.skel b/lib/megaco/examples/meas/meas.sh.skel.src index 76745ed8f4..c7bd6cdd2a 100644 --- a/lib/megaco/examples/meas/meas.sh.skel +++ b/lib/megaco/examples/meas/meas.sh.skel.src @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2007-2010. All Rights Reserved. +# Copyright Ericsson AB 2007-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 @@ -22,7 +22,7 @@ # ERL_HOME=<path to otp top dir> -MEGACO_HOME=$ERL_HOME/lib/erlang/lib/<megaco dir> +MEGACO_HOME=$ERL_HOME/lib/erlang/lib/megaco-%VSN% MEAS_HOME=$MEGACO_HOME/examples/meas PATH=$ERL_HOME/bin:$PATH diff --git a/lib/megaco/examples/meas/modules.mk b/lib/megaco/examples/meas/modules.mk index 8f1b45c8a6..26979933d7 100644 --- a/lib/megaco/examples/meas/modules.mk +++ b/lib/megaco/examples/meas/modules.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# Copyright Ericsson AB 2002-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 @@ -17,9 +17,9 @@ # # %CopyrightEnd% -SCRIPT_SKELETONS = \ - meas.sh.skel \ - mstone1.sh.skel +SCRIPT_SKELETON_SRC = \ + meas.sh.skel.src \ + mstone1.sh.skel.src MESSAGE_PACKAGES = \ time_test.msgs diff --git a/lib/megaco/examples/meas/mstone1.sh.skel b/lib/megaco/examples/meas/mstone1.sh.skel.src index b7c7e41007..54a6c61a58 100644 --- a/lib/megaco/examples/meas/mstone1.sh.skel +++ b/lib/megaco/examples/meas/mstone1.sh.skel.src @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2007-2009. All Rights Reserved. +# Copyright Ericsson AB 2007-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 @@ -59,7 +59,7 @@ Options: " ERL_HOME=<path to otp top dir> -MEGACO_HOME=$ERL_HOME/lib/erlang/lib/<megaco dir> +MEGACO_HOME=$ERL_HOME/lib/erlang/lib/megaco-%VSN% MEAS_HOME=$MEGACO_HOME/examples/meas PATH=$ERL_HOME/bin:$PATH diff --git a/lib/megaco/src/app/megaco.appup.src b/lib/megaco/src/app/megaco.appup.src index 7107178d1a..7f6fe0c733 100644 --- a/lib/megaco/src/app/megaco.appup.src +++ b/lib/megaco/src/app/megaco.appup.src @@ -139,10 +139,17 @@ %% | %% v %% 3.15.1.1 +%% | +%% v +%% 3.15.1.2 %% %% {"%VSN%", [ + {"3.15.1.1", + [ + ] + }, {"3.15.1", [ ] @@ -160,6 +167,10 @@ } ], [ + {"3.15.1.1", + [ + ] + }, {"3.15.1", [ ] diff --git a/lib/megaco/src/binary/depend.mk b/lib/megaco/src/binary/depend.mk index 5ec4977175..c9ca34bcf6 100644 --- a/lib/megaco/src/binary/depend.mk +++ b/lib/megaco/src/binary/depend.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2009. All Rights Reserved. +# Copyright Ericsson AB 2001-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 @@ -24,9 +24,9 @@ # but for per_bin it means that a stage in the encode # is done in the asn1 driver. # -# +driver +# +nif # For ber_bin this means that part of the decode is done -# in the asn1 driver. +# in the asn1 nif. # # +asn1config # This is only used by the ber_bin, and means that @@ -45,22 +45,22 @@ endif BER_V1_FLAGS = $(ASN1_CT_OPTS) BER_BIN_V1_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize -BER_BIN_DRV_V1_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +driver +BER_BIN_DRV_V1_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +nif BER_V2_FLAGS = $(ASN1_CT_OPTS) BER_BIN_V2_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize -BER_BIN_DRV_V2_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +driver +BER_BIN_DRV_V2_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +nif BER_PREV3A_FLAGS = $(ASN1_CT_OPTS) BER_BIN_PREV3A_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize -BER_BIN_DRV_PREV3A_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +driver +BER_BIN_DRV_PREV3A_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +nif BER_PREV3B_FLAGS = $(ASN1_CT_OPTS) BER_BIN_PREV3B_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize -BER_BIN_DRV_PREV3B_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +driver +BER_BIN_DRV_PREV3B_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +nif BER_PREV3C_FLAGS = $(ASN1_CT_OPTS) BER_BIN_PREV3C_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize -BER_BIN_DRV_PREV3C_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +driver +BER_BIN_DRV_PREV3C_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +nif BER_V3_FLAGS = $(ASN1_CT_OPTS) BER_BIN_V3_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize -BER_BIN_DRV_V3_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +driver +BER_BIN_DRV_V3_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +nif PER_V1_FLAGS = $(ASN1_CT_OPTS) PER_BIN_V1_FLAGS = $(ASN1_CT_OPTS) PER_BIN_DRV_V1_FLAGS = $(ASN1_CT_OPTS) +optimize @@ -83,17 +83,16 @@ PER_BIN_DRV_V3_FLAGS = $(ASN1_CT_OPTS) +optimize # --- Version 1 --- -$(BER_ASN1_V1_SPEC).erl $(BER_ASN1_V1_SPEC).hrl: \ +$(BER_ASN1_V1_SPEC).erl: \ $(BER_ASN1_V1_SPEC).set.asn \ $(ASN1_V1_SPEC).asn @echo "$(BER_ASN1_V1_SPEC):" $(ERLC) -bber $(BER_V1_FLAGS) $(BER_ASN1_V1_SPEC).set.asn $(EBIN)/$(BER_ASN1_V1_SPEC).$(EMULATOR): \ - $(BER_ASN1_V1_SPEC).erl \ - $(BER_ASN1_V1_SPEC).hrl + $(BER_ASN1_V1_SPEC).erl -$(BER_BIN_ASN1_V1_SPEC).erl $(BER_BIN_ASN1_V1_SPEC).hrl: \ +$(BER_BIN_ASN1_V1_SPEC).erl: \ $(BER_BIN_ASN1_V1_SPEC).set.asn \ $(BER_BIN_ASN1_V1_SPEC).asn1config \ $(ASN1_V1_SPEC).asn @@ -101,10 +100,9 @@ $(BER_BIN_ASN1_V1_SPEC).erl $(BER_BIN_ASN1_V1_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_V1_FLAGS) $(BER_BIN_ASN1_V1_SPEC).set.asn $(EBIN)/$(BER_BIN_ASN1_V1_SPEC).$(EMULATOR): \ - $(BER_BIN_ASN1_V1_SPEC).erl \ - $(BER_BIN_ASN1_V1_SPEC).hrl + $(BER_BIN_ASN1_V1_SPEC).erl -$(BER_BIN_DRV_ASN1_V1_SPEC).erl $(BER_BIN_DRV_ASN1_V1_SPEC).hrl: \ +$(BER_BIN_DRV_ASN1_V1_SPEC).erl: \ $(BER_BIN_DRV_ASN1_V1_SPEC).set.asn \ $(BER_BIN_DRV_ASN1_V1_SPEC).asn1config \ $(ASN1_V1_SPEC).asn @@ -112,53 +110,48 @@ $(BER_BIN_DRV_ASN1_V1_SPEC).erl $(BER_BIN_DRV_ASN1_V1_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_DRV_V1_FLAGS) $(BER_BIN_DRV_ASN1_V1_SPEC).set.asn $(EBIN)/$(BER_BIN_DRV_ASN1_V1_SPEC).$(EMULATOR): \ - $(BER_BIN_DRV_ASN1_V1_SPEC).erl \ - $(BER_BIN_DRV_ASN1_V1_SPEC).hrl + $(BER_BIN_DRV_ASN1_V1_SPEC).erl -$(PER_ASN1_V1_SPEC).erl $(PER_ASN1_V1_SPEC).hrl: \ +$(PER_ASN1_V1_SPEC).erl: \ $(PER_ASN1_V1_SPEC).set.asn \ $(ASN1_V1_SPEC).asn @echo "$(PER_ASN1_V1_SPEC):" $(ERLC) -bper $(PER_V1_FLAGS) $(PER_ASN1_V1_SPEC).set.asn $(EBIN)/$(PER_ASN1_V1_SPEC).$(EMULATOR): \ - $(PER_ASN1_V1_SPEC).erl \ - $(PER_ASN1_V1_SPEC).hrl + $(PER_ASN1_V1_SPEC).erl -$(PER_BIN_ASN1_V1_SPEC).erl $(PER_BIN_ASN1_V1_SPEC).hrl: \ +$(PER_BIN_ASN1_V1_SPEC).erl: \ $(PER_BIN_ASN1_V1_SPEC).set.asn \ $(ASN1_V1_SPEC).asn @echo "$(PER_BIN_ASN1_V1_SPEC):" $(ERLC) -bper_bin $(PER_BIN_V1_FLAGS) $(PER_BIN_ASN1_V1_SPEC).set.asn $(EBIN)/$(PER_BIN_ASN1_V1_SPEC).$(EMULATOR): \ - $(PER_BIN_ASN1_V1_SPEC).erl \ - $(PER_BIN_ASN1_V1_SPEC).hrl + $(PER_BIN_ASN1_V1_SPEC).erl -$(PER_BIN_DRV_ASN1_V1_SPEC).erl $(PER_BIN_DRV_ASN1_V1_SPEC).hrl: \ +$(PER_BIN_DRV_ASN1_V1_SPEC).erl: \ $(PER_BIN_DRV_ASN1_V1_SPEC).set.asn \ $(ASN1_V1_SPEC).asn @echo "$(PER_BIN_DRV_ASN1_V1_SPEC):" $(ERLC) -bper_bin $(PER_BIN_DRV_V1_FLAGS) $(PER_BIN_DRV_ASN1_V1_SPEC).set.asn $(EBIN)/$(PER_BIN_DRV_ASN1_V1_SPEC).$(EMULATOR): \ - $(PER_BIN_DRV_ASN1_V1_SPEC).erl \ - $(PER_BIN_DRV_ASN1_V1_SPEC).hrl + $(PER_BIN_DRV_ASN1_V1_SPEC).erl # --- Version 2 --- -$(BER_ASN1_V2_SPEC).erl $(BER_ASN1_V2_SPEC).hrl: \ +$(BER_ASN1_V2_SPEC).erl: \ $(BER_ASN1_V2_SPEC).set.asn \ $(ASN1_V2_SPEC).asn @echo "$(BER_ASN1_V2_SPEC):" $(ERLC) -bber $(BER_V2_FLAGS) $(BER_ASN1_V2_SPEC).set.asn $(EBIN)/$(BER_ASN1_V2_SPEC).$(EMULATOR): \ - $(BER_ASN1_V2_SPEC).erl \ - $(BER_ASN1_V2_SPEC).hrl + $(BER_ASN1_V2_SPEC).erl -$(BER_BIN_ASN1_V2_SPEC).erl $(BER_BIN_ASN1_V2_SPEC).hrl: \ +$(BER_BIN_ASN1_V2_SPEC).erl: \ $(BER_BIN_ASN1_V2_SPEC).set.asn \ $(BER_BIN_ASN1_V2_SPEC).asn1config \ $(ASN1_V2_SPEC).asn @@ -166,10 +159,9 @@ $(BER_BIN_ASN1_V2_SPEC).erl $(BER_BIN_ASN1_V2_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_V2_FLAGS) $(BER_BIN_ASN1_V2_SPEC).set.asn $(EBIN)/$(BER_BIN_ASN1_V2_SPEC).$(EMULATOR): \ - $(BER_BIN_ASN1_V2_SPEC).erl \ - $(BER_BIN_ASN1_V2_SPEC).hrl + $(BER_BIN_ASN1_V2_SPEC).erl -$(BER_BIN_DRV_ASN1_V2_SPEC).erl $(BER_BIN_DRV_ASN1_V2_SPEC).hrl: \ +$(BER_BIN_DRV_ASN1_V2_SPEC).erl: \ $(BER_BIN_DRV_ASN1_V2_SPEC).set.asn \ $(BER_BIN_DRV_ASN1_V2_SPEC).asn1config \ $(ASN1_V2_SPEC).asn @@ -177,55 +169,50 @@ $(BER_BIN_DRV_ASN1_V2_SPEC).erl $(BER_BIN_DRV_ASN1_V2_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_DRV_V2_FLAGS) $(BER_BIN_DRV_ASN1_V2_SPEC).set.asn $(EBIN)/$(BER_BIN_DRV_ASN1_V2_SPEC).$(EMULATOR): \ - $(BER_BIN_DRV_ASN1_V2_SPEC).erl \ - $(BER_BIN_DRV_ASN1_V2_SPEC).hrl + $(BER_BIN_DRV_ASN1_V2_SPEC).erl -$(PER_ASN1_V2_SPEC).erl $(PER_ASN1_V2_SPEC).hrl: \ +$(PER_ASN1_V2_SPEC).erl: \ $(PER_ASN1_V2_SPEC).set.asn \ $(ASN1_V2_SPEC).asn @echo "$(PER_ASN1_V2_SPEC):" $(ERLC) -bper $(PER_V2_FLAGS) $(PER_ASN1_V2_SPEC).set.asn $(EBIN)/$(PER_ASN1_V2_SPEC).$(EMULATOR): \ - $(PER_ASN1_V2_SPEC).erl \ - $(PER_ASN1_V2_SPEC).hrl + $(PER_ASN1_V2_SPEC).erl -$(PER_BIN_ASN1_V2_SPEC).erl $(PER_BIN_ASN1_V2_SPEC).hrl: \ +$(PER_BIN_ASN1_V2_SPEC).erl: \ $(PER_BIN_ASN1_V2_SPEC).set.asn \ $(ASN1_V2_SPEC).asn @echo "$(PER_BIN_ASN1_V2_SPEC):" $(ERLC) -bper_bin $(PER_BIN_V2_FLAGS) $(PER_BIN_ASN1_V2_SPEC).set.asn $(EBIN)/$(PER_BIN_ASN1_V2_SPEC).$(EMULATOR): \ - $(PER_BIN_ASN1_V2_SPEC).erl \ - $(PER_BIN_ASN1_V2_SPEC).hrl + $(PER_BIN_ASN1_V2_SPEC).erl -$(PER_BIN_DRV_ASN1_V2_SPEC).erl $(PER_BIN_DRV_ASN1_V2_SPEC).hrl: \ +$(PER_BIN_DRV_ASN1_V2_SPEC).erl: \ $(PER_BIN_DRV_ASN1_V2_SPEC).set.asn \ $(ASN1_V2_SPEC).asn @echo "$(PER_BIN_DRV_ASN1_V2_SPEC):" $(ERLC) -bper_bin $(PER_BIN_DRV_V2_FLAGS) $(PER_BIN_DRV_ASN1_V2_SPEC).set.asn $(EBIN)/$(PER_BIN_DRV_ASN1_V2_SPEC).$(EMULATOR): \ - $(PER_BIN_DRV_ASN1_V2_SPEC).erl \ - $(PER_BIN_DRV_ASN1_V2_SPEC).hrl + $(PER_BIN_DRV_ASN1_V2_SPEC).erl # --- Version 3 --- # -- (prev3a) -- -$(BER_ASN1_PREV3A_SPEC).erl $(BER_ASN1_PREV3A_SPEC).hrl: \ +$(BER_ASN1_PREV3A_SPEC).erl: \ $(BER_ASN1_PREV3A_SPEC).set.asn \ $(ASN1_PREV3A_SPEC).asn @echo "$(BER_ASN1_PREV3A_SPEC):" $(ERLC) -bber $(BER_PREV3A_FLAGS) $(BER_ASN1_PREV3A_SPEC).set.asn $(EBIN)/$(BER_ASN1_PREV3A_SPEC).$(EMULATOR): \ - $(BER_ASN1_PREV3A_SPEC).erl \ - $(BER_ASN1_PREV3A_SPEC).hrl + $(BER_ASN1_PREV3A_SPEC).erl -$(BER_BIN_ASN1_PREV3A_SPEC).erl $(BER_BIN_ASN1_PREV3A_SPEC).hrl: \ +$(BER_BIN_ASN1_PREV3A_SPEC).erl: \ $(BER_BIN_ASN1_PREV3A_SPEC).set.asn \ $(BER_BIN_ASN1_PREV3A_SPEC).asn1config \ $(ASN1_PREV3A_SPEC).asn @@ -233,10 +220,9 @@ $(BER_BIN_ASN1_PREV3A_SPEC).erl $(BER_BIN_ASN1_PREV3A_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_PREV3A_FLAGS) $(BER_BIN_ASN1_PREV3A_SPEC).set.asn $(EBIN)/$(BER_BIN_ASN1_PREV3A_SPEC).$(EMULATOR): \ - $(BER_BIN_ASN1_PREV3A_SPEC).erl \ - $(BER_BIN_ASN1_PREV3A_SPEC).hrl + $(BER_BIN_ASN1_PREV3A_SPEC).erl -$(BER_BIN_DRV_ASN1_PREV3A_SPEC).erl $(BER_BIN_DRV_ASN1_PREV3A_SPEC).hrl: \ +$(BER_BIN_DRV_ASN1_PREV3A_SPEC).erl: \ $(BER_BIN_DRV_ASN1_PREV3A_SPEC).set.asn \ $(BER_BIN_DRV_ASN1_PREV3A_SPEC).asn1config \ $(ASN1_PREV3A_SPEC).asn @@ -244,52 +230,47 @@ $(BER_BIN_DRV_ASN1_PREV3A_SPEC).erl $(BER_BIN_DRV_ASN1_PREV3A_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_DRV_PREV3A_FLAGS) $(BER_BIN_DRV_ASN1_PREV3A_SPEC).set.asn $(EBIN)/$(BER_BIN_DRV_ASN1_PREV3A_SPEC).$(EMULATOR): \ - $(BER_BIN_DRV_ASN1_PREV3A_SPEC).erl \ - $(BER_BIN_DRV_ASN1_PREV3A_SPEC).hrl + $(BER_BIN_DRV_ASN1_PREV3A_SPEC).erl -$(PER_ASN1_PREV3A_SPEC).erl $(PER_ASN1_PREV3A_SPEC).hrl: \ +$(PER_ASN1_PREV3A_SPEC).erl: \ $(PER_ASN1_PREV3A_SPEC).set.asn \ $(ASN1_PREV3A_SPEC).asn @echo "$(PER_ASN1_PREV3A_SPEC):" $(ERLC) -bper $(PER_PREV3A_FLAGS) $(PER_ASN1_PREV3A_SPEC).set.asn $(EBIN)/$(PER_ASN1_PREV3A_SPEC).$(EMULATOR): \ - $(PER_ASN1_PREV3A_SPEC).erl \ - $(PER_ASN1_PREV3A_SPEC).hrl + $(PER_ASN1_PREV3A_SPEC).erl -$(PER_BIN_ASN1_PREV3A_SPEC).erl $(PER_BIN_ASN1_PREV3A_SPEC).hrl: \ +$(PER_BIN_ASN1_PREV3A_SPEC).erl: \ $(PER_BIN_ASN1_PREV3A_SPEC).set.asn \ $(ASN1_PREV3A_SPEC).asn @echo "$(PER_BIN_ASN1_PREV3A_SPEC):" $(ERLC) -bper_bin $(PER_BIN_PREV3A_FLAGS) $(PER_BIN_ASN1_PREV3A_SPEC).set.asn $(EBIN)/$(PER_BIN_ASN1_PREV3A_SPEC).$(EMULATOR): \ - $(PER_BIN_ASN1_PREV3A_SPEC).erl \ - $(PER_BIN_ASN1_PREV3A_SPEC).hrl + $(PER_BIN_ASN1_PREV3A_SPEC).erl -$(PER_BIN_DRV_ASN1_PREV3A_SPEC).erl $(PER_BIN_DRV_ASN1_PREV3A_SPEC).hrl: \ +$(PER_BIN_DRV_ASN1_PREV3A_SPEC).erl: \ $(PER_BIN_DRV_ASN1_PREV3A_SPEC).set.asn \ $(ASN1_PREV3A_SPEC).asn @echo "$(PER_BIN_DRV_ASN1_PREV3A_SPEC):" $(ERLC) -bper_bin $(PER_BIN_DRV_PREV3A_FLAGS) $(PER_BIN_DRV_ASN1_PREV3A_SPEC).set.asn $(EBIN)/$(PER_BIN_DRV_ASN1_PREV3A_SPEC).$(EMULATOR): \ - $(PER_BIN_DRV_ASN1_PREV3A_SPEC).erl \ - $(PER_BIN_DRV_ASN1_PREV3A_SPEC).hrl + $(PER_BIN_DRV_ASN1_PREV3A_SPEC).erl # -- (prev3b) -- -$(BER_ASN1_PREV3B_SPEC).erl $(BER_ASN1_PREV3B_SPEC).hrl: \ +$(BER_ASN1_PREV3B_SPEC).erl: \ $(BER_ASN1_PREV3B_SPEC).set.asn \ $(ASN1_PREV3B_SPEC).asn @echo "$(BER_ASN1_PREV3B_SPEC):" $(ERLC) -bber $(BER_PREV3B_FLAGS) $(BER_ASN1_PREV3B_SPEC).set.asn $(EBIN)/$(BER_ASN1_PREV3B_SPEC).$(EMULATOR): \ - $(BER_ASN1_PREV3B_SPEC).erl \ - $(BER_ASN1_PREV3B_SPEC).hrl + $(BER_ASN1_PREV3B_SPEC).erl -$(BER_BIN_ASN1_PREV3B_SPEC).erl $(BER_BIN_ASN1_PREV3B_SPEC).hrl: \ +$(BER_BIN_ASN1_PREV3B_SPEC).erl: \ $(BER_BIN_ASN1_PREV3B_SPEC).set.asn \ $(BER_BIN_ASN1_PREV3B_SPEC).asn1config \ $(ASN1_PREV3B_SPEC).asn @@ -297,10 +278,9 @@ $(BER_BIN_ASN1_PREV3B_SPEC).erl $(BER_BIN_ASN1_PREV3B_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_PREV3B_FLAGS) $(BER_BIN_ASN1_PREV3B_SPEC).set.asn $(EBIN)/$(BER_BIN_ASN1_PREV3B_SPEC).$(EMULATOR): \ - $(BER_BIN_ASN1_PREV3B_SPEC).erl \ - $(BER_BIN_ASN1_PREV3B_SPEC).hrl + $(BER_BIN_ASN1_PREV3B_SPEC).erl -$(BER_BIN_DRV_ASN1_PREV3B_SPEC).erl $(BER_BIN_DRV_ASN1_PREV3B_SPEC).hrl: \ +$(BER_BIN_DRV_ASN1_PREV3B_SPEC).erl: \ $(BER_BIN_DRV_ASN1_PREV3B_SPEC).set.asn \ $(BER_BIN_DRV_ASN1_PREV3B_SPEC).asn1config \ $(ASN1_PREV3B_SPEC).asn @@ -308,53 +288,48 @@ $(BER_BIN_DRV_ASN1_PREV3B_SPEC).erl $(BER_BIN_DRV_ASN1_PREV3B_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_DRV_PREV3B_FLAGS) $(BER_BIN_DRV_ASN1_PREV3B_SPEC).set.asn $(EBIN)/$(BER_BIN_DRV_ASN1_PREV3B_SPEC).$(EMULATOR): \ - $(BER_BIN_DRV_ASN1_PREV3B_SPEC).erl \ - $(BER_BIN_DRV_ASN1_PREV3B_SPEC).hrl + $(BER_BIN_DRV_ASN1_PREV3B_SPEC).erl -$(PER_ASN1_PREV3B_SPEC).erl $(PER_ASN1_PREV3B_SPEC).hrl: \ +$(PER_ASN1_PREV3B_SPEC).erl: \ $(PER_ASN1_PREV3B_SPEC).set.asn \ $(ASN1_PREV3B_SPEC).asn @echo "$(PER_ASN1_PREV3B_SPEC):" $(ERLC) -bper $(PER_PREV3B_FLAGS) $(PER_ASN1_PREV3B_SPEC).set.asn $(EBIN)/$(PER_ASN1_PREV3B_SPEC).$(EMULATOR): \ - $(PER_ASN1_PREV3B_SPEC).erl \ - $(PER_ASN1_PREV3B_SPEC).hrl + $(PER_ASN1_PREV3B_SPEC).erl -$(PER_BIN_ASN1_PREV3B_SPEC).erl $(PER_BIN_ASN1_PREV3B_SPEC).hrl: \ +$(PER_BIN_ASN1_PREV3B_SPEC).erl: \ $(PER_BIN_ASN1_PREV3B_SPEC).set.asn \ $(ASN1_PREV3B_SPEC).asn @echo "$(PER_BIN_ASN1_PREV3B_SPEC):" $(ERLC) -bper_bin $(PER_BIN_PREV3B_FLAGS) $(PER_BIN_ASN1_PREV3B_SPEC).set.asn $(EBIN)/$(PER_BIN_ASN1_PREV3B_SPEC).$(EMULATOR): \ - $(PER_BIN_ASN1_PREV3B_SPEC).erl \ - $(PER_BIN_ASN1_PREV3B_SPEC).hrl + $(PER_BIN_ASN1_PREV3B_SPEC).erl -$(PER_BIN_DRV_ASN1_PREV3B_SPEC).erl $(PER_BIN_DRV_ASN1_PREV3B_SPEC).hrl: \ +$(PER_BIN_DRV_ASN1_PREV3B_SPEC).erl: \ $(PER_BIN_DRV_ASN1_PREV3B_SPEC).set.asn \ $(ASN1_PREV3B_SPEC).asn @echo "$(PER_BIN_DRV_ASN1_PREV3B_SPEC):" $(ERLC) -bper_bin $(PER_BIN_DRV_PREV3B_FLAGS) $(PER_BIN_DRV_ASN1_PREV3B_SPEC).set.asn $(EBIN)/$(PER_BIN_DRV_ASN1_PREV3B_SPEC).$(EMULATOR): \ - $(PER_BIN_DRV_ASN1_PREV3B_SPEC).erl \ - $(PER_BIN_DRV_ASN1_PREV3B_SPEC).hrl + $(PER_BIN_DRV_ASN1_PREV3B_SPEC).erl # -- (prev3c) -- -$(BER_ASN1_PREV3C_SPEC).erl $(BER_ASN1_PREV3C_SPEC).hrl: \ +$(BER_ASN1_PREV3C_SPEC).erl: \ $(BER_ASN1_PREV3C_SPEC).set.asn \ $(ASN1_PREV3C_SPEC).asn @echo "$(BER_ASN1_PREV3C_SPEC):" $(ERLC) -bber $(BER_PREV3C_FLAGS) $(BER_ASN1_PREV3C_SPEC).set.asn $(EBIN)/$(BER_ASN1_PREV3C_SPEC).$(EMULATOR): \ - $(BER_ASN1_PREV3C_SPEC).erl \ - $(BER_ASN1_PREV3C_SPEC).hrl + $(BER_ASN1_PREV3C_SPEC).erl -$(BER_BIN_ASN1_PREV3C_SPEC).erl $(BER_BIN_ASN1_PREV3C_SPEC).hrl: \ +$(BER_BIN_ASN1_PREV3C_SPEC).erl: \ $(BER_BIN_ASN1_PREV3C_SPEC).set.asn \ $(BER_BIN_ASN1_PREV3C_SPEC).asn1config \ $(ASN1_PREV3C_SPEC).asn @@ -362,10 +337,9 @@ $(BER_BIN_ASN1_PREV3C_SPEC).erl $(BER_BIN_ASN1_PREV3C_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_PREV3C_FLAGS) $(BER_BIN_ASN1_PREV3C_SPEC).set.asn $(EBIN)/$(BER_BIN_ASN1_PREV3C_SPEC).$(EMULATOR): \ - $(BER_BIN_ASN1_PREV3C_SPEC).erl \ - $(BER_BIN_ASN1_PREV3C_SPEC).hrl + $(BER_BIN_ASN1_PREV3C_SPEC).erl -$(BER_BIN_DRV_ASN1_PREV3C_SPEC).erl $(BER_BIN_DRV_ASN1_PREV3C_SPEC).hrl: \ +$(BER_BIN_DRV_ASN1_PREV3C_SPEC).erl: \ $(BER_BIN_DRV_ASN1_PREV3C_SPEC).set.asn \ $(BER_BIN_DRV_ASN1_PREV3C_SPEC).asn1config \ $(ASN1_PREV3C_SPEC).asn @@ -373,53 +347,48 @@ $(BER_BIN_DRV_ASN1_PREV3C_SPEC).erl $(BER_BIN_DRV_ASN1_PREV3C_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_DRV_PREV3C_FLAGS) $(BER_BIN_DRV_ASN1_PREV3C_SPEC).set.asn $(EBIN)/$(BER_BIN_DRV_ASN1_PREV3C_SPEC).$(EMULATOR): \ - $(BER_BIN_DRV_ASN1_PREV3C_SPEC).erl \ - $(BER_BIN_DRV_ASN1_PREV3C_SPEC).hrl + $(BER_BIN_DRV_ASN1_PREV3C_SPEC).erl -$(PER_ASN1_PREV3C_SPEC).erl $(PER_ASN1_PREV3C_SPEC).hrl: \ +$(PER_ASN1_PREV3C_SPEC).erl: \ $(PER_ASN1_PREV3C_SPEC).set.asn \ $(ASN1_PREV3C_SPEC).asn @echo "$(PER_ASN1_PREV3C_SPEC):" $(ERLC) -bper $(PER_PREV3C_FLAGS) $(PER_ASN1_PREV3C_SPEC).set.asn $(EBIN)/$(PER_ASN1_PREV3C_SPEC).$(EMULATOR): \ - $(PER_ASN1_PREV3C_SPEC).erl \ - $(PER_ASN1_PREV3C_SPEC).hrl + $(PER_ASN1_PREV3C_SPEC).erl -$(PER_BIN_ASN1_PREV3C_SPEC).erl $(PER_BIN_ASN1_PREV3C_SPEC).hrl: \ +$(PER_BIN_ASN1_PREV3C_SPEC).erl: \ $(PER_BIN_ASN1_PREV3C_SPEC).set.asn \ $(ASN1_PREV3C_SPEC).asn @echo "$(PER_BIN_ASN1_PREV3C_SPEC):" $(ERLC) -bper_bin $(PER_BIN_PREV3C_FLAGS) $(PER_BIN_ASN1_PREV3C_SPEC).set.asn $(EBIN)/$(PER_BIN_ASN1_PREV3C_SPEC).$(EMULATOR): \ - $(PER_BIN_ASN1_PREV3C_SPEC).erl \ - $(PER_BIN_ASN1_PREV3C_SPEC).hrl + $(PER_BIN_ASN1_PREV3C_SPEC).erl -$(PER_BIN_DRV_ASN1_PREV3C_SPEC).erl $(PER_BIN_DRV_ASN1_PREV3C_SPEC).hrl: \ +$(PER_BIN_DRV_ASN1_PREV3C_SPEC).erl: \ $(PER_BIN_DRV_ASN1_PREV3C_SPEC).set.asn \ $(ASN1_PREV3C_SPEC).asn @echo "$(PER_BIN_DRV_ASN1_PREV3C_SPEC):" $(ERLC) -bper_bin $(PER_BIN_DRV_PREV3C_FLAGS) $(PER_BIN_DRV_ASN1_PREV3C_SPEC).set.asn $(EBIN)/$(PER_BIN_DRV_ASN1_PREV3C_SPEC).$(EMULATOR): \ - $(PER_BIN_DRV_ASN1_PREV3C_SPEC).erl \ - $(PER_BIN_DRV_ASN1_PREV3C_SPEC).hrl + $(PER_BIN_DRV_ASN1_PREV3C_SPEC).erl # -- (v3) -- -$(BER_ASN1_V3_SPEC).erl $(BER_ASN1_V3_SPEC).hrl: \ +$(BER_ASN1_V3_SPEC).erl: \ $(BER_ASN1_V3_SPEC).set.asn \ $(ASN1_V3_SPEC).asn @echo "$(BER_ASN1_V3_SPEC):" $(ERLC) -bber $(BER_V3_FLAGS) $(BER_ASN1_V3_SPEC).set.asn $(EBIN)/$(BER_ASN1_V3_SPEC).$(EMULATOR): \ - $(BER_ASN1_V3_SPEC).erl \ - $(BER_ASN1_V3_SPEC).hrl + $(BER_ASN1_V3_SPEC).erl -$(BER_BIN_ASN1_V3_SPEC).erl $(BER_BIN_ASN1_V3_SPEC).hrl: \ +$(BER_BIN_ASN1_V3_SPEC).erl: \ $(BER_BIN_ASN1_V3_SPEC).set.asn \ $(BER_BIN_ASN1_V3_SPEC).asn1config \ $(ASN1_V3_SPEC).asn @@ -427,10 +396,9 @@ $(BER_BIN_ASN1_V3_SPEC).erl $(BER_BIN_ASN1_V3_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_V3_FLAGS) $(BER_BIN_ASN1_V3_SPEC).set.asn $(EBIN)/$(BER_BIN_ASN1_V3_SPEC).$(EMULATOR): \ - $(BER_BIN_ASN1_V3_SPEC).erl \ - $(BER_BIN_ASN1_V3_SPEC).hrl + $(BER_BIN_ASN1_V3_SPEC).erl -$(BER_BIN_DRV_ASN1_V3_SPEC).erl $(BER_BIN_DRV_ASN1_V3_SPEC).hrl: \ +$(BER_BIN_DRV_ASN1_V3_SPEC).erl: \ $(BER_BIN_DRV_ASN1_V3_SPEC).set.asn \ $(BER_BIN_DRV_ASN1_V3_SPEC).asn1config \ $(ASN1_V3_SPEC).asn @@ -438,38 +406,34 @@ $(BER_BIN_DRV_ASN1_V3_SPEC).erl $(BER_BIN_DRV_ASN1_V3_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_DRV_V3_FLAGS) $(BER_BIN_DRV_ASN1_V3_SPEC).set.asn $(EBIN)/$(BER_BIN_DRV_ASN1_V3_SPEC).$(EMULATOR): \ - $(BER_BIN_DRV_ASN1_V3_SPEC).erl \ - $(BER_BIN_DRV_ASN1_V3_SPEC).hrl + $(BER_BIN_DRV_ASN1_V3_SPEC).erl -$(PER_ASN1_V3_SPEC).erl $(PER_ASN1_V3_SPEC).hrl: \ +$(PER_ASN1_V3_SPEC).erl: \ $(PER_ASN1_V3_SPEC).set.asn \ $(ASN1_V3_SPEC).asn @echo "$(PER_ASN1_V3_SPEC):" $(ERLC) -bper $(PER_V3_FLAGS) $(PER_ASN1_V3_SPEC).set.asn $(EBIN)/$(PER_ASN1_V3_SPEC).$(EMULATOR): \ - $(PER_ASN1_V3_SPEC).erl \ - $(PER_ASN1_V3_SPEC).hrl + $(PER_ASN1_V3_SPEC).erl -$(PER_BIN_ASN1_V3_SPEC).erl $(PER_BIN_ASN1_V3_SPEC).hrl: \ +$(PER_BIN_ASN1_V3_SPEC).erl: \ $(PER_BIN_ASN1_V3_SPEC).set.asn \ $(ASN1_V3_SPEC).asn @echo "$(PER_BIN_ASN1_V3_SPEC):" $(ERLC) -bper_bin $(PER_BIN_V3_FLAGS) $(PER_BIN_ASN1_V3_SPEC).set.asn $(EBIN)/$(PER_BIN_ASN1_V3_SPEC).$(EMULATOR): \ - $(PER_BIN_ASN1_V3_SPEC).erl \ - $(PER_BIN_ASN1_V3_SPEC).hrl + $(PER_BIN_ASN1_V3_SPEC).erl -$(PER_BIN_DRV_ASN1_V3_SPEC).erl $(PER_BIN_DRV_ASN1_V3_SPEC).hrl: \ +$(PER_BIN_DRV_ASN1_V3_SPEC).erl: \ $(PER_BIN_DRV_ASN1_V3_SPEC).set.asn \ $(ASN1_V3_SPEC).asn @echo "$(PER_BIN_DRV_ASN1_V3_SPEC):" $(ERLC) -bper_bin $(PER_BIN_DRV_V3_FLAGS) $(PER_BIN_DRV_ASN1_V3_SPEC).set.asn $(EBIN)/$(PER_BIN_DRV_ASN1_V3_SPEC).$(EMULATOR): \ - $(PER_BIN_DRV_ASN1_V3_SPEC).erl \ - $(PER_BIN_DRV_ASN1_V3_SPEC).hrl + $(PER_BIN_DRV_ASN1_V3_SPEC).erl # ------------- diff --git a/lib/megaco/src/flex/Makefile.in b/lib/megaco/src/flex/Makefile.in index 5af651d89b..2c46a673e4 100644 --- a/lib/megaco/src/flex/Makefile.in +++ b/lib/megaco/src/flex/Makefile.in @@ -391,7 +391,9 @@ $(STD_DRV).c: $(STD_DRV).flex $(MT_DRV).c: $(MT_DRV).flex $(LEX) $(MT_LEX_FLAGS) -P$* -o$@ $< -solibs: $(LIBDIR) $(OBJDIR) $(SOLIBS) +_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) + +solibs: $(SOLIBS) $(OBJDIR)/$(STD_DRV).o: $(STD_DRV).c @echo "compiling std driver:" @@ -411,10 +413,3 @@ $(LIBDIR)/$(STD_DRV).$(DED_EXT): $(OBJDIR)/$(STD_DRV).o $(LIBDIR)/$(MT_DRV).$(DED_EXT): $(OBJDIR)/$(MT_DRV).o @echo "linking multi-threaded driver:" $(LD) $(LDFLAGS) -o $@ $< - -$(LIBDIR): - -mkdir -p $(LIBDIR) - -$(OBJDIR): - -mkdir -p $(OBJDIR) - diff --git a/lib/megaco/test/megaco_codec_v1_test.erl b/lib/megaco/test/megaco_codec_v1_test.erl index 3a548c4d9e..e9c19605dd 100644 --- a/lib/megaco/test/megaco_codec_v1_test.erl +++ b/lib/megaco/test/megaco_codec_v1_test.erl @@ -371,9 +371,9 @@ profile_decode_text_messages(Slogan, Codec, Config, Msgs0) -> decode_text_messages(Codec, Config, Bins, []) end, %% Make a dry run, just to make sure all modules are loaded: - io:format("make a dry run..~n", []), + io:format("make a dry run...~n", []), (catch Fun()), - io:format("make the run..~n", []), + io:format("make the run...~n", []), megaco_profile:profile(Slogan, Fun). %% (catch megaco_codec_v1_test:profile_encode_compact_text_messages()). diff --git a/lib/megaco/test/megaco_codec_v2_test.erl b/lib/megaco/test/megaco_codec_v2_test.erl index c3a80febba..1d3fcb36e9 100644 --- a/lib/megaco/test/megaco_codec_v2_test.erl +++ b/lib/megaco/test/megaco_codec_v2_test.erl @@ -346,9 +346,9 @@ profile_decode_text_messages(Slogan, Codec, Config, Msgs0) -> decode_text_messages(Codec, Config, Bins, []) end, %% Make a dry run, just to make sure all modules are loaded: - io:format("make a dry run..~n", []), + io:format("make a dry run...~n", []), (catch Fun()), - io:format("make the run..~n", []), + io:format("make the run...~n", []), megaco_profile:profile(Slogan, Fun). %% (catch megaco_codec_v2_test:profile_encode_compact_text_messages()). diff --git a/lib/megaco/test/megaco_mess_test.erl b/lib/megaco/test/megaco_mess_test.erl index ded1506271..383e3df774 100644 --- a/lib/megaco/test/megaco_mess_test.erl +++ b/lib/megaco/test/megaco_mess_test.erl @@ -34,12 +34,12 @@ %% -compile(export_all). -export([ - all/0,groups/0,init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, + 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, connect/1, - request_and_reply_plain/1, request_and_no_reply/1, @@ -347,39 +347,83 @@ end_per_testcase(Case, Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% all() -> - [connect, {group, request_and_reply}, - {group, pending_ack}, dist, {group, tickets}]. + [ + connect, + {group, request_and_reply}, + {group, pending_ack}, + dist, + {group, tickets} + ]. groups() -> - [{request_and_reply, [], - [request_and_reply_plain, request_and_no_reply, + [ + {request_and_reply, [], + [request_and_reply_plain, + request_and_no_reply, request_and_reply_pending_ack_no_pending, request_and_reply_pending_ack_one_pending, single_trans_req_and_reply, single_trans_req_and_reply_sendopts, - request_and_reply_and_ack, request_and_reply_and_no_ack, + request_and_reply_and_ack, + request_and_reply_and_no_ack, request_and_reply_and_late_ack, trans_req_and_reply_and_req]}, {pending_ack, [], [pending_ack_plain, request_and_pending_and_late_reply]}, {tickets, [], - [otp_4359, otp_4836, otp_5805, otp_5881, otp_5887, - otp_6253, otp_6275, otp_6276, {group, otp_6442}, - {group, otp_6865}, otp_7189, otp_7259, otp_7713, - {group, otp_8183}, otp_8212]}, + [otp_4359, + otp_4836, + otp_5805, + otp_5881, + otp_5887, + otp_6253, + otp_6275, + otp_6276, + {group, otp_6442}, + {group, otp_6865}, + otp_7189, + otp_7259, + otp_7713, + {group, otp_8183}, + otp_8212]}, {otp_6442, [], - [otp_6442_resend_request1, otp_6442_resend_request2, - otp_6442_resend_reply1, otp_6442_resend_reply2]}, + [otp_6442_resend_request1, + otp_6442_resend_request2, + otp_6442_resend_reply1, + otp_6442_resend_reply2]}, {otp_6865, [], [otp_6865_request_and_reply_plain_extra1, otp_6865_request_and_reply_plain_extra2]}, - {otp_8183, [], [otp_8183_request1]}]. + {otp_8183, [], [otp_8183_request1]} + ]. + + +init_per_suite(Config) -> + io:format("~w:init_per_suite -> entry with" + "~n Config: ~p" + "~n", [?MODULE, Config]), + Config. + +end_per_suite(_Config) -> + io:format("~w:end_per_suite -> entry with" + "~n _Config: ~p" + "~n", [?MODULE, _Config]), + ok. + init_per_group(_GroupName, Config) -> + io:format("~w:init_per_group -> entry with" + "~n _GroupName: ~p" + "~n Config: ~p" + "~n", [?MODULE, _GroupName, Config]), Config. end_per_group(_GroupName, Config) -> + io:format("~w:end_per_group -> entry with" + "~n _GroupName: ~p" + "~n Config: ~p" + "~n", [?MODULE, _GroupName, Config]), Config. @@ -394,12 +438,16 @@ connect(Config) when is_list(Config) -> PrelMid = preliminary_mid, MgMid = ipv4_mid(4711), + d("connect -> start megaco app",[]), ?VERIFY(ok, application:start(megaco)), + d("connect -> start (MG) user ~p",[MgMid]), ?VERIFY(ok, megaco:start_user(MgMid, [{send_mod, bad_send_mod}, {request_timer, infinity}, {reply_timer, infinity}])), + d("connect -> get receive info for ~p",[MgMid]), MgRH = user_info(MgMid, receive_handle), + d("connect -> (MG) try connect to MGC",[]), {ok, PrelCH} = ?VERIFY({ok, _}, megaco:connect(MgRH, PrelMid, sh, self())), connections([PrelCH]), @@ -6776,16 +6824,12 @@ rapalr_mg_notify_request_ar(Rid, Tid, Cid) -> - - - - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% dist(suite) -> []; dist(Config) when is_list(Config) -> + ?SKIP("Needs a re-write..."), [_Local, Dist] = ?ACQUIRE_NODES(2, Config), d("dist -> start proxy",[]), megaco_mess_user_test:start_proxy(), @@ -6897,7 +6941,11 @@ dist(Config) when is_list(Config) -> ?VERIFY(ok, application:stop(megaco)), ?RECEIVE([]), - d("dist -> done",[]), + + d("dist -> stop proxy",[]), + megaco_mess_user_test:stop_proxy(), + + d("dist -> done", []), ok. diff --git a/lib/megaco/test/megaco_profile.erl b/lib/megaco/test/megaco_profile.erl index d0b62610e1..344c551970 100644 --- a/lib/megaco/test/megaco_profile.erl +++ b/lib/megaco/test/megaco_profile.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2009. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -24,50 +24,102 @@ -module(megaco_profile). --export([profile/2]). - +-export([profile/2, prepare/2, analyse/1, + fprof_to_calltree/1, fprof_to_calltree/2, fprof_to_calltree/3]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Execute Fun and profile it with fprof. -profile(Slogan, Fun) when is_function(Fun) -> +profile(Slogan, Fun) when is_function(Fun, 0) -> Pids = [self()], - profile(Slogan, Fun, Pids). + {ok, TraceFile} = prepare(Slogan, Pids), + Res = (catch Fun()), + {ok, _DestFile} = analyse(Slogan), + ok = file:delete(TraceFile), + {ok, _TreeFile} = fprof_to_calltree(Slogan), + Res. -profile(Slogan, Fun, Pids) -> +%% Prepare for tracing +prepare(Slogan, Pids) -> TraceFile = lists:concat(["profile_", Slogan, "-fprof.trace"]), - DestFile = lists:concat(["profile_", Slogan, ".fprof"]), - TreeFile = lists:concat(["profile_", Slogan, ".calltree"]), - erlang:garbage_collect(), {ok, _Pid} = fprof:start(), + erlang:garbage_collect(), TraceOpts = [start, - {cpu_time, false}, - {procs, Pids}, - {file, TraceFile} + {cpu_time, false}, + {procs, Pids}, + {file, TraceFile} ], - ok = fprof:trace(TraceOpts), - Res = (catch Fun()), - ok = fprof:trace(stop), - ok = fprof:profile([{file, TraceFile}]), - ok = fprof:analyse([{dest, DestFile}]), - ok = fprof:stop(), - ok = file:delete(TraceFile), - reformat_total(DestFile, TreeFile), - Res. + ok = fprof:trace(TraceOpts), + {ok, TraceFile}. -reformat_total(FromFile, ToFile) -> - {ok, ConsultedFromFile} = file:consult(FromFile), - [_AnalysisOpts, [Totals] | Terms] = ConsultedFromFile, - {totals, _, TotalAcc, _} = Totals, +%% Stop tracing and analyse it +analyse(Slogan) -> + fprof:trace(stop), + TraceFile = lists:concat(["profile_", Slogan, "-fprof.trace"]), + DestFile = lists:concat(["profile_", Slogan, ".fprof"]), + try + case fprof:profile([{file, TraceFile}]) of + ok -> + ok = fprof:analyse([{dest, DestFile}, {totals, false}]), + {ok, DestFile}; + {error, Reason} -> + {error, Reason} + end + after + fprof:stop() + end. + +fprof_to_calltree(Slogan) -> + fprof_to_calltree(Slogan, 0). + +fprof_to_calltree(Slogan, MinPercent) -> + DestFile = lists:concat(["profile_", Slogan, ".fprof"]), + TreeFile = lists:concat(["profile_", Slogan, ".calltree"]), + fprof_to_calltree(DestFile, TreeFile, MinPercent). + +%% Create a calltree from an fprof file +fprof_to_calltree(FromFile, ToFile, MinPercent) -> + ReplyTo = self(), + Ref = make_ref(), + spawn_link(fun() -> + ReplyTo ! {Ref, do_fprof_to_calltree(FromFile, ToFile, MinPercent)} + end), + wait_for_reply(Ref). + +wait_for_reply(Ref) -> + receive + {Ref, Res} -> + Res; + {'EXIT', normal} -> + wait_for_reply(Ref); + {'EXIT', Reason} -> + exit(Reason) + end. + +do_fprof_to_calltree(FromFile, ToFile, MinPercent) -> {ok, Fd} = file:open(ToFile, [write, raw]), - Indent = "", - log(Fd, Indent, TotalAcc, Totals), - Processes = split_processes(Terms, [], []), - Reformat = fun(P) -> reformat_process(Fd, " " ++ Indent, TotalAcc, P) end, - lists:foreach(Reformat, Processes), - file:close(Fd). + {ok, ConsultedFromFile} = file:consult(FromFile), + [_AnalysisOpts, [_Totals] | Terms] = ConsultedFromFile, + Processes = split_processes(Terms, [], []), + Indent = "", + Summary = collapse_processes(Processes), + {_Label, _Cnt, Acc, _Own, _Roots, Details} = Summary, + %% log(Fd, Label, Indent, Acc, {Label, Cnt, Acc, Own}, [], 0), + gen_calltree(Fd, Indent, Acc, Summary, MinPercent), + Delim = io_lib:format("\n~80..=c\n\n", [$=]), + Write = + fun(P) -> + file:write(Fd, Delim), + gen_calltree(Fd, Indent, Acc, P, MinPercent) + end, + lists:foreach(Write, Processes), + file:write(Fd, Delim), + gen_details(Fd, Acc, Details), + file:close(Fd), + {ok, ToFile}. +%% Split all fprof terms into a list of processes split_processes([H | T], ProcAcc, TotalAcc) -> if is_tuple(H) -> @@ -75,64 +127,185 @@ split_processes([H | T], ProcAcc, TotalAcc) -> is_list(H), ProcAcc =:= [] -> split_processes(T, [H], TotalAcc); is_list(H) -> - split_processes(T, [H], [lists:reverse(ProcAcc) | TotalAcc]) + ProcAcc2 = rearrange_process(lists:reverse(ProcAcc)), + split_processes(T, [H], [ProcAcc2 | TotalAcc]) end; split_processes([], [], TotalAcc) -> - lists:reverse(TotalAcc); + lists:reverse(lists:keysort(3, TotalAcc)); split_processes([], ProcAcc, TotalAcc) -> - lists:reverse([lists:reverse(ProcAcc) | TotalAcc]). - -reformat_process(Fd, Indent, TotalAcc, Terms) -> - case Terms of - [[{ProcLabel, _, _, _}] | All] -> ok; - [[{ProcLabel,_,_,_} | _] | All] -> ok - end, - [{_, {TopKey, TopCnt, TopAcc, TopOwn}, _} | _] = All, - Process = {ProcLabel, TopCnt, TopAcc, TopOwn}, - log(Fd, Indent, TotalAcc, Process), - reformat_calls(Fd, " " ++ Indent, TotalAcc, TopKey, All, []). - -reformat_calls(Fd, Indent, TotalAcc, Key, Terms, Stack) -> - {_CalledBy, Current, Calls} = find(Key, Terms), - log(Fd, Indent, TotalAcc, Current), - case lists:member(Key, Stack) of - true -> - ok; - false -> - case Key of - {io_lib, _, _} -> - ok; - {disk_log, _, _} -> - ok; - {lists, flatten, _} -> - ok; - {lists, keysort, _} -> - ok; - _ -> - Fun = fun({NextKey, _, _, _}) -> - reformat_calls(Fd, - " " ++ Indent, - TotalAcc, - NextKey, - Terms, - [Key | Stack]) - end, - lists:foreach(Fun, Calls) - end + ProcAcc2 = rearrange_process(lists:reverse(ProcAcc)), + lists:reverse(lists:keysort(3, [ProcAcc2 | TotalAcc])). + +%% Rearrange the raw process list into a more useful format +rearrange_process([[{Label, _Cnt, _Acc, _Own} | _ ] | Details]) -> + do_rearrange_process(Details, Details, Label, [], []). + +do_rearrange_process([{CalledBy, Current, _Calls} | T], Orig, Label, Roots, Undefs) -> + case [{undefined, Cnt, safe_max(Acc, Own), Own} || + {undefined, Cnt, Acc, Own} <- CalledBy] of + [] -> + do_rearrange_process(T, Orig, Label, Roots, Undefs); + NewUndefs -> + do_rearrange_process(T, Orig, Label, [Current | Roots], NewUndefs ++ Undefs) + end; +do_rearrange_process([], Details, Label, Roots, Undefs) -> + [{undefined, Cnt, Acc, Own}] = collapse_calls(Undefs, []), + Details2 = sort_details(3, Details), + {Label, Cnt, Acc, Own, lists:reverse(lists:keysort(3, Roots)), Details2}. + +%% Compute a summary of the rearranged process info +collapse_processes(Processes) -> + Headers = lists:map(fun({_L, C, A, O, _R, _D}) -> {"SUMMARY", C, A, O} end, + Processes), + [{Label, Cnt, Acc, Own}] = collapse_calls(Headers, []), + Details = lists:flatmap(fun({_L, _C, _A, _O, _R, D}) -> D end, Processes), + Details2 = do_collapse_processes(sort_details(1, Details), []), + Roots = lists:flatmap(fun({_L, _C, _A, _O, R, _D}) -> R end, Processes), + RootMFAs = lists:usort([MFA || {MFA, _, _, _} <- Roots]), + Roots2 = [R || RootMFA <- RootMFAs, + {_, {MFA, _, _, _} = R, _} <- Details2, + MFA =:= RootMFA], + Roots3 = collapse_calls(Roots2, []), + {Label, Cnt, Acc, Own, Roots3, Details2}. + +do_collapse_processes([{CalledBy1, {MFA, Cnt1, Acc1, Own1}, Calls1} | T1], + [{CalledBy2, {MFA, Cnt2, Acc2, Own2}, Calls2} | T2]) -> + Cnt = Cnt1 + Cnt2, + Acc = Acc1 + Acc2, + Own = Own1 + Own2, + Current = {MFA, Cnt, Acc, Own}, + CalledBy0 = CalledBy1 ++ CalledBy2, + Calls0 = Calls1 ++ Calls2, + CalledBy = collapse_calls(lists:keysort(3, CalledBy0), []), + Calls = collapse_calls(lists:keysort(3, Calls0), []), + do_collapse_processes(T1, [{CalledBy, Current, Calls} | T2]); +do_collapse_processes([{CalledBy, Current, Calls} | T1], + T2) -> + do_collapse_processes(T1, [{CalledBy, Current, Calls} | T2]); +do_collapse_processes([], + T2) -> + sort_details(3, T2). + +%% Reverse sort on acc field +sort_details(Pos, Details) -> + Pivot = fun({_CalledBy1, Current1, _Calls1}, + {_CalledBy2, Current2, _Calls2}) -> + element(Pos, Current1) =< element(Pos, Current2) + end, + lists:reverse(lists:sort(Pivot, Details)). + +%% Compute a summary from a list of call tuples +collapse_calls([{MFA, Cnt1, Acc1, Own1} | T1], + [{MFA, Cnt2, Acc2, Own2} | T2]) -> + Cnt = Cnt1 + Cnt2, + Acc = safe_sum(Acc1, Acc2), + Own = Own1 + Own2, + collapse_calls(T1, [{MFA, Cnt, Acc, Own} | T2]); +collapse_calls([{MFA, Cnt, Acc, Own} | T1], + T2) -> + collapse_calls(T1, [{MFA, Cnt, Acc, Own} | T2]); +collapse_calls([], + T2) -> + lists:reverse(lists:keysort(3, T2)). + +safe_sum(Int1, Int2) -> + if + Int1 =:= undefined -> Int2; + Int2 =:= undefined -> Int1; + true -> Int1 + Int2 + end. + +safe_max(Int1, Int2) -> + if + Int1 =:= undefined -> + io:format("111\n", []), + Int2; + Int2 =:= undefined -> + io:format("222\n", []), + Int1; + Int2 > Int1 -> Int2; + true -> Int1 + end. + +%% Compute a calltree and write it to file +gen_calltree(Fd, Indent, TotalAcc, {Label, Cnt, Acc, Own, Roots, Details}, MinPercent) -> + Header = {Label, Cnt, Acc, Own}, + MetaLabel = "Process", + Diff = length(Label) - length(MetaLabel), + IoList = io_lib:format("~s~s Lvl Pct Cnt Acc Own Calls => MFA\n", + [MetaLabel, lists:duplicate(Diff, $\ )]), + file:write(Fd, IoList), + log(Fd, Label, Indent, TotalAcc, Header, Roots, MinPercent), + NewIndent = " " ++ Indent, + Fun = fun({MFA, _C, _A, _O}) -> + [put_detail(Label, D) || D <- Details], + gen_calls(Fd, Label, NewIndent, TotalAcc, MFA, MinPercent) + end, + lists:foreach(Fun, Roots). + +gen_calls(Fd, Label, Indent, TotalAcc, MFA, MinPercent) -> + case get_detail(Label, MFA) of + {read, {_CalledBy, Current, _Calls}} -> + log(Fd, Label, Indent, TotalAcc, Current, -1, MinPercent); + {unread, {_CalledBy, Current, Calls}} -> + log(Fd, Label, Indent, TotalAcc, Current, Calls, MinPercent), + NewIndent = " " ++ Indent, + Fun = fun({NextMFA, _, _, _}) -> + gen_calls(Fd, Label, NewIndent, TotalAcc, + NextMFA, MinPercent) + end, + lists:foreach(Fun, Calls) + end. + +put_detail(Label, {_, {MFA, _, _, _}, _} = Detail) -> + put({Label, MFA}, {unread, Detail}). + +get_detail(Label, MFA) -> + Val = get({Label, MFA}), + case Val of + {unread, Detail} -> + put({Label, MFA}, {read, Detail}), + Val; + {read, _Detail} -> + Val + end. + +gen_details(Fd, Total, Details) -> + IoList = io_lib:format("Pct Cnt Acc Own MFA\n", []), + file:write(Fd, IoList), + do_gen_details(Fd, Total, Details). + +do_gen_details(Fd, Total, [{_CalledBy, {MFA, Cnt, Acc, Own}, _Calls} | Details]) -> + MFAStr = io_lib:format("~p", [MFA]), + {_, Percent} = calc_percent(Acc, Own, Total), + IoList = io_lib:format("~3.. B% ~10.3B ~10.3f ~10.3f => ~s\n", + [Percent, Cnt, Acc, Own, MFAStr]), + file:write(Fd, IoList), + do_gen_details(Fd, Total, Details); +do_gen_details(_Fd, _Total, []) -> + ok. + +log(Fd, Label, Indent, Acc, Current, Calls, MinPercent) when is_list(Calls) -> + log(Fd, Label, Indent, Acc, Current, length(Calls), MinPercent); +log(Fd, Label, Indent, Total, {MFA, Cnt, Acc, Own}, N, MinPercent) -> + {Max, Percent} = calc_percent(Acc, Own, Total), + if + Percent >= MinPercent -> + do_log(Fd, Label, Indent, Percent, MFA, Cnt, Max, Own, N); + true -> + ok end. -find(Key, [{_, {Key, _, _, _}, _} = H | _]) -> - H; -find(Key, [{_, {_, _, _, _}, _} | T]) -> - find(Key, T). - -log(Fd, Indent, Total, {Label, Cnt, Acc, Own}) -> - Percent = case Acc of - undefined -> 100; - _ -> trunc((lists:max([Acc, Own]) * 100) / Total) - end, - Label2 = io_lib:format("~p", [Label]), - IoList = io_lib:format("~s~p% ~s \t~p \t~p \t~p\n", - [Indent, Percent, Label2, Cnt, trunc(Acc), trunc(Own)]), +do_log(Fd, Label, Indent, Percent, MFA, Cnt, Acc, Own, N) -> + MFAStr = io_lib:format("~p", [MFA]), + CallsStr = io_lib:format(" ~5.. s ", [lists:concat([N])]), + IoList = io_lib:format("~s ~3.. B " + "~s~3.. B% ~10.. B ~10.. B ~10.. B ~s => ~s\n", + [Label, length(Indent) div 2, + Indent, Percent, Cnt, + round(Acc), round(Own), CallsStr, MFAStr]), file:write(Fd, IoList). +calc_percent(Acc, Own, Total) -> + Max = safe_max(Acc, Own), + {Max, round((Max * 100) / Total)}. diff --git a/lib/megaco/test/megaco_test_lib.erl b/lib/megaco/test/megaco_test_lib.erl index 41f6c2c4cb..282fd91b44 100644 --- a/lib/megaco/test/megaco_test_lib.erl +++ b/lib/megaco/test/megaco_test_lib.erl @@ -21,6 +21,7 @@ %%---------------------------------------------------------------------- %% Purpose: Lightweight test server %%---------------------------------------------------------------------- +%% -module(megaco_test_lib). @@ -684,7 +685,7 @@ skip(Actual, File, Line) -> fatal_skip(Actual, File, Line) -> error(Actual, File, Line), - exit(shutdown). + exit({skipped, {fatal, Actual, File, Line}}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -749,6 +750,7 @@ proxy_loop(OwnId, Controller) -> proxy_loop(OwnId, Controller) end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Test server callbacks init_per_testcase(_Case, Config) -> @@ -852,10 +854,10 @@ watchdog(Pid, Time) -> prepare_test_case(Actions, N, Config, File, Line) -> OrigNodes = lookup_config(nodes, Config), TestNodes = lookup_config(nodenames, Config), %% For testserver - This = node(), + This = node(), SomeNodes = OrigNodes ++ (TestNodes -- OrigNodes), - AllNodes = [This | (SomeNodes -- [This])], - Nodes = pick_n_nodes(N, AllNodes, File, Line), + AllNodes = [This | (SomeNodes -- [This])], + Nodes = pick_n_nodes(N, AllNodes, File, Line), start_nodes(Nodes, File, Line), do_prepare_test_case(Actions, Nodes, Config, File, Line). diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk index c1476488ca..35acffcb64 100644 --- a/lib/megaco/vsn.mk +++ b/lib/megaco/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = megaco -MEGACO_VSN = 3.15.1.1 +MEGACO_VSN = 3.15.1.2 PRE_VSN = APP_VSN = "$(APPLICATION)-$(MEGACO_VSN)$(PRE_VSN)" diff --git a/lib/mnesia/doc/src/Makefile b/lib/mnesia/doc/src/Makefile index f45b5137a3..f2e581f9d3 100644 --- a/lib/mnesia/doc/src/Makefile +++ b/lib/mnesia/doc/src/Makefile @@ -29,14 +29,6 @@ VSN=$(MNESIA_VSN) APPLICATION=mnesia # ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - -# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) @@ -105,31 +97,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -142,8 +113,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -158,33 +127,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) - - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -199,8 +141,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -211,30 +151,4 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -endif -endif - -endif - - release_spec: - diff --git a/lib/mnesia/doc/src/make.dep b/lib/mnesia/doc/src/make.dep deleted file mode 100644 index 6e79484cb3..0000000000 --- a/lib/mnesia/doc/src/make.dep +++ /dev/null @@ -1,46 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: Mnesia_App_A.tex Mnesia_App_B.tex Mnesia_App_C.tex \ - Mnesia_App_D.tex Mnesia_chap1.tex Mnesia_chap2.tex \ - Mnesia_chap3.tex Mnesia_chap4.tex Mnesia_chap5.tex \ - Mnesia_chap7.tex Mnesia_chap8.tex book.tex \ - mnesia.tex mnesia_frag_hash.tex mnesia_registry.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -Mnesia_App_B.tex: ../../src/mnesia_backup.erl - -Mnesia_App_C.tex: ../../src/mnesia_frag.erl - -Mnesia_App_D.tex: ../../src/mnesia_frag_hash.erl - -Mnesia_chap2.tex: company.erl company.hrl - -Mnesia_chap3.tex: company.erl - -Mnesia_chap4.tex: company.erl - -Mnesia_chap5.tex: FRUITS company.erl company_o.erl company_o.hrl - -Mnesia_chap7.tex: bup.erl - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: company.ps - diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index e8b8c58c70..ae6631646c 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -413,7 +413,7 @@ pr_other(Var, Other) -> [self(), process_info(self(), registered_name), Var, Other, Why]), case Other of - {badarg, [{ets, lookup_element, _}|_]} -> + {badarg, [{ets, lookup_element, _, _}|_]} -> exit(Why); _ -> erlang:error(Why) diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index eb83168498..c4b22814a8 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -429,7 +429,7 @@ init_table(Tab, disc_only_copies, Fun, DetsInfo,Sender) -> {ErtsVer, DetsData} -> Res = (catch dets:is_compatible_bchunk_format(Tab, DetsData)), case Res of - {'EXIT',{undef,[{dets,_,_}|_]}} -> + {'EXIT',{undef,[{dets,_,_,_}|_]}} -> Sender ! {self(), {old_protocol, Tab}}, dets:init_table(Tab, Fun); %% Old dets version {'EXIT', What} -> diff --git a/lib/observer/doc/src/make.dep b/lib/observer/doc/src/make.dep deleted file mode 100644 index 3c1b3df771..0000000000 --- a/lib/observer/doc/src/make.dep +++ /dev/null @@ -1,29 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex crashdump.tex crashdump_ug.tex etop.tex \ - etop_ug.tex observer_app.tex part.tex ref_man.tex \ - ttb.tex ttb_ug.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: etop_5.ps etop_lines.ps etop_main.ps etop_opt.ps - -book.dvi: et_modsprocs.ps et_processes.ps - diff --git a/lib/observer/doc/src/ttb.xml b/lib/observer/doc/src/ttb.xml index 2c80891925..4e63aecbf2 100644 --- a/lib/observer/doc/src/ttb.xml +++ b/lib/observer/doc/src/ttb.xml @@ -25,11 +25,12 @@ <title>ttb</title> <prepared>Siri hansen</prepared> + <prepared>Bartlomiej Puzon</prepared> <responsible></responsible> <docno>1</docno> <approved></approved> <checked></checked> - <date>2002-02-25</date> + <date>2010-08-13</date> <rev>PA1</rev> <file>ttb.sgml</file> </header> @@ -43,6 +44,35 @@ </description> <funcs> <func> + <name>start_trace(Nodes, Patterns, FlagSpec, Opts) -> Result</name> + <fsummary>Start a trace port on each given node.</fsummary> + <type> + <v>Result = see p/2</v> + <v>Nodes = see tracer/2</v> + <v>Patterns = [tuple()]</v> + <v>FlagSpec = {Procs, Flags}</v> + <v>Proc = see p/2</v> + <v>Flags = see p/2</v> + <v>Opts = see tracer/2</v> + </type> + <desc> + <p>This function is a shortcut allowing to start a trace with one command. Each + tuple in <c>Patterns</c> is converted to list which is in turn passed to + <c>ttb:tpl</c>. + The call:<code type="none"> +ttb:start_trace([Node, OtherNode], +[{mod, foo, []}, {mod, bar, 2}], +{all, call}, +[{file, File}, {handler,{fun myhandler/4, S}}])</code> + is equivalent to <code type="none"> +ttb:start_trace([Node, OtherNode], [{file, File}, {handler,{fun myhandler/4, S}}]), +ttb:tpl(mod, foo, []), +ttb:tpl(mod, bar, 2, []), +ttb:p(all, call)</code> + </p> + </desc> + </func> + <func> <name>tracer() -> Result</name> <fsummary>This is equivalent to tracer(node()).</fsummary> <desc> @@ -50,6 +80,17 @@ </desc> </func> <func> + <name>tracer(Shortcut) -> Result</name> + <fsummary>Handy shortcuts for common tracing settings</fsummary> + <type> + <v>Shortcut = shell | dbg</v> + </type> + <desc> + <p><c>shell</c> is equivalent to <c>tracer(node(),[{file, {local, "ttb"}}, shell])</c>.</p> + <p><c>dbg</c> is equivalent to <c>tracer(node(),[{shell, only}])</c>.</p> + </desc> + </func> + <func> <name>tracer(Nodes) -> Result</name> <fsummary>This is equivalent to tracer(Nodes,[]).</fsummary> <desc> @@ -62,14 +103,21 @@ <type> <v>Result = {ok, ActivatedNodes} | {error,Reason}</v> <v>Nodes = atom() | [atom()] | all | existing | new</v> - <v>Opts = [Opt]</v> - <v>Opt = {file,Client} | {handler, FormatHandler} | {process_info,PI}</v> + <v>Opts = Opt | [Opt]</v> + <v>Opt = {file,Client} | {handler, FormatHandler} | {process_info,PI} | + shell | {shell, ShellSpec} | {timer, TimerSpec} | {overload, {MSec, Module, Function}} + | {flush, MSec} | resume | {resume, FetchTimeout}</v> + <v>TimerSpec = MSec | {MSec, StopOpts}</v> + <v>MSec = FetchTimeout = integer()</v> + <v>Module = Function = atom() </v> + <v>StopOpts = see stop/2</v> <v>Client = File | {local, File}</v> <v>File = Filename | Wrap</v> <v>Filename = string()</v> <v>Wrap = {wrap,Filename} | {wrap,Filename,Size,Count}</v> <v>FormatHandler = See format/2</v> <v>PI = true | false </v> + <v>ShellSpec = true | false | only</v> </type> <desc> <p>This function starts a file trace port on all given nodes @@ -96,7 +144,70 @@ is the process' registered name its globally registered name, or its initial function. It is possible to turn off this functionality by setting <c>PI = false</c>. - </p> + </p> + <p>The <c>{shell, ShellSpec}</c> option indicates that the trace messages should + be printed on the console as they are received by the tracing + process. This implies <c>{local, File}</c> trace client. If the ShellSpec + is <c>only</c> (instead of <c>true</c>), no trace logs are stored. + </p> + <p>The <c>shell</c> option is a shortcut for <c>{shell, true}</c>.</p> + <p>The <c>timer</c> option indicates that the trace should be + automatically stopped after <c>MSec</c> milliseconds. <c>StopOpts</c> + are passed to <c>ttb:stop/2</c> command if specified (default is <c>[]</c>). + Note that the timing is approximate, as delays related to + network communication are always present. The timer starts after + <c>ttb:p/2</c> is issued, so you can set up your trace patterns before. + </p> + <p>The <c>overload</c> option allows to enable overload + checking on the nodes under trace. <c>Module:Function(check)</c> + is performed each <c>MSec</c> milliseconds. If the check returns + <c>true</c>, the tracing is disabled on a given node.<br/> + <c>Module:Function</c> should be able to handle at least three + atoms: <c>init</c>, <c>check</c> and <c>stop</c>. <c>init</c> and + <c>stop</c> give the user a possibility to initialize and clean + up the check environment.<br/> + When a node gets overloaded, it is not possible to issue <c>ttb:p</c> + nor any command from the <c>ttb:tp</c> family, as it would lead to + inconsistent tracing state (different trace specifications on + different node). + </p> + <p>The <c>flush</c> option periodically flushes all file trace + port clients (see <c>dbg:flush_trace_port/1</c>). When enabled, + the buffers are freed each <c>MSec</c> milliseconds. This option is + not allowed with <c>{file, {local, File}}</c> tracing. + </p> + <p><c>{resume, FetchTimeout}</c> enables the autoresume feature. + Whenever enabled, remote nodes try to reconnect to the controlling node + in case they were restarted. The feature requires <c>runtime_tools</c> + application to be started (so it has to be present in the <c>.boot</c> + scripts if the traced nodes run with embedded erlang). If this is + not possible, resume may be performed manually by starting + <c>runtime_tools</c> remotely using <c>rpc:call/4</c>.<br/> + <c>ttb</c> tries to fetch all logs from a reconnecting node before + reinitializing the trace. This has to finish within FetchTimeout milliseconds + or is aborted<br/> + By default, autostart information is stored in a file called + <c>ttb_autostart.bin</c> on each node. If this is not desired + (i.e. on diskless nodes), a custom module to handle autostart + information storage and retrieval can be provided by specifying + <c>ttb_autostart_module</c> environment variable for the <c>runtime_tools</c> + application. The module has to respond to the following API: + <taglist> + <tag><c>write_config(Data) -> ok</c></tag> + <item>Store the provided data for further retrieval. It is + important to realize that the data storage used must not + be affected by the node crash.</item> + <tag><c>read_config() -> {ok, Data} | {error, Error}</c></tag> + <item>Retrieve configuration stored with <c>write_config(Data)</c>.</item> + <tag><c>delete_config() -> ok</c></tag> + <item>Delete configuration stored with <c>write_config(Data)</c>. + Note that after this call any subsequent calls to <c>read_config</c> + must return <c>{error, Error}</c>. + </item> + </taglist> + </p> + <p>The <c>resume</c> option implies the default <c>FetchTimeout</c>, which is + 10 seconds</p> </desc> </func> <func> @@ -110,7 +221,7 @@ </type> <desc> <p>This function sets the given trace flags on the given - processes. + processes. The <c>timestamp</c> flag is always turned on. </p> <p>Please turn to the Reference manual for module <c>dbg</c> for details about the possible trace flags. The parameter @@ -119,6 +230,9 @@ registered names or process identifiers. If a registered name is given, the flags are set on processes with this name on all active nodes.</p> + <p>Issuing this command starts the timer for this trace if + <c>timer</c> option was specified with <c>tracer/2</c>. + </p> </desc> </func> <func> @@ -155,6 +269,18 @@ <tag><c>ctpg</c></tag> <item>Clear trace pattern on global function calls</item> </taglist> + <p>With <c>tp</c> and <c>tpl</c> one of match specification shortcuts + may be used (example: <c>ttb:tp(foo_module, caller)</c>). The shortcuts are: + <taglist> + <item><c>return</c> - for <c>[{'_',[],[{return_trace}]}]</c> + (report the return value)</item> + <item><c>caller</c> - for <c>[{'_',[],[{message,{caller}}]}]</c> + (report the calling function)</item> + <item><c>{codestr, Str}</c> - for <c>dbg:fun2ms/1</c> arguments + passed as strings (example: <c>"fun(_) -> return_trace() end"</c>) + </item> + </taglist> + </p> </desc> </func> <func> @@ -189,7 +315,7 @@ </desc> </func> <func> - <name>write_config(ConfigFile,Config,Opt) -> ok | {error,Reason}</name> + <name>write_config(ConfigFile,Config,Opts) -> ok | {error,Reason}</name> <fsummary>Creates a config file.</fsummary> <type> <v>ConfigFile = string()</v> @@ -197,7 +323,8 @@ <v>Mod = atom()</v> <v>Func = atom()</v> <v>Args = [term()]</v> - <v>Opt = [] | [append]</v> + <v>Opts = Opt | [Opt]</v> + <v>Opt = append</v> </type> <desc> <p>This function creates or extends a config file which can be @@ -213,9 +340,9 @@ should be a list of integers pointing out the entries to be stored. </p> - <p>If <c>Opt</c> is not given or if it is <c>[]</c>, + <p>If <c>Opts</c> is not given or if it is <c>[]</c>, <c>ConfigFile</c> is deleted and a new file is created. If - <c>Opt = [append]</c>, <c>ConfigFile</c> will not be deleted. + <c>Opts = [append]</c>, <c>ConfigFile</c> will not be deleted. The new information will be appended at the end of the file.</p> </desc> </func> @@ -226,7 +353,9 @@ <v>ConfigFile = string()</v> </type> <desc> - <p>Executes all entries in the given config file.</p> + <p>Executes all entries in the given config file. Note that the history + of the last trace is always available in the file named + <c>ttb_last_config</c>.</p> </desc> </func> <func> @@ -243,6 +372,9 @@ </p> <p>The content of a config file can be listed with <c>list_config/1</c>.</p> + <p> Note that the history + of the last trace is always available in the file named + <c>ttb_last_config</c>.</p> </desc> </func> <func> @@ -334,29 +466,51 @@ </desc> </func> <func> - <name>stop(Opts) -> stopped</name> + <name>stop(Opts) -> stopped | {stopped, Dir}</name> <fsummary>Stop tracing and fetch/format logs from all nodes</fsummary> <type> - <v>Opts = [Opt]</v> - <v>Opt = fetch | format</v> + <v>Opts = Opt | [Opt]</v> + <v>Opt = nofetch | {fetch_dir, Dir} | format | {format, FormatOpts} | return_fetch_dir</v> + <v>Dir = string()</v> + <v>FormatOpts = see format/2</v> </type> <desc> - <p>Stops tracing on all nodes. - </p> - <p>The <c>fetch</c> option indicates that trace logs shall be - collected from all nodes after tracing is stopped. This option - is useful if nodes on remote machines are traced. Logs and - trace information files are then sent to the trace control + <p>Stops tracing on all nodes. Logs and + trace information files are sent to the trace control node and stored in a directory named - <c>ttb_upload-Timestamp</c>, where <c>Timestamp</c> is on the + <c>ttb_upload_FileName-Timestamp</c>, where <c>Filename</c> is + the one provided with <c>{file, File}</c> during trace setup + and <c>Timestamp</c> is of the form <c>yyyymmdd-hhmmss</c>. Even logs from nodes on the same machine as the trace control node are moved to this directory. - </p> + The history list is saved to a file named <c>ttb_last_config</c> + for further reference (as it will be not longer accessible + through history and configuration management functions (like + <c>ttb:list_history/0</c>). + </p> + <p>The <c>nofetch</c> option indicates that trace logs shall not be + collected after tracing is stopped. + </p> + <p>The <c>{fetch, Dir}</c> option allows to specify the directory + to fetch the data to. If the directory already exists, an + error is thrown. + </p> <p>The <c>format</c> option indicates that the trace logs - shall be formatted after tracing is stopped. Note that this - option also implies the <c>fetch</c> option, i.e. logs are - collected in a new directory on the trace control node before - formatting. All logs in the directory will be merged.</p> + shall be formatted after tracing is stopped. All logs in the fetch directory will be merged. + You may use <c>{format, FormatOpts}</c> to pass additional + arguments to <c>format/2</c>.</p> + <p>The <c>return_fetch_dir</c> option indicates that the return value + should be <c>{stopped, Dir}</c> and not just <c>stopped</c>. + This implies <c>fetch</c>. + </p> + </desc> + </func> + <func> + <name>get_et_handler()</name> + <fsummary>Returns <c>et</c> handler.</fsummary> + <desc> + <p>The <c>et</c> handler returned by the function may be used with <c>format/2</c> + or <c>tracer/2</c>. Example: <c>ttb:format(Dir, [{handler, ttb:get_et_handler()}])</c>.</p> </desc> </func> <func> @@ -372,37 +526,40 @@ <type> <v>File = string() | [string()]</v> <d>This can be the name of a binary log, a list of such logs or the name of a directory containing one or more binary logs.</d> - <v>Options = [Opt]</v> - <v>Opt = {out,Out} | {handler,FormatHandler}</v> + <v>Options = Opt | [Opt]</v> + <v>Opt = {out,Out} | {handler,FormatHandler} | disable_sort</v> <v>Out = standard_io | string()</v> - <v>FormatHandler = {Function, InitialState} | et</v> + <v>FormatHandler = {Function, InitialState}</v> <v>Function = fun(Fd,Trace,TraceInfo,State) -> State</v> <v>Fd = standard_io | FileDescriptor</v> <d>This is the file descriptor of the destination file <c>Out</c></d> <v>Trace = tuple()</v> <d>This is the trace message. Please turn to the Reference manual for the <c>erlang</c>module for details.</d> <v>TraceInfo = [{Key,ValueList}]</v> - <d>This includes the keys <c>flags</c>, <c>client</c>and <c>node</c>, and if <c>handler</c>is given as option to the tracer function, this is also included. In addition all information written with the <c>write_trace_info/2</c>function is included. </d> + <d>This includes the keys <c>flags</c>, <c>client</c> and <c>node</c>, and if <c>handler</c> is given as option to the tracer function, this is also included. In addition all information written with the <c>write_trace_info/2</c>function is included. </d> </type> <desc> - <p>Reads the given binary trace log(s). If a directory or a - list of logs is given and the <c>timestamp</c> flag was set - during tracing, the trace messages from the different logs are - merged according to the timestamps. - </p> + <p>Reads the given binary trace log(s). The logs are processed + in the order of their timestamp as long as <c>disable_sort</c> + option is not given. + </p> <p>If <c>FormatHandler = {Function,InitialState}</c>, <c>Function</c> will be called for each trace message. If - <c>FormatHandler = et</c>, <c>et_viewer</c> in the <em>Event Tracer</em> application (<c>et</c>) is used for presenting the - trace log graphically. <c>ttb</c> provides a few different + <c>FormatHandler = get_et_handler()</c>, <c>et_viewer</c> in + the <em>Event Tracer</em> application (<c>et</c>) is used for presenting + the trace log graphically. <c>ttb</c> provides a few different filters which can be selected from the Filter menu in the <c>et_viewer</c>. If <c>FormatHandler</c> is not given, a default handler is used which presents each trace message as a line of text. </p> + <p>The state returned from each call of <c>Function</c> is passed to the next call, + even if next call is to format a message from another log file. + </p> <p>If <c>Out</c> is given, <c>FormatHandler</c> gets the - filedescriptor to <c>Out</c> as the first parameter. + file descriptor to <c>Out</c> as the first parameter. </p> - <p><c>Out</c> is ignored if <c>FormatHandler = et</c>. + <p><c>Out</c> is ignored if <c>et</c> format handler is used. </p> <p>Wrap logs can be formatted one by one or all in one go. To format one of the wrap logs in a set, give the exact name of diff --git a/lib/observer/doc/src/ttb_ug.xml b/lib/observer/doc/src/ttb_ug.xml index 44b7b08fd3..4f2b55a22a 100644 --- a/lib/observer/doc/src/ttb_ug.xml +++ b/lib/observer/doc/src/ttb_ug.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2002</year><year>2009</year> + <year>2002</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -48,11 +48,13 @@ <item>Formatting of binary trace logs and merging of logs from multiple nodes.</item> </list> - <p>Even though the intention of the Trace Tool Builder is to serve - as a base for tailor made trace tools, it is of course possible - to use it directly from the erlang shell. The application only - allows the use of file port tracer, so if you would like would - like to use other types of trace clients you will be better off + <p>The intention of the Trace Tool Builder is to serve + as a base for tailor made trace tools, but you may use it directly + from the erlang shell (it may mimic <c>dbg</c> behaviour while + still providing useful additions like match specification shortcuts). + The application only + allows the use of file port tracer, so if you would like + to use other types of trace clients you will be better off using <c>dbg</c> directly instead.</p> </section> @@ -64,14 +66,15 @@ trace flags on the processes you want to trace with <c>ttb:p/2</c>. Then, when the tracing is completed, you must stop the tracer with <c>ttb:stop/0/1</c> and format the trace log with - <c>ttb:format/1/2</c>. + <c>ttb:format/1/2</c> (as long as there is anything to format, of + course). </p> - <p><c>ttb:tracer/0/1/2</c> opens a file trace port on each node - that shall be traced. All trace messages will be written to this - port and end up in a binary file (the binary trace log). + <p><c>ttb:tracer/0/1/2</c> opens a trace port on each node + that shall be traced. By default, trace messages are written + to binary files on remote nodes(the binary trace log). </p> - <p><c>ttb:p/2</c> specifies which processes that shall be - traced. Trace flags given in this call specifies what to trace on + <p><c>ttb:p/2</c> specifies which processes shall be + traced. Trace flags given in this call specify what to trace on each process. You can call this function several times if you like different trace flags to be set on different processes. </p> @@ -105,14 +108,15 @@ -export([f/0]). f() -> receive - From when pid(From) -> + From when is_pid(From) -> Now = erlang:now(), From ! {self(),Now} end. </code> <p>The following example shows the basic use of <c>ttb</c> from the erlang shell. Default options are used both for starting the - tracer and for formatting. This gives a trace log named - <c>Node-ttb</c>, where <c>Node</c> is the name of the node. The + tracer and for formatting (the custom fetch dir is however provided). + This gives a trace log named <c>Node-ttb</c> in the newly-created + directory, where <c>Node</c> is the name of the node. The default handler prints the formatted trace messages in the shell.</p> <code type="none"><![CDATA[ @@ -131,11 +135,11 @@ f() -> (tiger@durin)50> (tiger@durin)50> %% Here I set a trace pattern on erlang:now/0 (tiger@durin)50> %% The trace pattern is a simple match spec -(tiger@durin)50> %% generated by dbg:fun2ms/1. It indicates that -(tiger@durin)50> %% the return value shall be traced. -(tiger@durin)50> MS = dbg:fun2ms(fun(_) -> return_trace() end). -[{'_',[],[{return_trace}]}] -(tiger@durin)51> ttb:tp(erlang,now,MS). +(tiger@durin)50> %% indicating that the return value should be +(tiger@durin)50> %% traced. Refer to the reference_manual for +(tiger@durin)50> %% the full list of match spec shortcuts +(tiger@durin)50> %% available. +(tiger@durin)51> ttb:tp(erlang,now,return). {ok,[{matched,tiger@durin,1},{saved,1}]} (tiger@durin)52> (tiger@durin)52> %% I run my test (i.e. send a message to @@ -145,11 +149,11 @@ f() -> (tiger@durin)53> (tiger@durin)53> %% And then I have to stop ttb in order to flush (tiger@durin)53> %% the trace port buffer -(tiger@durin)53> ttb:stop(). -stopped +(tiger@durin)53> ttb:stop([return, {fetch_dir, "fetch"}]). +{stopped, "fetch"} (tiger@durin)54> (tiger@durin)54> %% Finally I format my trace log -(tiger@durin)54> ttb:format("tiger@durin-ttb"). +(tiger@durin)54> ttb:format("fetch"). ({<0.125.0>,{m,f,0},tiger@durin}) call erlang:now() ({<0.125.0>,{m,f,0},tiger@durin}) returned from erlang:now/0 -> {1031,133451,667611} @@ -166,11 +170,9 @@ ok ]]></code> -module(mydebug). -export([start/0,trc/1,stop/0,format/1]). -export([print/4]). - %% Include ms_transform.hrl so that I can use dbg:fun2ms/2 to %% generate match specifications. -include_lib("stdlib/include/ms_transform.hrl"). - %%% -------------Tool API------------- %%% ---------------------------------- %%% Star the "mydebug" tool @@ -180,28 +182,28 @@ start() -> %% module shall be used as format handler ttb:tracer(all,[{file,"debug_log"},{handler,{{?MODULE,print},0}}]), %% All processes (existing and new) shall trace function calls - %% and include a timestamp in each trace message - ttb:p(all,[call,timestamp]). + %% We want trace messages to be sorted upon format, which requires + %% timestamp flag. The flag is however enabled by default in ttb. + ttb:p(all,call). %%% Set trace pattern on function(s) -trc(M) when atom(M) -> +trc(M) when is_atom(M) -> trc({M,'_','_'}); -trc({M,F}) when atom(M), atom(F) -> +trc({M,F}) when is_atom(M), is_atom(F) -> trc({M,F,'_'}); -trc({M,F,_A}=MFA) when atom(M), atom(F) -> - %% This match spec specifies that return values shall - %% be traced. NOTE that ms_transform.hrl must be included - %% if dbg:fun2ms/1 shall be used! +trc({M,F,_A}=MFA) when is_atom(M), is_atom(F) -> + %% This match spec shortcut specifies that return values shall + %% be traced. MatchSpec = dbg:fun2ms(fun(_) -> return_trace() end), ttb:tpl(MFA,MatchSpec). %%% Format a binary trace log -format(File) -> - ttb:format(File). +format(Dir) -> + ttb:format(Dir). %%% Stop the "mydebug" tool stop() -> - ttb:stop(). + ttb:stop(return). %%% --------Internal functions-------- %%% ---------------------------------- @@ -226,9 +228,9 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> [N,Ts,P,M,F,A,R]). ]]></code> <p>To distinguish trace logs produced with this tool from other logs, the <c>file</c> option is used in <c>tracer/2</c>. The - logs will therefore be named <c>Node-debug_log</c>, where - <c>Node</c> is the name of the node where the log is produced. - </p> + logs will therefore be fetched to a directory named + <c>ttb_upload_debug_log-YYYYMMDD-HHMMSS</c> + </p> <p>By using the <c>handler</c> option when starting the tracer, the information about how to format the file is stored in the trace information file (<c>.ti</c>). This is not necessary, as @@ -278,13 +280,157 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> must be given to the <c>tracer/2</c> function with the value <c>{local, File}</c>, e.g.</p> <code type="none"> -(trace_control@durin)1> ttb:tracer(mynode@diskless,[{file,{local, -{wrap,"mytrace"}}}]). +(trace_control@durin)1> ttb:tracer(mynode@diskless,{file,{local, +{wrap,"mytrace"}}}). {ok,[mynode@diskless]} </code> </section> </section> <section> + <title>Additional tracing options</title> + <p>When setting up a trace, several features may be turned on:</p> + <list type="bulleted"> + <item>time-constrained tracing,</item> + <item>overload protection,</item> + <item>autoresuming.</item> + </list> + <section> + <title>Time-constrained tracing</title> + <p>Sometimes, it may be helpful to enable trace for a + given period of time (i.e. to monitor a system for 24 hours + or half of a second). This may be done by issuing additional + <c>{timer, TimerSpec}</c> option. If <c>TimerSpec</c> has the + form of <c>MSec</c>, the trace is stopped after <c>MSec</c> + milliseconds using <c>ttb:stop/0</c>. If any additional options + are provided (<c>TimerSpec = {MSec, Opts}</c>), <c>ttb:stop/1</c> + is called instead with <c>Opts</c> as the arguments. The timer + is started with <c>ttb:p/2</c>, so any trace patterns should + be set up before. <c>ttb:start_trace/4</c> + always sets up all pattern before invoking <c>ttb:p/2</c>. + Note that due to network and processing delays the the period + of tracing is approximate. + The example below shows how to set up a trace which will be + automatically stopped and formatted after 5 seconds + </p><code> +(tiger@durin)1>ttb:start_trace([node()], + [{erlang, now,[]}], + {all, call}, + [{timer, {5000, format}}]). +</code> + </section> + <section> + <label>Overload protection</label> + <p>When tracing live systems, special care needs to be always taken + not to overload a node with too heavy tracing. <c>ttb</c> provides + the <c>overload</c> option to help to address the problem.</p> + <p><c>{overload, MSec, Module, Function}</c> instructs the ttb backend + (called <c>observer_backend</c>, part of the <c>runtime_tools</c> + application) to perform overload check every <c>MSec</c> milliseconds. + If the check (namely <c>Module:Function(check)</c>) returns + <c>true</c>, tracing is disabled on the selected node.</p> + <p>Overload protection activated on one node does not + affect other nodes, where the tracing continues as normal. + <c>ttb:stop/0/1</c> fetches data from all clients, including everything + that has been collected before overload protection was activated. + Note that + changing trace details (with <c>ttb:p</c> and <c>ttb:tp/tpl...</c>) + once overload protection gets activated in one of the traced + nodes is not permitted in order not to allow trace setup + to be inconsistent between nodes. + </p> + <p><c>Module:Function</c> provided with the <c>overload</c> option must + handle three calls: <c>init</c>, <c>check</c> and <c>stop</c>. <c>init</c> + and <c>stop</c> allows to perform some setup and teardown required by + the check. An overload check module could look like this (note that + <c>check</c> is always called by the same process, so <c>put</c> and + <c>get</c> are possible). + </p><code> +-module(overload). +-export([check/1]). + +check(init) -> + Pid = sophisticated_module:start(), + put(pid, Pid); +check(check) -> + get(pid) ! is_overloaded, + receive + Reply -> + Reply + after 5000 -> + true + end; +check(stop) -> + get(pid) ! stop.</code> + </section> + <section> + <title>Autoresume</title> + <p>It is possible that a node (probably a buggy one, hence traced) + crashes. In order to automatically resume tracing on the node + as soon as it gets back, <c>resume</c> has to be used. When + it is, the failing node tries to reconnect + to trace control node as soon as <c>runtime tools</c> is started. + This implies that <c>runtime_tools</c> must be included in + other node's startup chain (if it is not, one could still + resume tracing by starting <c>runtime_tools</c> manually, + i.e. by an RPC call).</p> + <p>In order not to loose the data that the failing node stored + up to the point of crash, the control node will try to fetch + it before restarting trace. This must happen within the allowed + time frame or is aborted (default is 10 seconds, can be customized with + <c>{resume, MSec}</c>). The data fetched this way is then + merged with all other traces.</p> + <p>Autostart feature requires additional data to be stored on + traced nodes. By default, the data is stored automatically + to the file called "ttb_autostart.bin" in the traced node's cwd. + Users may decide to change this behaviour (i.e. on diskless + nodes) by specifying their own module to handle autostart data + storage and retrieval (<c>ttb_autostart_module</c> + environment variable of <c>runtime_tools</c>). Please see the + ttb's reference manual to see the module's API. This example + shows the default handler</p> + <code> +-module(ttb_autostart). +-export([read_config/0, + write_config/1, + delete_config/0]). + +-define(AUTOSTART_FILENAME, "ttb_autostart.bin"). + +delete_config() -> + file:delete(?AUTOSTART_FILENAME). + +read_config() -> + case file:read_file(?AUTOSTART_FILENAME) of + {ok, Data} -> {ok, binary_to_term(Data)}; + Error -> Error + end. + +write_config(Data) -> + file:write_file(?AUTOSTART_FILENAME, term_to_binary(Data)). + </code> + <p>Remember that file trace ports buffer the data + by default. If the node crashes, trace messages are not + flushed to the binary log. If the chance of failure is + high, it might be a good idea to automatically flush + the buffers every now and then. Passing <c>{flush, MSec}</c> + as one of <c>ttb:tracer/2</c> option flushes all buffers + every <c>MSec</c> milliseconds.</p> + </section> + <section> + <title>dbg mode</title> + <p>The <c>{shell, ShellType}</c> option allows to make <c>ttb</c> + operation similar to <c>dbg</c>. Using <c>{shell, true}</c> + displays all trace messages in the shell before storing them. + <c>{shell, only}</c> additionally disables message storage + (so that the tool behaves exactly like dbg). This is allowed + only with ip trace ports (<c>{trace, {local, File}}</c>). + </p> + <p>The command <c>ttb:tracer(dbg)</c> is a shortcut for the pure-dbg + mode (<c>{shell, only}</c>).</p> + </section> + </section> + + <section> <marker id="trace_info"></marker> <title>Trace Information and the .ti File</title> <p>In addition to the trace log file(s), a file with the extension @@ -292,13 +438,9 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> is the trace information file. It is a binary file, and it contains the process information, trace flags used, the name of the node to which it belongs and all information written with the - <c>write_trace_info/2</c> function. - </p> - <p>To be able to use all this information during formatting, it is - important that the trace information file exists in the same - directory as the trace log, and that it has the same name as the - trace log with the additional extension <c>.ti</c>. - </p> + <c>write_trace_info/2</c> function. .ti files are always fetched + with other logs when the trace is stopped. + </p> <p>Except for the process information, everything in the trace information file is passed on to the handler function when formatting. The <c>TI</c> parameter is a list of @@ -327,7 +469,12 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> each log. <c>ttb</c> will create a new binary log each time a log reaches the maximum size. When the the maximum number of logs are reached, the oldest log is deleted before a new one is created. - </p> + </p> + <p>Note that the overall size of data generated by ttb may be greater + than the wrap specification would suggest - if a traced node restarts + and autoresume is enabled, old wrap log is always stored and + a new one is created. + </p> <p>Wrap logs can be formatted one by one or all at once. See <seealso marker="#format">Formatting</seealso>. </p> @@ -348,12 +495,10 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> present the trace log graphically (see <seealso marker="#et_viewer">Presenting trace logs with Event Tracer</seealso>). </p> <p>The first argument to <c>ttb:format/1/2</c> specifies which - binary log(s) to format. This can be the name of one binary log, a - list of such logs or the name of a directory containing one or - more binary logs. If this argument indicates more than one log, - and the <c>timestamp</c> flag was set when tracing, the trace - messages from the different logs will be merged according to the - timestamps in each message. + binary log(s) to format. This is usually the name of a directory + that ttb created during log fetch. Unless there is the <c>disable_sort</c> + option provided, the logs from different files are always sorted + according to timestamp in traces. </p> <p>The second argument to <c>ttb:format/2</c> is a list of options. The <c>out</c> option specifies the destination where the @@ -363,7 +508,10 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> option is not given, the <c>handler</c> option given when starting the tracer is used. If the <c>handler</c> option was not given when starting the tracer either, a default handler is used, which - prints each trace message as a line of text. + prints each trace message as a line of text. The <c>disable_sort</c> + option indicates that there logs should not be merged according to + timestamp, but processed one file after another (this might be + a bit faster). </p> <p>A format handler is a fun taking four arguments. This fun will be called for each trace message in the binary log(s). A simple @@ -396,10 +544,24 @@ end </code> <c>handle_gc/4</c> in the module <c>multitrace.erl</c> which can be found in the <c>src</c> directory of the Observer application. </p> - <p>By giving the format handler <c>et</c>, you can have the trace + <p>The actual trace message is passed as the second argument (<c>Trace</c>). + The possible values of <c>Trace</c> are:</p> + <list type="bulleted"> + <item>all trace messages described in <c>erlang:trace/3</c> documentation, + </item> + <item><c>{drop, N}</c> if ip tracer is used (see <c>dbg:trace_port/2</c>), + </item> + <item><c>end_of_trace</c> received once when all trace messages have + been processed.</item> + </list> + <p>By giving the format handler <c>ttb:get_et_handler()</c>, you can have the trace log presented graphically with <c>et_viewer</c> in the Event Tracer application (see <seealso marker="#et_viewer">Presenting trace logs with Event Tracer</seealso>). - </p> + </p> + <p>You may always decide not to format the whole trace data contained + in the fetch directory, but analyze single files instead. In order + to do so, a single file (or list of files) have to be passed as + the first argument to <c>format/1/2</c>.</p> <p>Wrap logs can be formatted one by one or all in one go. To format one of the wrap logs in a set, give the exact name of the file. To format the whole set of wrap logs, give the name with '*' @@ -407,7 +569,7 @@ end </code> </p> <p>Start tracing:</p> <code type="none"> -(tiger@durin)1> ttb:tracer(node(),[{file,{wrap,"trace"}}]). +(tiger@durin)1> ttb:tracer(node(),{file,{wrap,"trace"}}). {ok,[tiger@durin]} (tiger@durin)2> ttb:p(...) ... </code> @@ -443,7 +605,7 @@ ok to the User's Guide and Reference Manuals for the <c>et</c> application. </p> - <p>By giving the format handler <c>et</c>, you can have the + <p>By giving the format handler <c>ttb:get_et_handler()</c>, you can have the trace log presented graphically with <c>et_viewer</c> in the Event Tracer application. <c>ttb</c> provides a few different filters which can be selected from the Filter menu in the @@ -495,9 +657,23 @@ ok filters respectively, except that each module or function can have several vertical lines, one for each process it resides on. </p> - <p>As an example this module is used, and the function - <c>bar:f1()</c> is called from another module <c>foo</c>.</p> + <p>In the next example, modules <c>foo</c> and <c>bar</c> are used:</p> <code type="none"> +-module(foo). +-export([start/0,go/0]). + +start() -> + spawn(?MODULE, go, []). + +go() -> + receive + stop -> + ok; + go -> + bar:f1(), + go() + end. +</code><code type="none"> -module(bar). -export([f1/0,f3/0]). f1() -> @@ -506,12 +682,23 @@ f1() -> f2() -> spawn(?MODULE,f3,[]). f3() -> - ok. </code> - <p>The <c>call</c> and <c>return_to</c> flags are used, and - trace pattern is set on local calls in module <c>bar</c>. - </p> - <p><c>ttb:format("tiger@durin-ttb", [{handler, et}])</c> gives the - following result: + ok.</code> + + <p>Now let's set up the trace.</p> +<code> +(tiger@durin)1>%%First we retrieve the Pid to limit traced processes set +(tiger@durin)1>Pid = foo:start(). +(tiger@durin)2>%%Now we set up tracing +(tiger@durin)2>ttb:tracer(). +(tiger@durin)3>ttb:p(Pid, [call, return_to, procs, set_on_spawn]). +(tiger@durin)4>ttb:tpl(bar, []). +(tiger@durin)5>%%Invoke our test function and see output with et viewer +(tiger@durin)5>Pid ! go. +(tiger@durin)6>ttb:stop({format, {handler, ttb:get_et_handler()}}). +</code> + + <p>This shoud render a result similar to the + following: </p> <p></p> <image file="et_processes.gif"> @@ -520,25 +707,37 @@ f3() -> <image file="et_modsprocs.gif"> <icaption>Filter: "mods_and_procs"</icaption> </image> + + <p>Note, that we can use <c>ttb:start_trace/4</c> function to help + us here:</p> +<code> +(tiger@durin)1>Pid = foo:start(). +(tiger@durin)2>ttb:start_trace([node()], + [{bar,[]}], + {Pid, [call, return_to, procs, set_on_spawn]} + {handler, ttb:get_et_handler()}). +(tiger@durin)3>Pid ! go. +(tiger@durin)4>ttb:stop(format). +</code> + </section> </section> <section> <marker id="fetch_format"></marker> <title>Automatically collect and format logs from all nodes</title> - <p>If the option <c>fetch</c> is given to the <c>ttb:stop/1</c> - function, trace logs and trace information files are fetched - from all nodes after tracing is stopped. The logs are stored in a - new directory named <c>ttb_upload-Timestamp</c> under the working - directory of the trace control node. + <p>By default <c>ttb:stop/1</c> fetches trace logs and + trace information files from all nodes. The logs are stored in a + new directory named <c>ttb_upload-Filename-Timestamp</c> under the working + directory of the trace control node. Fetching may be disabled by + providing the <c>nofetch</c> option to <c>ttb:stop/1</c>. User can + specify a fetch directory of his choice passing the + <c>{fetch_dir, Dir}</c> option. </p> <p>If the option <c>format</c> is given to <c>ttb:stop/1</c>, the trace logs are automatically formatted after tracing is - stopped. Note that <c>format</c> also implies <c>fetch</c>, - i.e. the trace logs will be collected from all nodes as for the - <c>fetch</c> option before they are formatted. All logs in the - upload directory are merged during formatting. - </p> + stopped. + </p> </section> <section> @@ -546,13 +745,18 @@ f3() -> <p>For the tracing functionality, <c>dbg</c> could be used instead of the <c>ttb</c> for setting trace flags on processes and trace patterns for call trace, i.e. the functions <c>p</c>, <c>tp</c>, - <c>tpl</c>, <c>ctp</c>, <c>ctpl</c> and <c>ctpg</c>. The only - thing added by <c>ttb</c> for these functions is that all calls - are stored in the history buffer and can be recalled and stored in - a configuration file. This makes it easy to setup the same trace - environment e.g. if you want to compare two test runs. It also - reduces the amount of typing when using <c>ttb</c> from the erlang - shell. + <c>tpl</c>, <c>ctp</c>, <c>ctpl</c> and <c>ctpg</c>. There are only + two things added by <c>ttb</c> for these functions: + <list type="bulleted"> + <item>all calls are stored in the history buffer and can be + recalled and stored in a configuration file. This makes it + easy to setup the same trace environment e.g. if you want to + compare two test runs. It also reduces the amount of + typing when using <c>ttb</c> from the erlang shell;</item> + <item>shortcuts are provided for the most common match + specifications (in order not to force the user to use + <c>dbg:fun2ms</c> continually</item>). + </list> </p> <p>Use <c>list_history/0</c> to see the content of the history buffer, and <c>run_history/1</c> to re-execute one of the entries. @@ -574,7 +778,8 @@ f3() -> selected entries from the history by calling <c>ttb:write_config(ConfigFile,NumList)</c>, where <c>NumList</c> is a list of integers pointing out the history - entries to write. + entries to write. Moreover, the history buffer is always dumped + to <c>ttb_last_config</c> when <c>ttb:stop/0/1</c> is called. </p> <p>User defined entries can also be written to a config file by calling the function @@ -720,9 +925,7 @@ ok {ok,[{matched,1},{saved,1}]} (tiger@durin)113> dbg:get_tracer(), seq_trace:reset_trace(). true -(tiger@durin)114> ttb:stop(). -ok -(tiger@durin)115> ttb:format("tiger@durin-ttb"). +(tiger@durin)114> ttb:stop(format). ({<0.158.0>,{shell,evaluator,3},tiger@durin}) call dbg:get_tracer() SeqTrace [0]: ({<0.158.0>,{shell,evaluator,3},tiger@durin}) {<0.237.0>,dbg,tiger@durin} ! {<0.158.0>,{get_tracer,tiger@durin}} @@ -743,9 +946,7 @@ ok (tiger@durin)117> seq_trace:set_token(send,true), dbg:get_tracer(), seq_trace:reset_trace(). true -(tiger@durin)118> ttb:stop(). -ok -(tiger@durin)119> ttb:format("tiger@durin-ttb"). +(tiger@durin)118> ttb:stop(format). SeqTrace [0]: ({<0.158.0>,{shell,evaluator,3},tiger@durin}) {<0.246.0>,dbg,tiger@durin} ! {<0.158.0>,{get_tracer,tiger@durin}} [Serial: {0,1}] diff --git a/lib/observer/src/ttb.erl b/lib/observer/src/ttb.erl index 221b71df6a..1471be92e5 100644 --- a/lib/observer/src/ttb.erl +++ b/lib/observer/src/ttb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-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 @@ -18,9 +18,11 @@ %% -module(ttb). -author('[email protected]'). +-author('[email protected]'). %% API --export([tracer/0,tracer/1,tracer/2,p/2,stop/0,stop/1]). +-export([tracer/0,tracer/1,tracer/2,p/2,stop/0,stop/1,start_trace/4]). +-export([get_et_handler/0]). -export([tp/2, tp/3, tp/4, ctp/0, ctp/1, ctp/2, ctp/3, tpl/2, tpl/3, tpl/4, ctpl/0, ctpl/1, ctpl/2, ctpl/3, ctpg/0, ctpg/1, ctpg/2, ctpg/3]). -export([seq_trigger_ms/0,seq_trigger_ms/1]). @@ -34,24 +36,38 @@ -include_lib("kernel/include/file.hrl"). -define(meta_time,5000). +-define(fetch_time, 10000). -define(history_table,ttb_history_table). -define(seq_trace_flags,[send,'receive',print,timestamp]). --define(upload_dir,"ttb_upload"). +-define(upload_dir(Logname),"ttb_upload_"++Logname). +-define(last_config, "ttb_last_config"). +-define(partial_dir, "ttb_partial_result"). -ifdef(debug). --define(get_status,;get_status -> erlang:display(dict:to_list(NodeInfo)),loop(NodeInfo)). +-define(get_status,;get_status -> erlang:display(dict:to_list(NodeInfo),loop(NodeInfo, TraceInfo)). -else. -define(get_status,). -endif. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Shortcut +start_trace(Nodes, Patterns, {Procs, Flags}, Options) -> + {ok, _} = tracer(Nodes, Options), + [{ok, _} = apply(?MODULE, tpl, tuple_to_list(Args)) || Args <- Patterns], + {ok, _} = p(Procs, Flags). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Open a trace port on all given nodes and create the meta data file tracer() -> tracer(node()). +tracer(shell) -> tracer(node(), shell); +tracer(dbg) -> tracer(node(), {shell, only}); tracer(Nodes) -> tracer(Nodes,[]). tracer(Nodes,Opt) -> - start(), - store(tracer,[Nodes,Opt]), {PI,Client,Traci} = opt(Opt), - do_tracer(Nodes,PI,Client,Traci). + %%We use initial Traci as SessionInfo for loop/2 + Pid = start(Traci), + store(tracer,[Nodes,Opt]), + do_tracer(Nodes,PI,Client,[{ttb_control, Pid}|Traci]). do_tracer(Nodes0,PI,Client,Traci) -> Nodes = nods(Nodes0), @@ -59,9 +75,14 @@ do_tracer(Nodes0,PI,Client,Traci) -> do_tracer(Clients,PI,Traci). do_tracer(Clients,PI,Traci) -> + ShellOutput = proplists:get_value(shell, Traci, false), {ClientSucc,Succ} = lists:foldl( fun({N,{local,File},TF},{CS,S}) -> + TF2 = case ShellOutput of + only -> none; + _ -> TF + end, [_Sname,Host] = string:tokens(atom_to_list(N),"@"), case catch dbg:tracer(N,port,dbg:trace_port(ip,0)) of {ok,N} -> @@ -69,8 +90,8 @@ do_tracer(Clients,PI,Traci) -> {ok,T} = dbg:get_tracer(N), rpc:call(N,seq_trace,set_system_tracer,[T]), dbg:trace_client(ip,{Host,Port}, - {fun ip_to_file/2,{file,File}}), - {[{N,{local,File,Port},TF}|CS], [N|S]}; + {fun ip_to_file/2,{{file,File}, ShellOutput}}), + {[{N,{local,File,Port},TF2}|CS], [N|S]}; Other -> display_warning(N,{cannot_open_ip_trace_port, Host, @@ -98,17 +119,54 @@ do_tracer(Clients,PI,Traci) -> {ok,Succ} end. +opt(Opt) when is_list(Opt) -> + opt(Opt,{true,?MODULE,[]}); opt(Opt) -> - opt(Opt,{true,?MODULE,[]}). + opt([Opt]). opt([{process_info,PI}|O],{_,Client,Traci}) -> opt(O,{PI,Client,Traci}); opt([{file,Client}|O],{PI,_,Traci}) -> - opt(O,{PI,Client,Traci}); + opt(O,{PI,Client,[{logfile,get_logname(Client)}|Traci]}); opt([{handler,Handler}|O],{PI,Client,Traci}) -> opt(O,{PI,Client,[{handler,Handler}|Traci]}); +opt([{timer, {MSec, StopOpts}}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{timer,{MSec, StopOpts}}|Traci]}); +opt([{timer, MSec}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{timer,{MSec, []}}|Traci]}); +opt([{overload_check, {MSec,M,F}}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{overload_check,{MSec,M,F}}|Traci]}); +opt([shell|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{shell, true}|Traci]}); +opt([{shell,Type}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{shell, Type}|Traci]}); +opt([resume|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{resume, {true, ?fetch_time}}|Traci]}); +opt([{resume,MSec}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{resume, {true, MSec}}|Traci]}); +opt([{flush,MSec}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{flush, MSec}|Traci]}); opt([],Opt) -> - Opt. + ensure_opt(Opt). + +ensure_opt({PI,Client,Traci}) -> + case {proplists:get_value(flush, Traci), Client} of + {undefined, _} -> ok; + {_, {local, _}} -> exit(flush_unsupported_with_ip_trace_port); + {_,_} -> ok + end, + NeedIpTracer = proplists:get_value(shell, Traci, false) /= false, + case {NeedIpTracer, Client} of + {false, _} -> {PI, Client, Traci}; + {true, ?MODULE} -> {PI, {local, ?MODULE}, Traci}; + {true, {local, File}} -> {PI, {local, File}, Traci}; + {true, _} -> exit(local_client_required_on_shell_tracing) + end. + +get_logname({local, F}) -> get_logname(F); +get_logname({wrap, F}) -> filename:basename(F); +get_logname({wrap, F, _, _}) -> filename:basename(F); +get_logname(F) -> filename:basename(F). nods(all) -> Nodes1 = remove_active([node()|nodes()]), @@ -205,17 +263,29 @@ run_history([H|T]) -> ok -> run_history(T); {error,not_found} -> {error,{not_found,H}} end; + +run_history(all) -> + CurrentHist = ets:tab2list(?history_table), + ets:delete_all_objects(?history_table), + [run_printed(MFA,true) || {_, MFA} <- CurrentHist]; +run_history(all_silent) -> + CurrentHist = ets:tab2list(?history_table), + ets:delete_all_objects(?history_table), + [run_printed(MFA,false) || {_, MFA} <- CurrentHist]; run_history([]) -> ok; run_history(N) -> case catch ets:lookup(?history_table,N) of [{N,{M,F,A}}] -> - print_func(M,F,A), - R = apply(M,F,A), - print_result(R); + run_printed({M,F,A},true); _ -> {error, not_found} end. + +run_printed({M,F,A},Verbose) -> + Verbose andalso print_func(M,F,A), + R = apply(M,F,A), + Verbose andalso print_result(R). write_config(ConfigFile,all) -> write_config(ConfigFile,['_']); @@ -223,6 +293,8 @@ write_config(ConfigFile,Config) -> write_config(ConfigFile,Config,[]). write_config(ConfigFile,all,Opt) -> write_config(ConfigFile,['_'],Opt); +write_config(ConfigFile,Config,Opt) when not(is_list(Opt)) -> + write_config(ConfigFile,Config,[Opt]); write_config(ConfigFile,Nums,Opt) when is_list(Nums), is_integer(hd(Nums)); Nums=:=['_'] -> F = fun(N) -> ets:select(?history_table, @@ -313,6 +385,7 @@ arg_list([A1|A],Acc) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Set trace flags on processes p(Procs0,Flags0) -> + ensure_no_overloaded_nodes(), store(p,[Procs0,Flags0]), no_store_p(Procs0,Flags0). no_store_p(Procs0,Flags0) -> @@ -327,11 +400,12 @@ no_store_p(Procs0,Flags0) -> {error,Reason} -> display_warning(P,Reason), {PMatched,Ps} - end + end end,{[],[]},Procs) of {[],[]} -> {error, no_match}; {SuccMatched,Succ} -> no_store_write_trace_info(flags,{Succ,Flags}), + ?MODULE ! trace_started, {ok,SuccMatched} end end. @@ -339,7 +413,7 @@ no_store_p(Procs0,Flags0) -> transform_flags([clear]) -> [clear]; transform_flags(Flags) -> - dbg:transform_flags(Flags). + dbg:transform_flags([timestamp | Flags]). procs(Procs) when is_list(Procs) -> @@ -365,24 +439,30 @@ proc({global,Name}) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Trace pattern tp(A,B) -> - store(tp,[A,B]), - dbg:tp(A,B). + ensure_no_overloaded_nodes(), + store(tp,[A,ms(B)]), + dbg:tp(A,ms(B)). tp(A,B,C) -> - store(tp,[A,B,C]), - dbg:tp(A,B,C). + ensure_no_overloaded_nodes(), + store(tp,[A,B,ms(C)]), + dbg:tp(A,B,ms(C)). tp(A,B,C,D) -> - store(tp,[A,B,C,D]), - dbg:tp(A,B,C,D). + ensure_no_overloaded_nodes(), + store(tp,[A,B,C,ms(D)]), + dbg:tp(A,B,C,ms(D)). tpl(A,B) -> - store(tpl,[A,B]), - dbg:tpl(A,B). + ensure_no_overloaded_nodes(), + store(tpl,[A,ms(B)]), + dbg:tpl(A,ms(B)). tpl(A,B,C) -> - store(tpl,[A,B,C]), - dbg:tpl(A,B,C). + ensure_no_overloaded_nodes(), + store(tpl,[A,B,ms(C)]), + dbg:tpl(A,B,ms(C)). tpl(A,B,C,D) -> - store(tpl,[A,B,C,D]), - dbg:tpl(A,B,C,D). + ensure_no_overloaded_nodes(), + store(tpl,[A,B,C,ms(D)]), + dbg:tpl(A,B,C,ms(D)). ctp() -> store(ctp,[]), @@ -423,6 +503,56 @@ ctpg(A,B,C) -> store(ctpg,[A,B,C]), dbg:ctpg(A,B,C). +ms(return) -> + [{'_',[],[{return_trace}]}]; +ms(caller) -> + [{'_',[],[{message,{caller}}]}]; +ms({codestr, FunStr}) -> + {ok, MS} = string2ms(FunStr), + MS; +ms(Other) -> + Other. + +ensure_no_overloaded_nodes() -> + Overloaded = case whereis(?MODULE) of + undefined -> + []; + _ -> + ?MODULE ! {get_overloaded, self()}, + receive {overloaded,O} -> O end + end, + case Overloaded of + [] -> ok; + Overloaded -> exit({error, overload_protection_active, Overloaded}) + end. + +-spec string2ms(string()) -> {ok, list()} | {error, fun_format}. +string2ms(FunStr) -> + case erl_scan:string(fix_dot(FunStr)) of + {ok, Tokens, _} -> + case erl_parse:parse_exprs(Tokens) of + {ok, [Expression]} -> + case Expression of + {_, _, {clauses, Clauses}} -> + {ok, ms_transform:transform_from_shell(dbg, Clauses, [])}; + _ -> + {error, fun_format} + end; + _ -> + {error, fun_format} + end; + _ ->{error, fun_format} + end. + +-spec fix_dot(string()) -> string(). +fix_dot(FunStr) -> + [H | Rest] = lists:reverse(FunStr), + case H of + $. -> + FunStr; + H -> + lists:reverse([$., H | Rest]) + end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Support for sequential trace @@ -457,66 +587,114 @@ no_store_write_trace_info(Key,What) -> %%% Stop tracing on all nodes stop() -> stop([]). -stop(Opts) -> +stop(Opts) when is_list(Opts) -> Fetch = stop_opts(Opts), - case whereis(?MODULE) of - undefined -> ok; - Pid when is_pid(Pid) -> - ?MODULE ! {stop,Fetch,self()}, - receive {?MODULE,stopped} -> ok end + Result = + case whereis(?MODULE) of + undefined -> ok; + Pid when is_pid(Pid) -> + ?MODULE ! {stop,Fetch,self()}, + receive {?MODULE,R} -> R end + end, + case {Fetch, Result} of + {nofetch, _} -> + ok; + {_, {stopped, _}} -> + %% Printout moved out of the ttb loop to avoid occasional deadlock + io:format("Stored logs in ~s~n", [element(2, Result)]); + {_, _} -> + ok end, - stopped. + stop_return(Result,Opts); +stop(Opts) -> + stop([Opts]). stop_opts(Opts) -> - case lists:member(format,Opts) of - true -> - format; % format implies fetch - false -> - case lists:member(fetch,Opts) of - true -> fetch; - false -> nofetch - end + FetchDir = proplists:get_value(fetch_dir, Opts), + ensure_fetch_dir(FetchDir), + FormatData = case proplists:get_value(format, Opts) of + undefined -> false; + true -> {format, []}; + FOpts -> {format, FOpts} + end, + case {FormatData, lists:member(return_fetch_dir, Opts)} of + {false, true} -> + {fetch, FetchDir}; % if we specify return_fetch_dir, the data should be fetched + {false, false} -> + case lists:member(nofetch,Opts) of + false -> {fetch, FetchDir}; + true -> nofetch + end; + {FormatData, _} -> + {FormatData, FetchDir} + end. + +ensure_fetch_dir(undefined) -> ok; +ensure_fetch_dir(Dir) -> + case filelib:is_file(Dir) of + true -> + throw({error, exists, Dir}); + false -> + ok + end. + +stop_return(R,Opts) -> + case {lists:member(return_fetch_dir,Opts),R} of + {true,_} -> + R; + {false,{stopped,_}} -> + stopped; + {false,_} -> + %% Anything other than 'stopped' would not be bw compatible... + stopped end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Process implementation -start() -> +start(SessionInfo) -> case whereis(?MODULE) of undefined -> Parent = self(), - Pid = spawn(fun() -> init(Parent) end), - receive {started,Pid} -> ok end; + Pid = spawn(fun() -> init(Parent, SessionInfo) end), + receive {started,Pid} -> ok end, + Pid; Pid when is_pid(Pid) -> - ok + Pid end. - -init(Parent) -> +init(Parent, SessionInfo) -> register(?MODULE,self()), ets:new(?history_table,[ordered_set,named_table,public]), Parent ! {started,self()}, - loop(dict:new()). + NewSessionInfo = [{partials, 0}, {dead_nodes, []} | SessionInfo], + try_send_flush_tick(NewSessionInfo), + loop(dict:new(), NewSessionInfo). -loop(NodeInfo) -> +loop(NodeInfo, SessionInfo) -> receive {init_node,Node,MetaFile,PI,Traci} -> erlang:monitor_node(Node,true), - MetaPid = + {AbsoluteMetaFile, MetaPid} = case rpc:call(Node, observer_backend, ttb_init_node, [MetaFile,PI,Traci]) of - {ok,MP} -> - MP; + {ok,MF,MP} -> + {MF,MP}; {badrpc,nodedown} -> %% We will get a nodedown message - undefined + {MetaFile,undefined} end, - loop(dict:store(Node,{MetaFile,MetaPid},NodeInfo)); + loop(dict:store(Node,{AbsoluteMetaFile,MetaPid},NodeInfo), SessionInfo); + {ip_to_file_trace_port,Port,Sender} -> + Ports = proplists:get_value(ip_to_file_trace_ports, SessionInfo, []), + NewSessionInfo = [{ip_to_file_trace_ports,[Port|Ports]}|SessionInfo], + Sender ! {?MODULE,ok}, + loop(NodeInfo, NewSessionInfo); {get_nodes,Sender} -> Sender ! {?MODULE,dict:fetch_keys(NodeInfo)}, - loop(NodeInfo); + loop(NodeInfo, SessionInfo); {write_trace_info,Key,What} -> dict:fold(fun(Node,{_MetaFile,MetaPid},_) -> rpc:call(Node,observer_backend, @@ -524,55 +702,136 @@ loop(NodeInfo) -> end, ok, NodeInfo), - loop(NodeInfo); + loop(NodeInfo, SessionInfo); {nodedown,Node} -> - loop(dict:erase(Node,NodeInfo)); + NewState = make_node_dead(Node, NodeInfo, SessionInfo), + loop(dict:erase(Node,NodeInfo), NewState); + {noderesumed,Node,Reporter} -> + {MetaFile, CurrentSuffix, NewState} = make_node_alive(Node, SessionInfo), + fetch_partial_result(Node, MetaFile, CurrentSuffix), + spawn(fun() -> resume_trace(Reporter) end), + loop(NodeInfo, NewState); + {timeout, StopOpts} -> + spawn(?MODULE, stop, [StopOpts]), + loop(NodeInfo, SessionInfo); + {node_overloaded, Node} -> + io:format("Overload check activated on node: ~p.~n", [Node]), + {Overloaded, SI} = {proplists:get_value(overloaded, SessionInfo, []), + lists:keydelete(overloaded, 1, SessionInfo)}, + loop(NodeInfo, [{overloaded, [Node|Overloaded]} | SI]); + {get_overloaded, Pid} -> + Pid ! {overloaded,proplists:get_value(overloaded, SessionInfo, [])}, + loop(NodeInfo, SessionInfo); + trace_started -> + case proplists:get_value(timer, SessionInfo) of + undefined -> ok; + {MSec, StopOpts} -> erlang:send_after(MSec, self(), {timeout, StopOpts}) + end, + loop(NodeInfo, SessionInfo); + flush_timeout -> + [ dbg:flush_trace_port(Node) || Node <- dict:fetch_keys(NodeInfo) ], + try_send_flush_tick(SessionInfo), + loop(NodeInfo, SessionInfo); {stop,nofetch,Sender} -> - dict:fold( - fun(Node,{_,MetaPid},_) -> - rpc:call(Node,observer_backend,ttb_stop,[MetaPid]) - end, - ok, - NodeInfo), - dbg:stop_clear(), - ets:delete(?history_table), - Sender ! {?MODULE,stopped}; - {stop,FetchOrFormat,Sender} -> - Localhost = host(node()), - Dir = ?upload_dir++ts(), - file:make_dir(Dir), - %% The nodes are traversed twice here because - %% the meta tracing in observer_backend must be - %% stopped before dbg is stopped, and dbg must - %% be stopped before the trace logs are moved orelse - %% windows complains. - AllNodesAndMeta = - dict:fold( - fun(Node,{MetaFile,MetaPid},Nodes) -> - rpc:call(Node,observer_backend,ttb_stop,[MetaPid]), - [{Node,MetaFile}|Nodes] - end, - [], - NodeInfo), - dbg:stop_clear(), - AllNodes = - lists:map( - fun({Node,MetaFile}) -> - spawn(fun() -> fetch(Localhost,Dir,Node,MetaFile) end), - Node + do_stop(nofetch, Sender, NodeInfo, SessionInfo); + {stop,FetchSpec,Sender} -> + case proplists:get_value(shell, SessionInfo, false) of + only -> do_stop(nofetch, Sender, NodeInfo, SessionInfo); + _ -> do_stop(FetchSpec, Sender, NodeInfo, SessionInfo) + end + end. + +do_stop(nofetch, Sender, NodeInfo, SessionInfo) -> + write_config(?last_config, all), + dict:fold( + fun(Node,{_,MetaPid},_) -> + rpc:call(Node,observer_backend,ttb_stop,[MetaPid]) + end, + ok, + NodeInfo), + stop_ip_to_file_trace_ports(SessionInfo), + dbg:stop_clear(), + ets:delete(?history_table), + Sender ! {?MODULE, stopped}; + +do_stop({FetchOrFormat, UserDir}, Sender, NodeInfo, SessionInfo) -> + write_config(?last_config, all), + Localhost = host(node()), + Dir = get_fetch_dir(UserDir, proplists:get_value(logfile, SessionInfo)), + file:make_dir(Dir), + %% The nodes are traversed twice here because + %% the meta tracing in observer_backend must be + %% stopped before dbg is stopped, and dbg must + %% be stopped before the trace logs are moved orelse + %% windows complains. + AllNodesAndMeta = + dict:fold( + fun(Node,{MetaFile,MetaPid},Nodes) -> + rpc:call(Node,observer_backend,ttb_stop,[MetaPid]), + [{Node,MetaFile}|Nodes] + end, + [], + NodeInfo), + stop_ip_to_file_trace_ports(SessionInfo), + dbg:stop_clear(), + AllNodes = + lists:map( + fun({Node,MetaFile}) -> + spawn(fun() -> fetch_report(Localhost,Dir,Node,MetaFile) end), + Node + end, + AllNodesAndMeta), + ets:delete(?history_table), + wait_for_fetch(AllNodes), + copy_partials(Dir, proplists:get_value(partials, SessionInfo)), + Absname = filename:absname(Dir), + case FetchOrFormat of + fetch -> ok; + {format, Opts} -> format(Dir, Opts) + end, + Sender ! {?MODULE,{stopped,Absname}}. + +stop_ip_to_file_trace_ports(SessionInfo) -> + lists:foreach(fun(Port) -> + case lists:member(Port,erlang:ports()) of + true -> + dbg:deliver_and_flush(Port), + erlang:port_close(Port); + false -> + ok + end end, - AllNodesAndMeta), - ets:delete(?history_table), - wait_for_fetch(AllNodes), - io:format("Stored logs in ~s~n",[filename:absname(Dir)]), - case FetchOrFormat of - format -> format(Dir); - fetch -> ok - end, - Sender ! {?MODULE,stopped} - ?get_status + proplists:get_value(ip_to_file_trace_ports,SessionInfo,[])). + + +make_node_dead(Node, NodeInfo, SessionInfo) -> + {MetaFile,_} = dict:fetch(Node, NodeInfo), + NewDeadNodes = [{Node, MetaFile} | proplists:get_value(dead_nodes, SessionInfo)], + [{dead_nodes, NewDeadNodes} | lists:keydelete(dead_nodes, 1, SessionInfo)]. + +make_node_alive(Node, SessionInfo) -> + DeadNodes = proplists:get_value(dead_nodes, SessionInfo), + Partials = proplists:get_value(partials, SessionInfo), + {value, {_, MetaFile}, Dn2} = lists:keytake(Node, 1, DeadNodes), + SessionInfo2 = lists:keyreplace(dead_nodes, 1, SessionInfo, {dead_nodes, Dn2}), + {MetaFile, Partials + 1, lists:keyreplace(partials, 1, SessionInfo2, {partials, Partials + 1})}. + +try_send_flush_tick(State) -> + case proplists:get_value(flush, State) of + undefined -> + ok; + MSec -> + erlang:send_after(MSec, self(), flush_timeout) end. +get_fetch_dir(undefined,undefined) -> ?upload_dir(?MODULE_STRING) ++ ts(); +get_fetch_dir(undefined,Logname) -> ?upload_dir(Logname) ++ ts(); +get_fetch_dir(Dir,_) -> Dir. + +resume_trace(Reporter) -> + ?MODULE:run_history(all_silent), + Reporter ! trace_resumed. + get_nodes() -> ?MODULE ! {get_nodes,self()}, receive {?MODULE,Nodes} -> Nodes end. @@ -582,19 +841,40 @@ ts() -> io_lib:format("-~4.4.0w~2.2.0w~2.2.0w-~2.2.0w~2.2.0w~2.2.0w", [Y,M,D,H,Min,S]). +copy_partials(_, 0) -> + ok; +copy_partials(Dir, Num) -> + PartialDir = ?partial_dir ++ integer_to_list(Num), + file:rename(PartialDir, filename:join(Dir,PartialDir)), + copy_partials(Dir, Num - 1). + +fetch_partial_result(Node,MetaFile,Current) -> + DirName = ?partial_dir ++ integer_to_list(Current), + case file:list_dir(DirName) of + {error, enoent} -> + ok; + {ok, Files} -> + [ file:delete(filename:join(DirName, File)) || File <- Files ], + file:del_dir(DirName) + end, + file:make_dir(DirName), + fetch(host(node()), DirName, Node, MetaFile). +fetch_report(Localhost, Dir, Node, MetaFile) -> + fetch(Localhost,Dir,Node,MetaFile), + ?MODULE ! {fetch_complete,Node}. fetch(Localhost,Dir,Node,MetaFile) -> - case host(Node) of - Localhost -> % same host, just move the files - Files = rpc:call(Node,observer_backend,ttb_get_filenames,[MetaFile]), + case (host(Node) == Localhost) orelse is_local(MetaFile) of + true -> % same host, just move the files + Files = get_filenames(Node,MetaFile), lists:foreach( - fun(File0) -> - File = filename:join(Dir,filename:basename(File0)), - file:rename(File0,File) - end, - Files); - _Otherhost -> + fun(File0) -> + Dest = filename:join(Dir,filename:basename(File0)), + file:rename(File0, Dest) + end, + Files); + false -> {ok, LSock} = gen_tcp:listen(0, [binary,{packet,2},{active,false}]), {ok,Port} = inet:port(LSock), rpc:cast(Node,observer_backend,ttb_fetch, @@ -603,8 +883,17 @@ fetch(Localhost,Dir,Node,MetaFile) -> receive_files(Dir,Sock,undefined), ok = gen_tcp:close(LSock), ok = gen_tcp:close(Sock) - end, - ?MODULE ! {fetch_complete,Node}. + end. + +is_local({local, _, _}) -> + true; +is_local(_) -> + false. + +get_filenames(_N, {local,F,_}) -> + observer_backend:ttb_get_filenames(F); +get_filenames(N, F) -> + rpc:call(N, observer_backend,ttb_get_filenames,[F]). receive_files(Dir,Sock,Fd) -> case gen_tcp:recv(Sock, 0) of @@ -646,9 +935,16 @@ wait_for_fetch(Nodes) -> %%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - write_info(Nodes,PI,Traci) -> - lists:foreach(fun({N,{local,C,_},F}) -> - MetaFile = F ++ ".ti", - file:delete(MetaFile), + {ok, Cwd} = file:get_cwd(), + lists:foreach(fun({N,{local,C,_},F}) -> + MetaFile = case F of + none -> + none; + F -> + AbsFile = filename:join(Cwd, F) ++ ".ti", + file:delete(AbsFile), + AbsFile + end, Traci1 = [{node,N},{file,C}|Traci], {ok,Port} = dbg:get_tracer(N), ?MODULE ! @@ -662,38 +958,35 @@ write_info(Nodes,PI,Traci) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Format binary trace logs +get_et_handler() -> + {fun ttb_et:handler/4, initial}. + format(Files) -> format(Files,[]). format(Files,Opt) -> - {Out,Handler} = format_opt(Opt), + {Out,Handler,DisableSort} = format_opt(Opt), ets:new(?MODULE,[named_table]), - format(Files,Out,Handler). -format(File,Out,Handler) when is_list(File), is_integer(hd(File)) -> + format(Files,Out,Handler, DisableSort). +format(File,Out,Handler,DisableSort) when is_list(File), is_integer(hd(File)) -> Files = case filelib:is_dir(File) of true -> % will merge all files in the directory - MetaFiles = filelib:wildcard(filename:join(File,"*.ti")), - lists:map(fun(M) -> - Sub = string:left(M,length(M)-3), - case filelib:is_file(Sub) of - true -> Sub; - false -> Sub++".*.wrp" - end - end, - MetaFiles); + List = filelib:wildcard(filename:join(File, ?partial_dir++"*")), + lists:append(collect_files([File | List])); false -> % format one file [File] end, - format(Files,Out,Handler); -format(Files,Out,Handler) when is_list(Files), is_list(hd(Files)) -> + format(Files,Out,Handler,DisableSort); +format(Files,Out,Handler,DisableSort) when is_list(Files), is_list(hd(Files)) -> StopDbg = case whereis(dbg) of undefined -> true; _ -> false end, - Details = lists:foldl(fun(File,Acc) -> [prepare(File,Handler)|Acc] end, + Details = lists:foldl(fun(File,Acc) -> [prepare(File)|Acc] end, [],Files), Fd = get_fd(Out), - R = do_format(Fd,Details), + RealHandler = get_handler(Handler, Files), + R = do_format(Fd,Details,DisableSort,RealHandler), file:close(Fd), ets:delete(?MODULE), case StopDbg of @@ -702,7 +995,30 @@ format(Files,Out,Handler) when is_list(Files), is_list(hd(Files)) -> end, R. -prepare(File,Handler) -> +collect_files(Dirs) -> + lists:map(fun(Dir) -> + MetaFiles = filelib:wildcard(filename:join(Dir,"*.ti")), + lists:map(fun(M) -> + Sub = string:left(M,length(M)-3), + case filelib:is_file(Sub) of + true -> Sub; + false -> Sub++".*.wrp" + end + end, + MetaFiles) + end, Dirs). + +get_handler(undefined, Files) -> + %%We retrieve traci from the first available file + {Traci, _} = read_traci(hd(Files)), + case dict:find(handler, Traci) of + error -> {fun defaulthandler/4, initial}; + {ok, [Handler]} -> Handler + end; +get_handler(Handler, _) -> + Handler. + +prepare(File) -> {Traci,Proci} = read_traci(File), Node = get_node(Traci), lists:foreach(fun({Pid,PI}) -> @@ -714,19 +1030,21 @@ prepare(File,Handler) -> ets:insert(?MODULE,{Pid,PI,Node}) end,Proci), FileOrWrap = get_file(File,Traci), - Handler1 = get_handler(Handler,Traci), - {FileOrWrap,Traci,Handler1}. + {FileOrWrap,Traci}. -format_opt(Opt) -> +format_opt(Opt) when is_list(Opt) -> Out = case lists:keysearch(out,1,Opt) of {value,{out,O}} -> O; _ -> standard_io end, Handler = case lists:keysearch(handler,1,Opt) of - {value,{handler,H}} -> H; - _ -> undefined + {value,{handler,H}} -> H; + _ -> undefined end, - {Out,Handler}. + DisableSort = proplists:get_value(disable_sort, Opt, false), + {Out,Handler,DisableSort}; +format_opt(Opt) -> + format_opt([Opt]). read_traci(File) -> @@ -800,75 +1118,61 @@ check_client(Client,File) when is_tuple(Client),element(2,Client)==wrap -> check_exists(File) -> case file:read_file_info(File) of {ok,#file_info{type=regular}} -> File; - _ -> + _ -> exit({error,no_file}) end. - -get_handler(Handler,Traci) -> - case Handler of - undefined -> - case dict:find(handler,Traci) of - {ok,[H]} -> H; - error -> undefined - end; - _ -> - Handler - end. -do_format(Fd,Details) -> - Clients = lists:foldl(fun({FileOrWrap,Traci,Handler},Acc) -> - [start_client(FileOrWrap,Traci,Handler) - |Acc] +do_format(Fd,Details,DisableSort,Handler) -> + Clients = lists:foldl(fun({FileOrWrap,Traci},Acc) -> + [start_client(FileOrWrap,Traci)|Acc] end,[],Details), - init_collector(Fd,Clients). - - -start_client(FileOrWrap,Traci,et) -> - dbg:trace_client(file, FileOrWrap, - {fun handler/2, - {dict:to_list(Traci),{{ttb_et,handler},initial}}}); -start_client(FileOrWrap,Traci,undefined) -> - dbg:trace_client(file, FileOrWrap, - {fun handler/2, - {dict:to_list(Traci),{fun defaulthandler/4,initial}}}); -start_client(FileOrWrap,Traci,Handler) -> - dbg:trace_client(file, FileOrWrap, - {fun handler/2, {dict:to_list(Traci),Handler}}). - -handler(Trace,State) -> - %% State here is only used for the initial state. The accumulated - %% State is maintained by collector!!! - receive - {get,Collector} -> Collector ! {self(),{Trace,State}}; + init_collector(Fd,Clients,DisableSort,Handler). + +start_client(FileOrWrap,Traci) -> + dbg:trace_client(file, FileOrWrap, + {fun handler/2, dict:to_list(Traci)}). + +handler(Trace,Traci) -> + %%We return our own Traci so that it not necesarry to look it up + %%This may take time if something huge has been written to it + receive + {get,Collector} -> Collector ! {self(),{Trace,Traci}}; done -> ok end, - State. + Traci. -handler1(Trace,{Fd,{Traci,{Fun,State}}}) when is_function(Fun) -> - {Traci,{Fun,Fun(Fd,Trace,Traci,State)}}; -handler1(Trace,{Fd,{Traci,{{M,F},State}}}) when is_atom(M), is_atom(F) -> - {Traci,{{M,F},M:F(Fd,Trace,Traci,State)}}. +%%Used to handle common state (the same for all clients) +handler2(Trace,{Fd,Traci,{Fun,State}}) when is_function(Fun) -> + {Fun, Fun(Fd, Trace, Traci, State)}; +handler2(Trace,{Fd,Traci,{{M,F},State}}) when is_atom(M), is_atom(F) -> + {{M,F}, M:F(Fd, Trace, Traci, State)}. defaulthandler(Fd,Trace,_Traci,initial) -> dbg:dhandler(Trace,Fd); defaulthandler(_Fd,Trace,_Traci,State) -> dbg:dhandler(Trace,State). -init_collector(Fd,Clients) -> +init_collector(Fd,Clients,DisableSort,Handler) -> Collected = get_first(Clients), - collector(Fd,sort(Collected)). + case DisableSort of + true -> collector(Fd,Collected, DisableSort, Handler); + false -> collector(Fd,sort(Collected), DisableSort, Handler) + end. -collector(Fd,[{_,{Client,{Trace,State}}}|Rest]) -> +collector(Fd,[{_,{Client,{Trace,Traci}}} |Rest], DisableSort, CommonState) -> Trace1 = update_procinfo(Trace), - State1 = handler1(Trace1,{Fd,State}), - case get_next(Client,State1) of - end_of_trace -> - handler1(end_of_trace,{Fd,State1}), - collector(Fd,Rest); - Next -> collector(Fd,sort([Next|Rest])) + CommonState2 = handler2(Trace1, {Fd, Traci, CommonState}), + case get_next(Client) of + end_of_trace -> + collector(Fd,Rest,DisableSort, CommonState2); + Next -> case DisableSort of + false -> collector(Fd,sort([Next|Rest]), DisableSort, CommonState2); + true -> collector(Fd,[Next|Rest], DisableSort, CommonState2) + end end; -collector(_Fd,[]) -> +collector(Fd,[], _, CommonState) -> + handler2(end_of_trace, {Fd, end_of_trace, CommonState}), ok. update_procinfo({drop,_N}=Trace) -> @@ -895,7 +1199,7 @@ update_procinfo(Trace) -> ProcInfo = get_procinfo(Pid), setelement(2,Trace,ProcInfo). -get_procinfo(Pid) when is_pid(Pid) -> +get_procinfo(Pid) when is_pid(Pid); is_port(Pid) -> case ets:lookup(?MODULE,Pid) of [PI] -> PI; [] -> Pid @@ -913,21 +1217,21 @@ get_procinfo({Name,Node}) when is_atom(Name) -> get_first([Client|Clients]) -> Client ! {get,self()}, - receive - {Client,{end_of_trace,_}} -> + receive + {Client,{end_of_trace,_}} -> get_first(Clients); - {Client,{Trace,_State}}=Next -> + {Client,{Trace,_}}=Next -> [{timestamp(Trace),Next}|get_first(Clients)] end; get_first([]) -> []. -get_next(Client,State) when is_pid(Client) -> +get_next(Client) when is_pid(Client) -> Client ! {get,self()}, - receive - {Client,{end_of_trace,_}} -> + receive + {Client,{end_of_trace,_}} -> end_of_trace; - {Client,{Trace,_OldState}} -> - {timestamp(Trace),{Client,{Trace,State}}} % inserting new state!! + {Client,{Trace, Traci}} -> + {timestamp(Trace),{Client,{Trace,Traci}}} end. sort(List) -> @@ -971,19 +1275,37 @@ display_warning(Item,Warning) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Trace client which reads an IP port and puts data directly to a file. %%% This is used when tracing remote nodes with no file system. -ip_to_file(Trace,{file,File}) -> +ip_to_file({metadata,_,_},{_, only} = State) -> + State; +ip_to_file(Trace, {_, only} = State) -> + dbg:dhandler(Trace, standard_io), + State; +ip_to_file(Trace,{{file,File}, ShellOutput}) -> Fun = dbg:trace_port(file,File), %File can be a filename or a wrap spec Port = Fun(), - ip_to_file(Trace,Port); -ip_to_file({metadata,MetaFile,MetaData},Port) -> + %% Store the port so it can be properly closed + ?MODULE ! {ip_to_file_trace_port, Port, self()}, + receive {?MODULE,ok} -> ok end, + case Trace of + {metadata, _, _} -> ok; + Trace -> show_trace(Trace, ShellOutput) + end, + ip_to_file(Trace,{Port,ShellOutput}); +ip_to_file({metadata,MetaFile,MetaData},State) -> {ok,MetaFd} = file:open(MetaFile,[write,raw,append]), file:write(MetaFd,MetaData), file:close(MetaFd), - Port; -ip_to_file(Trace,Port) -> + State; +ip_to_file(Trace,{Port, ShellOutput}) -> + show_trace(Trace, ShellOutput), B = term_to_binary(Trace), erlang:port_command(Port,B), - Port. + {Port, ShellOutput}. + +show_trace(Trace, true) -> + dbg:dhandler(Trace, standard_io); +show_trace(_, _) -> + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% For debugging @@ -996,5 +1318,3 @@ dump_ti(<<>>,Acc) -> dump_ti(B,Acc) -> {Term,Rest} = get_term(B), dump_ti(Rest,[Term|Acc]). - - diff --git a/lib/observer/test/Makefile b/lib/observer/test/Makefile index 6073e6ea00..bf99f07081 100644 --- a/lib/observer/test/Makefile +++ b/lib/observer/test/Makefile @@ -22,7 +22,10 @@ MODULES = \ observer_SUITE \ crashdump_viewer_SUITE \ etop_SUITE \ + ttb_helper \ ttb_SUITE \ + client \ + server \ crashdump_helper ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/observer/test/client.erl b/lib/observer/test/client.erl new file mode 100644 index 0000000000..90b72d3f8f --- /dev/null +++ b/lib/observer/test/client.erl @@ -0,0 +1,28 @@ +-module(client). +-compile(export_all). + +init(Node) -> + application:start(runtime_tools), + net_kernel:connect_node(Node). + +init() -> + init(server_node()). + +restart() -> + init:restart(). + +server_node() -> + {ok,HostName} = inet:gethostname(), + list_to_atom("server@" ++ HostName). + +get() -> + erlang:send({server,server_node()}, {get,self()}), + receive Data -> Data + after 1000 -> no_reply + end. + +put(Thing) -> + erlang:send({server,server_node()}, {put,self(),Thing}), + receive ok -> timer:sleep(2), ok + after 1000 -> no_reply + end. diff --git a/lib/observer/test/server.erl b/lib/observer/test/server.erl new file mode 100644 index 0000000000..f6d3542c96 --- /dev/null +++ b/lib/observer/test/server.erl @@ -0,0 +1,44 @@ +-module(server). +-compile(export_all). + +start() -> + application:start(runtime_tools), + Pid = spawn(?MODULE,loop,[[], 0]), + register(server,Pid). + +stop() -> + case lists:member(server, registered()) of + true -> + server ! stop; + false -> + ok + end. + +loop(Data, Num) -> + receive + {put,From,Ting} -> timer:sleep(2), + received(From,Ting), + From ! ok, + loop([Ting|Data], Num+1); + {get,From} -> From ! Data, + loop(Data, Num+1); + stop -> stopped; + clear -> loop([], Num+1); + {cnt, From} -> From ! Num, + loop(Data, Num) + end. + +counter() -> + server ! {cnt, self()}, + receive + Num -> + Num + end. + +received(From, Thing) -> + case Thing of + never_send_this_atom -> + loop(Thing, 0); + _ -> + {return, 27, Thing, From} + end. diff --git a/lib/observer/test/ttb_SUITE.erl b/lib/observer/test/ttb_SUITE.erl index 24b4a22aa9..695d41b48a 100644 --- a/lib/observer/test/ttb_SUITE.erl +++ b/lib/observer/test/ttb_SUITE.erl @@ -1,7 +1,7 @@ -%% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% +%% Copyright Ericsson AB 2002-2010. 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 @@ -33,12 +33,34 @@ -include_lib("test_server/include/test_server.hrl"). -define(default_timeout, ?t:minutes(1)). +-define(OUTPUT, "handler_output"). +-define(FNAME, "temptest"). +-define(DIRNAME, "ddtemp"). -init_per_testcase(_Case, Config) -> - ttb:stop(), +init_per_testcase(Case, Config) -> ?line Dog=test_server:timetrap(?default_timeout), + ttb:stop(), + rm(?OUTPUT), + [rm(Upload) || Upload<-filelib:wildcard("ttb_upload*")], + rm(?DIRNAME), + [rm(At) || At <- filelib:wildcard("*@*")], + rm("ttb_last_config"), + %% Workaround for bug(?) in test_server - if the test case fails + %% with a timetrap timeout, then end_per_testcase will run with + %% faulty group_leader - which in turn makes test_server:stop_node + %% hang (stop_node is called by most of the cleanup functions). + %% Therefore we do the cleanup before each testcase instead - this + %% is obviously not 100% correct, but it will at least make sure + %% that the nodes which are to be started in a test case at are + %% terminated. + try apply(?MODULE,Case,[cleanup,Config]) + catch error:undef -> ok + end, [{watchdog, Dog}|Config]. -end_per_testcase(_Case, Config) -> +end_per_testcase(Case, Config) -> + %% try apply(?MODULE,Case,[cleanup,Config]) + %% catch error:undef -> ok + %% end, Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. @@ -49,12 +71,31 @@ all() -> [file, file_no_pi, file_fetch, wrap, wrap_merge, wrap_merge_fetch_format, write_config1, write_config2, write_config3, history, write_trace_info, seq_trace, - diskless, otp_4967_1, otp_4967_2]. + diskless, diskless_wrap, otp_4967_1, otp_4967_2, + fetch_when_no_option_given, basic_ttb_run_ip_port, basic_ttb_run_file_port, + return_fetch_dir_implies_fetch, logfile_name_in_fetch_dir, upload_to_my_logdir, + upload_to_my_existing_logdir, fetch_with_options_not_as_list, + error_when_formatting_multiple_files_4393, format_on_trace_stop, + trace_to_remote_files_on_localhost_with_different_pwd, + trace_to_local_files_on_localhost_with_different_pwd, + trace_to_remote_files_on_localhost_with_different_pwd_abs, + changing_cwd_on_control_node, changing_cwd_on_remote_node, + changing_cwd_on_control_node_with_local_trace, + one_command_trace_setup, dbg_style_fetch, shell_tracing_init, + only_one_state_for_format_handler, only_one_state_with_default_format_handler, + only_one_state_with_initial_format_handler, run_trace_with_shortcut1, + run_trace_with_shortcut2, run_trace_with_shortcut3, run_trace_with_shortcut4, + cant_specify_local_and_flush, trace_sorted_by_default,disable_sorting, + trace_resumed_after_node_restart, trace_resumed_after_node_restart_ip, + trace_resumed_after_node_restart_wrap, + trace_resumed_after_node_restart_wrap_mult +]. groups() -> []. init_per_suite(Config) -> + clean_priv_dir(Config), Config. end_per_suite(_Config) -> @@ -76,7 +117,7 @@ file(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"file"), ?line {ok,[Node]} = ttb:tracer(Node,[{file, File}, @@ -92,18 +133,20 @@ file(Config) when is_list(Config) -> ?line {ok,[{matched,_,1},{matched,_,1}]} = ttb:tp(?MODULE,foo,[]), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), - ?line ?t:stop_node(OtherNode), + ?line ttb:stop([nofetch]), ?line ok = ttb:format(filename:join(Privdir,atom_to_list(Node)++"-file")), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(OtherNode)++"-file")), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ok. +file(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + file_no_pi(suite) -> []; file_no_pi(doc) -> @@ -113,7 +156,7 @@ file_no_pi(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"file"), ?line {ok,[_,_]} = ttb:tracer([Node,OtherNode],[{file, File}, @@ -123,20 +166,23 @@ file_no_pi(Config) when is_list(Config) -> ?line {ok,[{matched,_,1},{matched,_,1}]} = ttb:tp(?MODULE,foo,[]), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), - ?line ?t:stop_node(OtherNode), + ?line ttb:stop([nofetch]), ?line ok = ttb:format(filename:join(Privdir,atom_to_list(Node)++"-file")), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(OtherNode)++"-file")), - ?line [{trace,LocalProc,call,{?MODULE,foo,[]}}, + ?line [{trace_ts,LocalProc,call,{?MODULE,foo,[]}, {_,_,_}}, end_of_trace, - {trace,RemoteProc,call,{?MODULE,foo,[]}}, + {trace_ts,RemoteProc,call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ?line true = is_pid(LocalProc), ?line true = is_pid(RemoteProc), ok. +file_no_pi(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + + file_fetch(suite) -> []; file_fetch(doc) -> @@ -146,7 +192,7 @@ file_fetch(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line ThisDir = filename:join(Privdir,this), ?line ok = file:make_dir(ThisDir), ?line OtherDir = filename:join(Privdir,other), @@ -170,12 +216,11 @@ file_fetch(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ?t:capture_start(), - ?line ttb:stop([fetch]), + ?line ttb:stop([return_fetch_dir]), ?line ?t:capture_stop(), ?line [StoreString] = ?t:capture_get(), ?line UploadDir = lists:last(string:tokens(lists:flatten(StoreString),"$ \n")), - ?line ?t:stop_node(OtherNode), %% check that files are no longer in original directories... ?line ok = check_gone(ThisDir,atom_to_list(Node)++"-file_fetch"), @@ -194,14 +239,18 @@ file_fetch(Config) when is_list(Config) -> ?line ok = ttb:format(filename:join(UploadDir, atom_to_list(OtherNode)++"-file_fetch")), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ?line ok = file:set_cwd(Cwd), ok. +file_fetch(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + + wrap(suite) -> []; wrap(doc) -> @@ -211,7 +260,7 @@ wrap(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"wrap"), ?line {ok,[_,_]} = ttb:tracer([Node,OtherNode],[{file, {wrap,File,200,3}}, @@ -224,19 +273,18 @@ wrap(Config) when is_list(Config) -> ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), - ?line ?t:stop_node(OtherNode), + ?line ttb:stop([nofetch]), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(Node)++"-wrap.*.wrp")), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - {trace,{S,_,Node},call,{?MODULE,foo,[]}}, - {trace,{S,_,Node},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(OtherNode)++"-wrap.*.wrp")), - ?line [{trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), %% Check that merge does not crash even if the timestamp flag is not on. @@ -244,17 +292,19 @@ wrap(Config) when is_list(Config) -> [filename:join(Privdir, atom_to_list(Node)++"-wrap.*.wrp"), filename:join(Privdir, - atom_to_list(OtherNode)++"-wrap.*.wrp")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - {trace,{S,_,Node},call,{?MODULE,foo,[]}}, - {trace,{S,_,Node},call,{?MODULE,foo,[]}}, - end_of_trace, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, + atom_to_list(OtherNode)++"-wrap.*.wrp")],[{disable_sort,true}]), + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ok. +wrap(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + wrap_merge(suite) -> []; wrap_merge(doc) -> @@ -264,7 +314,7 @@ wrap_merge(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"wrap_merge"), ?line {ok,[_,_]} = ttb:tracer([Node,OtherNode],[{file, {wrap,File,200,3}}, @@ -277,8 +327,7 @@ wrap_merge(Config) when is_list(Config) -> ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), - ?line ?t:stop_node(OtherNode), + ?line ttb:stop([nofetch]), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-wrap_merge.*.wrp"), @@ -289,11 +338,13 @@ wrap_merge(Config) when is_list(Config) -> {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, {trace_ts,_,call,{?MODULE,foo,[]},_}, {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, - end_of_trace, {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},_}, end_of_trace] = flush(), ok. +wrap_merge(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + wrap_merge_fetch_format(suite) -> []; @@ -304,7 +355,7 @@ wrap_merge_fetch_format(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"wrap_merge_fetch_format"), %% I'm setting priv_dir as cwd, so ttb_upload directory is created there @@ -324,19 +375,19 @@ wrap_merge_fetch_format(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ttb:stop([format]), - ?line ?t:stop_node(OtherNode), ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},_}, {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},_}, {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, - end_of_trace, {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},_}, end_of_trace] = flush(), ?line ok = file:set_cwd(Cwd), ok. +wrap_merge_fetch_format(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). write_config1(suite) -> []; @@ -348,7 +399,7 @@ write_config1(Config) when is_list(Config) -> ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"write_config1"), ?line ok = ttb:write_config(File, [{ttb,tracer,[[Node,OtherNode], @@ -360,16 +411,14 @@ write_config1(Config) when is_list(Config) -> ?line ok = ttb:run_config(File), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), - ?line ?t:stop_node(OtherNode), + ?line ttb:stop([nofetch]), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config1"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_config1")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - end_of_trace, - {trace,Other,call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,Other,call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), case metatest(Other,OtherNode,Privdir,"-write_config1.ti") of @@ -388,6 +437,10 @@ write_config1(Config) when is_list(Config) -> end, ok. + +write_config1(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + write_config2(suite) -> []; write_config2(doc) -> @@ -397,7 +450,7 @@ write_config2(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"write_config2"), ?line {ok,[_,_]} = ttb:tracer([Node,OtherNode],[{file, File}, @@ -410,16 +463,14 @@ write_config2(Config) when is_list(Config) -> ?line ok = ttb:run_config(File), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), - ?line ?t:stop_node(OtherNode), + ?line ttb:stop([nofetch]), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config2"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_config2")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - end_of_trace, - {trace,Other,call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,Other,call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), case metatest(Other,OtherNode,Privdir,"-write_config2.ti") of @@ -438,6 +489,10 @@ write_config2(Config) when is_list(Config) -> end, ok. +write_config2(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + + write_config3(suite) -> []; write_config3(doc) -> @@ -447,7 +502,7 @@ write_config3(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"write_config3"), ?line {ok,[_,_]} = ttb:tracer([Node,OtherNode],[{file, File}, @@ -455,18 +510,18 @@ write_config3(Config) when is_list(Config) -> ?line {ok,[{all,[{matched,_,_},{matched,_,_}]}]} = ttb:p(all,call), ?line {ok,[{matched,_,1},{matched,_,1}]} = ttb:tp(?MODULE,foo,[]), ?line ok = ttb:write_config(File,[1,2]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line [_,_] = ttb:list_config(File), ?line ok = ttb:run_config(File), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config3"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_config3")]), - ?line [] = flush(), %foo is not traced + ?line [end_of_trace] = flush(), %foo is not traced ?line ok = ttb:write_config(File,[{ttb,tp,[?MODULE,foo,[]]}], [append]), @@ -474,16 +529,14 @@ write_config3(Config) when is_list(Config) -> ?line ok = ttb:run_config(File), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), - ?line ?t:stop_node(OtherNode), + ?line ttb:stop([nofetch]), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config3"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_config3")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - end_of_trace, - {trace,Other,call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,Other,call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), case metatest(Other,OtherNode,Privdir,"-write_config3.ti") of @@ -502,6 +555,10 @@ write_config3(Config) when is_list(Config) -> end, ok. +write_config3(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + + history(suite) -> []; @@ -514,7 +571,7 @@ history(Config) when is_list(Config) -> ?line S = self(), ?line Nodes = [Node,OtherNode], - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"history"), ?line StartOpts = [{file, File}, {handler,{fun myhandler/4, S}}], @@ -531,15 +588,16 @@ history(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line ok = ttb:run_history([3,4]), ?line ?MODULE:foo(), - ?line ttb:stop(), - ?line ?t:stop_node(OtherNode), + ?line ttb:stop([nofetch]), ?line ok = ttb:format( [filename:join(Privdir,atom_to_list(Node)++"-history"), filename:join(Privdir,atom_to_list(OtherNode)++"-history")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ok. - + +history(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). write_trace_info(suite) -> @@ -551,7 +609,7 @@ write_trace_info(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"write_trace_info"), ?line {ok,[_,_]} = ttb:tracer([Node,OtherNode],[{file, File}, @@ -561,20 +619,21 @@ write_trace_info(Config) when is_list(Config) -> ?line ok = ttb:write_trace_info(mytraceinfo,fun() -> node() end), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), - ?line ?t:stop_node(OtherNode), + ?line ttb:stop([nofetch]), ?line ok = ttb:format( [filename:join(Privdir,atom_to_list(Node)++"-write_trace_info"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_trace_info")], [{handler,{fun otherhandler/4,S}}]), - ?line [{{trace,{S,_,Node},call,{?MODULE,foo,[]}},[Node]}, - {end_of_trace,[Node]}, - {{trace,{_,_,OtherNode},call,{?MODULE,foo,[]}},[OtherNode]}, - {end_of_trace,[OtherNode]}] = flush(), + ?line [{{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}},[Node]}, + {{trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}},[OtherNode]}, + end_of_trace] = flush(), ok. +write_trace_info(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + seq_trace(suite) -> []; @@ -583,7 +642,7 @@ seq_trace(doc) -> seq_trace(Config) when is_list(Config) -> ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"seq_trace"), ?line {ok,[Node]} = ttb:tracer(node(),[{file,File}, {handler,{fun myhandler/4, S}}]), @@ -593,10 +652,10 @@ seq_trace(Config) when is_list(Config) -> ?line Start = spawn(fun() -> seq() end), ?line timer:sleep(300), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ok = ttb:format( [filename:join(Privdir,atom_to_list(Node)++"-seq_trace")]), - ?line [{trace,StartProc,call,{?MODULE,seq,[]}}, + ?line [{trace_ts,StartProc,call,{?MODULE,seq,[]},{_,_,_}}, {seq_trace,0,{send,{0,1},StartProc,P1Proc,{Start,P2}}}, {seq_trace,0,{send,{1,2},P1Proc,P2Proc,{P1,Start}}}, {seq_trace,0,{send,{2,3},P2Proc,StartProc,{P2,P1}}}, @@ -650,7 +709,7 @@ diskless(Config) when is_list(Config) -> ?line {ok,RemoteNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"diskless"), ?line {ok,[RemoteNode]} = ttb:tracer([RemoteNode],[{file, {local, File}}, @@ -660,15 +719,45 @@ diskless(Config) when is_list(Config) -> ?line rpc:call(RemoteNode,?MODULE,foo,[]), ?line timer:sleep(500), % needed for the IP port to flush - ?line ttb:stop(), - ?line ?t:stop_node(RemoteNode), + ?line ttb:stop([nofetch]), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(RemoteNode)++"-diskless")), - ?line [{trace,{_,_,RemoteNode},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{_,_,RemoteNode},call,{?MODULE,foo,[]},{_,_,_}}, + end_of_trace] = flush(), + ok. + +diskless(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + +diskless_wrap(suite) -> + []; +diskless_wrap(doc) -> + ["Start tracing on diskless remote node, save to local wrapped file"]; +diskless_wrap(Config) when is_list(Config) -> + ?line {ok,RemoteNode} = ?t:start_node(node2,slave,[]), + ?line c:nl(?MODULE), + ?line S = self(), + ?line Privdir=priv_dir(Config), + ?line File = filename:join(Privdir,"diskless"), + ?line {ok,[RemoteNode]} = + ttb:tracer([RemoteNode],[{file, {local, {wrap,File,200,3}}}, + {handler,{fun myhandler/4, S}}]), + ?line {ok,[{all,[{matched,RemoteNode,_}]}]} = ttb:p(all,call), + ?line {ok,[{matched,RemoteNode,1}]} = ttb:tp(?MODULE,foo,[]), + + ?line rpc:call(RemoteNode,?MODULE,foo,[]), + ?line timer:sleep(500), % needed for the IP port to flush + ?line ttb:stop([nofetch]), + ?line ok = ttb:format(filename:join(Privdir, + atom_to_list(RemoteNode)++"-diskless.*.wrp")), + + ?line [{trace_ts,{_,_,RemoteNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ok. +diskless_wrap(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). otp_4967_1(suite) -> []; @@ -688,7 +777,7 @@ otp_4967_2(doc) -> ["OTP-4967: Trace message sent to {Name, Node}"]; otp_4967_2(Config) when is_list(Config) -> io:format("1: ~p",[now()]), - ?line Privdir = ?config(priv_dir,Config), + ?line Privdir = priv_dir(Config), io:format("2: ~p",[now()]), ?line File = filename:join(Privdir,"otp_4967"), io:format("3: ~p",[now()]), @@ -715,19 +804,41 @@ otp_4967_2(Config) when is_list(Config) -> io:format("11: ~p",[now()]), ?line true = lists:member(heihopp,Msgs), % the heihopp message itself io:format("13: ~p",[now()]), - ?line {value,{trace,_,send,heihopp,{_,otp_4967,Node}}} = + ?line {value,{trace_ts,_,send,heihopp,{_,otp_4967,Node},{_,_,_}}} = lists:keysearch(heihopp,4,Msgs), % trace trace of the heihopp message io:format("14: ~p",[now()]), ?line end_of_trace = lists:last(Msgs), % end of the trace ok. - - myhandler(_Fd,Trace,_,Relay) -> Relay ! Trace, Relay. +simple_call_handler() -> + {fun(A, {trace_ts, _, call, _, _} ,_,_) -> io:format(A, "ok.~n", []); + (_, end_of_trace, _, _) -> ok end, []}. + +marking_call_handler() -> + {fun(_, _, _, initial) -> file:write_file("HANDLER_OK", []); + (_,_,_,_) -> ok end, initial}. + +counter_call_handler() -> + {fun(_, {trace_ts, _, call, _, _} ,_,State) -> State + 1; + (A, end_of_trace, _, State) -> io:format(A,"~p.~n", [State]) end, 0}. + +ret_caller_call_handler() -> + {fun(A, {trace_ts, _, call, _, _, _} ,_,_) -> io:format(A, "ok.~n", []); + (A, {trace_ts, _, return_from, _, _, _}, _, _) -> io:format(A, "ok.~n", []); + (_, _, _, _) -> ok end, []}. + +node_call_handler() -> + {fun(A, {trace_ts, {_,_,Node}, call, _, _} ,_,_) -> io:format(A, "~p.~n", [Node]); + (_, end_of_trace, _, _) -> ok end, []}. + +otherhandler(_Fd,_,end_of_trace,Relay) -> + Relay ! end_of_trace, + Relay; otherhandler(_Fd,Trace,TI,Relay) -> {value,{mytraceinfo,I}} = lists:keysearch(mytraceinfo,1,TI), Relay ! {Trace,I}, @@ -794,3 +905,630 @@ check_gone(Dir,File) -> false -> ok end. + +start_client_and_server() -> + ?line {ok,ClientNode} = ?t:start_node(client,slave,[]), + ?line ok = ttb_helper:c(code, add_paths, [code:get_path()]), + ?line {ok,ServerNode} = ?t:start_node(server,slave,[]), + ?line ok = ttb_helper:s(code, add_paths, [code:get_path()]), + ?line ttb_helper:clear(), + {ServerNode, ClientNode}. + +stop_client_and_server() -> + ClientNode = ttb_helper:get_node(client), + ServerNode = ttb_helper:get_node(server), + erlang:monitor_node(ClientNode,true), + erlang:monitor_node(ServerNode,true), + ?line ?t:stop_node(ClientNode), + ?line ?t:stop_node(ServerNode), + wait_for_client_and_server_stop(ClientNode,ServerNode). + +wait_for_client_and_server_stop(undefined,undefined) -> + ok; +wait_for_client_and_server_stop(ClientNode,ServerNode) -> + receive + {nodedown,ClientNode} -> + erlang:monitor_node(ClientNode,false), + wait_for_client_and_server_stop(undefined,ServerNode); + {nodedown,ServerNode} -> + erlang:monitor_node(ServerNode,false), + wait_for_client_and_server_stop(ClientNode,undefined) + end. + +begin_trace(ServerNode, ClientNode, Dest) -> + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, Dest}]), + ?line ttb:p(all, call), + ?line ttb:tp(server, received, []), + ?line ttb:tp(client, put, []), + ?line ttb:tp(client, get, []). + +begin_trace_local(ServerNode, ClientNode, Dest) -> + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, Dest}]), + ?line ttb:p(all, call), + ?line ttb:tpl(server, received, []), + ?line ttb:tpl(client, put, []), + ?line ttb:tpl(client, get, []). + +check_size(N, Dest, Output, ServerNode, ClientNode) -> + ?line begin_trace(ServerNode, ClientNode, Dest), + ?line case Dest of + {local, _} -> + ?line ttb_helper:msgs_ip(N); + _ -> + ?line ttb_helper:msgs(N) + end, + ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), + ?line ttb:format(D, [{out, Output}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(Output), + ?line true = (N + 1 == length(Ret)). + +fetch_when_no_option_given(suite) -> + []; +fetch_when_no_option_given(doc) -> + ["Fetch when no option given"]; +fetch_when_no_option_given(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, Privdir} = file:get_cwd(), + ?line [] = filelib:wildcard(filename:join(Privdir,"ttb_upload_temptest*")), + begin_trace(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(4), + ?line stopped = ttb:stop(), + ?line [_] = filelib:wildcard(filename:join(Privdir,"ttb_upload_temptest*")). + +fetch_when_no_option_given(cleanup,_Config) -> + ?line stop_client_and_server(). + + +basic_ttb_run_ip_port(suite) -> + []; +basic_ttb_run_ip_port(doc) -> + ["Basic ttb run ip port"]; +basic_ttb_run_ip_port(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line check_size(1, {local, ?FNAME}, ?OUTPUT, ServerNode, ClientNode), + ?line check_size(2, {local, ?FNAME}, ?OUTPUT, ServerNode, ClientNode), + ?line check_size(10, {local, ?FNAME}, ?OUTPUT, ServerNode, ClientNode). +basic_ttb_run_ip_port(cleanup,_Config) -> + ?line stop_client_and_server(). + +basic_ttb_run_file_port(suite) -> + []; +basic_ttb_run_file_port(doc) -> + ["Basic ttb run file port"]; +basic_ttb_run_file_port(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line check_size(1, ?FNAME, ?OUTPUT, ServerNode, ClientNode), + ?line check_size(2, ?FNAME, ?OUTPUT, ServerNode, ClientNode), + ?line check_size(10, ?FNAME, ?OUTPUT, ServerNode, ClientNode). +basic_ttb_run_file_port(cleanup,_Config) -> + ?line stop_client_and_server(). + +return_fetch_dir_implies_fetch(suite) -> + []; +return_fetch_dir_implies_fetch(doc) -> + ["Return_fetch_dir implies fetch"]; +return_fetch_dir_implies_fetch(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(2), + ?line {_,_} = ttb:stop([return_fetch_dir]). +return_fetch_dir_implies_fetch(cleanup,_Config) -> + ?line stop_client_and_server(). + +logfile_name_in_fetch_dir(suite) -> + []; +logfile_name_in_fetch_dir(doc) -> + ["Logfile name in fetch dir"]; +logfile_name_in_fetch_dir(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, {local, ?FNAME}), + ?line {_,Dir} = ttb:stop([return_fetch_dir]), + ?line P1 = lists:nth(3, string:tokens(filename:basename(Dir), "_")), + ?line P2 = hd(string:tokens(P1, "-")), + ?line _File = P2. +logfile_name_in_fetch_dir(cleanup,_Config) -> + ?line stop_client_and_server(). + +upload_to_my_logdir(suite) -> + []; +upload_to_my_logdir(doc) -> + ["Upload to my logdir"]; +upload_to_my_logdir(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}]), + ?line {stopped,_} = ttb:stop([return_fetch_dir, {fetch_dir, ?DIRNAME}]), + ?line true = filelib:is_file(?DIRNAME), + ?line [] = filelib:wildcard("ttb_upload_"++?FNAME). +upload_to_my_logdir(cleanup,_Config) -> + ?line stop_client_and_server(). + +upload_to_my_existing_logdir(suite) -> + []; +upload_to_my_existing_logdir(doc) -> + ["Upload to my existing logdir"]; +upload_to_my_existing_logdir(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line ok = file:make_dir(?DIRNAME), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}]), + ?line {error,_,_} = (catch ttb:stop([return_fetch_dir, {fetch_dir, ?DIRNAME}])), + ?line {stopped,_} = ttb:stop(return_fetch_dir). +upload_to_my_existing_logdir(cleanup,_Config) -> + ?line stop_client_and_server(). + +fetch_with_options_not_as_list(suite) -> + []; +fetch_with_options_not_as_list(doc) -> + ["Fetch with options not as list"]; +fetch_with_options_not_as_list(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}]), + ?line {stopped, D} = ttb:stop(return_fetch_dir), + ?line false = filelib:is_file(?OUTPUT), + ?line ttb:format(D, {out, ?OUTPUT}), + ?line true = filelib:is_file(?OUTPUT). +fetch_with_options_not_as_list(cleanup,_Config) -> + ?line stop_client_and_server(). + +error_when_formatting_multiple_files_4393(suite) -> + []; +error_when_formatting_multiple_files_4393(doc) -> + ["Error when formatting multiple files"]; +error_when_formatting_multiple_files_4393(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(2), + ?line {_, Dir} = ttb:stop(return_fetch_dir), + ?line Files = [filename:join(Dir, atom_to_list(ServerNode) ++ "-" ++ ?FNAME), + filename:join(Dir, atom_to_list(ClientNode) ++ "-" ++ ?FNAME)], + ?line ok = ttb:format(Files). +error_when_formatting_multiple_files_4393(cleanup,_Config) -> + ?line stop_client_and_server(). + +format_on_trace_stop(suite) -> + []; +format_on_trace_stop(doc) -> + ["Format on trace stop"]; +format_on_trace_stop(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, {local, ?FNAME}), + ?line ttb_helper:msgs_ip(2), + ?line file:delete("HANDLER_OK"), + ?line {_,_} = ttb:stop([fetch, return_fetch_dir, {format, {handler, marking_call_handler()}}]), + ?line true = filelib:is_file("HANDLER_OK"), + ?line ok = file:delete("HANDLER_OK"). +format_on_trace_stop(cleanup,_Config) -> + ?line stop_client_and_server(). + +%% The following three tests are for the issue "fixes fetch fail when nodes on the same host +%% have different cwd" +trace_to_remote_files_on_localhost_with_different_pwd(suite) -> + []; +trace_to_remote_files_on_localhost_with_different_pwd(doc) -> + ["Trace to remote files on localhost with different pwd"]; +trace_to_remote_files_on_localhost_with_different_pwd(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line ok = file:set_cwd(".."), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line check_size(2, ?FNAME, ?OUTPUT, ServerNode, ClientNode), + ?line ok = file:set_cwd(OldDir). +trace_to_remote_files_on_localhost_with_different_pwd(cleanup,_Config) -> + ?line stop_client_and_server(). + +trace_to_local_files_on_localhost_with_different_pwd(suite) -> + []; +trace_to_local_files_on_localhost_with_different_pwd(doc) -> + ["Trace to local files on localhost with different pwd"]; +trace_to_local_files_on_localhost_with_different_pwd(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line ok = file:set_cwd(".."), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line check_size(2, {local, ?FNAME}, ?OUTPUT, ServerNode, ClientNode), + ?line ok = file:set_cwd(OldDir). +trace_to_local_files_on_localhost_with_different_pwd(cleanup,_Config) -> + ?line stop_client_and_server(). + +trace_to_remote_files_on_localhost_with_different_pwd_abs(suite) -> + []; +trace_to_remote_files_on_localhost_with_different_pwd_abs(doc) -> + ["Trace to remote files on localhost with different pwd abs"]; +trace_to_remote_files_on_localhost_with_different_pwd_abs(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line ok = file:set_cwd(".."), + ?line {ok, Path} = file:get_cwd(), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line File = filename:join(Path, ?FNAME), + ?line check_size(2, File, ?OUTPUT, ServerNode, ClientNode), + ?line ok = file:set_cwd(OldDir). +trace_to_remote_files_on_localhost_with_different_pwd_abs(cleanup,_Config) -> + ?line stop_client_and_server(). + +%% Trace is not affected by changes of cwd on control node or remote nodes during tracing +%% (three tests) +changing_cwd_on_control_node(suite) -> + []; +changing_cwd_on_control_node(doc) -> + ["Changing cwd on control node during tracing is safe"]; +changing_cwd_on_control_node(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, ?FNAME), + ?line NumMsgs = 3, + ?line ttb_helper:msgs(NumMsgs), + ?line ok = file:set_cwd(".."), + ?line ttb_helper:msgs(NumMsgs), + ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line true = (2*(NumMsgs + 1) == length(Ret)), + ?line ok = file:set_cwd(OldDir). +changing_cwd_on_control_node(cleanup,_Config) -> + ?line stop_client_and_server(). + +changing_cwd_on_control_node_with_local_trace(suite) -> + []; +changing_cwd_on_control_node_with_local_trace(doc) -> + ["Changing cwd on control node during local tracing is safe"]; +changing_cwd_on_control_node_with_local_trace(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, {local, ?FNAME}), + ?line NumMsgs = 3, + ?line ttb_helper:msgs_ip(NumMsgs), + ?line ok = file:set_cwd(".."), + ?line ttb_helper:msgs_ip(NumMsgs), + ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line true = (2*(NumMsgs + 1) == length(Ret)), + ?line ok = file:set_cwd(OldDir). +changing_cwd_on_control_node_with_local_trace(cleanup,_Config) -> + ?line stop_client_and_server(). + +changing_cwd_on_remote_node(suite) -> + []; +changing_cwd_on_remote_node(doc) -> + ["Changing cwd on remote node during tracing is safe"]; +changing_cwd_on_remote_node(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, ?FNAME), + ?line NumMsgs = 2, + ?line ttb_helper:msgs(NumMsgs), + ?line ok = rpc:call(ClientNode, file, set_cwd, [".."]), + ?line ttb_helper:msgs(NumMsgs), + ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line true = (2*(NumMsgs + 1) == length(Ret)). +changing_cwd_on_remote_node(cleanup,_Config) -> + ?line stop_client_and_server(). + +one_command_trace_setup(suite) -> + []; +one_command_trace_setup(doc) -> + ["One command trace setup"]; +one_command_trace_setup(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line ttb:start_trace([ClientNode, ServerNode], + [{server, received, '_', []}, + {client, put, 1, []}, + {client, get, '_', []}], + {all, call}, + [{file, ?FNAME}]), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop(return_fetch_dir), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line 5 = length(Ret). +one_command_trace_setup(cleanup,_Config) -> + ?line stop_client_and_server(). + +dbg_style_fetch(suite) -> + []; +dbg_style_fetch(doc) -> + ["Dbg style fetch"]; +dbg_style_fetch(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line DirSize = length(element(2, file:list_dir("."))), + ?line ttb:start_trace([ClientNode, ServerNode], + [{server, received, '_', []}, + {client, put, 1, []}, + {client, get, '_', []}], + {all, call}, + [{shell, only}]), + ?line DirSize = length(element(2, file:list_dir("."))), + ?line ttb_helper:msgs(2), + ?line DirSize = length(element(2, file:list_dir("."))), + ?line stopped, ttb:stop(format), + %%+1 -> ttb_last_trace + ?line true = (DirSize + 1 == length(element(2, file:list_dir(".")))), + ?line {ok,[{all, [{matched,_,_}, {matched,_,_}]}]} = + ttb:start_trace([ClientNode, ServerNode], + [{server, received, '_', []}, + {client, put, 1, []}, + {client, get, '_', []}], + {all, call}, + [{shell, only}]), + ?line ttb:stop(). +dbg_style_fetch(cleanup,_Config) -> + ?line stop_client_and_server(). + +shell_tracing_init(suite) -> + []; +shell_tracing_init(doc) -> + ["Shell tracing init"]; +shell_tracing_init(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line ttb:tracer([ClientNode, ServerNode], shell), + ?line ttb:stop(), + ?line ttb:tracer([ClientNode, ServerNode], + [{file, {local, ?FNAME}}, shell]), + ?line ttb:stop(), + ?line local_client_required_on_shell_tracing = + try ttb:tracer([ClientNode, ServerNode],[{file, ?FNAME}, shell]) + catch + exit:local_client_required_on_shell_tracing -> + local_client_required_on_shell_tracing + end. +shell_tracing_init(cleanup,_Config) -> + ?line stop_client_and_server(). + +only_one_state_for_format_handler(suite) -> + []; +only_one_state_for_format_handler(doc) -> + ["Only one state for format handler"]; +only_one_state_for_format_handler(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_local(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, counter_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line [5] = Ret. +only_one_state_for_format_handler(cleanup,_Config) -> + ?line stop_client_and_server(). + +only_one_state_with_default_format_handler(suite) -> + []; +only_one_state_with_default_format_handler(doc) -> + ["Only one state with default format handler"]; +only_one_state_with_default_format_handler(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_local(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}]), + ?line true = filelib:is_file(?OUTPUT). +only_one_state_with_default_format_handler(cleanup,_Config) -> + ?line stop_client_and_server(). + +only_one_state_with_initial_format_handler(suite) -> + []; +only_one_state_with_initial_format_handler(doc) -> + ["Only one state with initial format handler"]; +only_one_state_with_initial_format_handler(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}, {handler, counter_call_handler()}]), + ?line ttb:p(all, call), + ?line ttb:tpl(server, received, []), + ?line ttb:tpl(client, put, []), + ?line ttb:tpl(client, get, []), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line [5] = Ret. +only_one_state_with_initial_format_handler(cleanup,_Config) -> + ?line stop_client_and_server(). + +run_trace_with_shortcut(Shortcut, Ret, F) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}]), + ?line ttb:p(all, call), + ?line ttb:F(client, put, Shortcut), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, ret_caller_call_handler()}]), + ?line {ok, Ret} =file:consult(?OUTPUT), + ?line stop_client_and_server(). + +fun_for(return) -> + {codestr, "fun(_) -> return_trace() end"}; +fun_for(msg_false) -> + {codestr, "fun(_) -> message(false) end"}. + +run_trace_with_shortcut1(suite) -> + []; +run_trace_with_shortcut1(doc) -> + ["Run trace with shortcut 1"]; +run_trace_with_shortcut1(Config) when is_list(Config) -> + ?line run_trace_with_shortcut(caller, [ok,ok], tp), + ?line run_trace_with_shortcut(caller, [ok,ok], tpl). +run_trace_with_shortcut1(cleanup,_Config) -> + ?line stop_client_and_server(). + +run_trace_with_shortcut2(suite) -> + []; +run_trace_with_shortcut2(doc) -> + ["Run trace with shortcut 2"]; +run_trace_with_shortcut2(Config) when is_list(Config) -> + ?line run_trace_with_shortcut(return, [ok,ok], tp), + ?line run_trace_with_shortcut(return, [ok,ok], tpl). +run_trace_with_shortcut2(cleanup,_Config) -> + ?line stop_client_and_server(). + +run_trace_with_shortcut3(suite) -> + []; +run_trace_with_shortcut3(doc) -> + ["Run trace with shortcut 3"]; +run_trace_with_shortcut3(Config) when is_list(Config) -> + ?line run_trace_with_shortcut(fun_for(return), [ok,ok], tp), + ?line run_trace_with_shortcut(fun_for(return), [ok,ok], tpl). +run_trace_with_shortcut3(cleanup,_Config) -> + ?line stop_client_and_server(). + +run_trace_with_shortcut4(suite) -> + []; +run_trace_with_shortcut4(doc) -> + ["Run trace with shortcut 4"]; +run_trace_with_shortcut4(Config) when is_list(Config) -> + ?line run_trace_with_shortcut(fun_for(msg_false), [], tp), + ?line run_trace_with_shortcut(fun_for(msg_false), [], tpl). +run_trace_with_shortcut4(cleanup,_Config) -> + ?line stop_client_and_server(). + +cant_specify_local_and_flush(suite) -> + []; +cant_specify_local_and_flush(doc) -> + ["Can't specify local and flush"]; +cant_specify_local_and_flush(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line flush_unsupported_with_ip_trace_port = + try ttb:tracer([ServerNode, ClientNode], + [{flush, 1000}, {file, {local, ?FNAME}}]) + catch + exit:flush_unsupported_with_ip_trace_port -> + flush_unsupported_with_ip_trace_port + end. +cant_specify_local_and_flush(cleanup,_Config) -> + ?line stop_client_and_server(). + +trace_sorted_by_default(suite) -> + []; +trace_sorted_by_default(doc) -> + ["Trace sorted by default"]; +trace_sorted_by_default(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_local(ServerNode, ClientNode, ?FILE), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, node_call_handler()}, {disable_sort, false}]), + {ok, Ret} = file:consult(?OUTPUT), + ?line [ClientNode,ServerNode,ClientNode,ServerNode,ServerNode] = Ret. +trace_sorted_by_default(cleanup,_Config) -> + ?line stop_client_and_server(). + +disable_sorting(suite) -> + []; +disable_sorting(doc) -> + ["Disable sorting"]; +disable_sorting(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_local(ServerNode, ClientNode, ?FILE), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, node_call_handler()}, {disable_sort, true}]), + {ok, Ret} = file:consult(?OUTPUT), + ?line [ClientNode,ClientNode,ServerNode,ServerNode,ServerNode] = Ret. +disable_sorting(cleanup,_Config) -> + ?line stop_client_and_server(). + +%% ----------------------------------------------------------------------------- +%% tests for autoresume of tracing +%% ----------------------------------------------------------------------------- + +trace_resumed_after_node_restart(suite) -> + []; +trace_resumed_after_node_restart(doc) -> + ["Test trace resumed after node restart, trace to files on remote node."]; +trace_resumed_after_node_restart(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_with_resume(ServerNode, ClientNode, ?FNAME), + ?line logic(2,6,file). +trace_resumed_after_node_restart(cleanup,_Config) -> + ?line stop_client_and_server(). + +trace_resumed_after_node_restart_ip(suite) -> + []; +trace_resumed_after_node_restart_ip(doc) -> + ["Test trace resumed after node restart, trace via tcp/ip to local node."]; +trace_resumed_after_node_restart_ip(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_with_resume(ServerNode, ClientNode, {local, ?FNAME}), + ?line logic(2,6,local). +trace_resumed_after_node_restart_ip(cleanup,_Config) -> + ?line stop_client_and_server(). + +trace_resumed_after_node_restart_wrap(suite) -> + []; +trace_resumed_after_node_restart_wrap(doc) -> + ["Test trace resumed after node restart, wrap option."]; +trace_resumed_after_node_restart_wrap(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_with_resume(ServerNode, ClientNode, {wrap, ?FNAME, 10, 4}), + ?line logic(1,4,file). +trace_resumed_after_node_restart_wrap(cleanup,_Config) -> + ?line stop_client_and_server(). + +trace_resumed_after_node_restart_wrap_mult(suite) -> + []; +trace_resumed_after_node_restart_wrap_mult(doc) -> + ["Test trace resumed after node restart, wrap option, multiple files."]; +trace_resumed_after_node_restart_wrap_mult(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_with_resume(ServerNode, ClientNode, {wrap, ?FNAME, 10, 4}), + ?line logic(20,8,file). +trace_resumed_after_node_restart_wrap_mult(cleanup,_Config) -> + ?line stop_client_and_server(). + +logic(N, M, TracingType) -> + helper_msgs(N, TracingType), + ?t:stop_node(ttb_helper:get_node(client)), + timer:sleep(2500), + ?line {ok,_ClientNode} = ?t:start_node(client,slave,[]), + ?line ok = ttb_helper:c(code, add_paths, [code:get_path()]), + ?line ttb_helper:c(client, init, []), + ?line helper_msgs(N, TracingType), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, ret_caller_call_handler2()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line M = length(Ret). + +begin_trace_with_resume(ServerNode, ClientNode, Dest) -> + ?line {ok, _} = ttb:tracer([ServerNode,ClientNode], [{file, Dest}, resume]), + ?line ttb:p(all, [call, timestamp]), + ?line ttb:tp(server, received, []), + ?line ttb:tp(client, put, []), + ?line ttb:tp(client, get, []). + +ret_caller_call_handler2() -> + {fun(A, {trace_ts, _, call, _, _} ,_,_) -> io:format(A, "ok.~n", []); + (_, _, _, _) -> ok end, []}. + +helper_msgs(N, TracingType) -> + case TracingType of + local -> + ttb_helper:msgs_ip(N); + _ -> + ttb_helper:msgs(N) + end. + +priv_dir(Conf) -> + %% Due to problem with long paths on windows => creating a new + %% priv_dir under data_dir + Dir = filename:absname(filename:join(?config(data_dir, Conf),priv_dir)), + filelib:ensure_dir(filename:join(Dir,"*")), + Dir. + +clean_priv_dir(Config) -> + PrivDir = priv_dir(Config), + case filelib:is_dir(PrivDir) of + true -> rm(PrivDir); + false -> ok + end. + +rm(This) -> + case filelib:is_dir(This) of + true -> + {ok,Files} = file:list_dir(This), + [rm(filename:join(This,F)) || F <- Files], + file:del_dir(This); + false -> + file:delete(This) + end. diff --git a/lib/observer/test/ttb_helper.erl b/lib/observer/test/ttb_helper.erl new file mode 100644 index 0000000000..76b06cd3ce --- /dev/null +++ b/lib/observer/test/ttb_helper.erl @@ -0,0 +1,157 @@ +-module(ttb_helper). %%Nodes control +-compile(export_all). + +%%API +%%get() -> client:get() +%%put(X) -> client:put(X) +%%msgs(N) -> N times client:put(test_msg) +%%clear() -> restart server +%%ensure_running() / stop() -> start/stop nodes +%%get_node(atom) -> return atom@hostname + +-define(NODE_CMD(Name), + "erl -sname " ++ atom_to_list(Name) ++ + " -pa .. -pa . -detached -run ttb_helper send_ok"). +-define(REG_NAME, nc_testing). + +new_fun() -> + fun(_, end_of_trace, _, Dict) -> io:format("~p~n", [dict:to_list(Dict)]); + (_, T, _, Dict) -> case element(2, T) of + {Pid, _, _} -> + dict:update_counter(Pid, 1, Dict); + Pid -> + dict:update_counter(Pid, 1, Dict) + end + end. + +new_fun_2() -> + fun(_, end_of_trace, _, Dict) -> io:format("~p~n", [dict:to_list(Dict)]); + (_, T, _, Dict) -> case element(2, T) of + {_, Name, _} when is_atom(Name)-> + dict:update_counter(Name, 1, Dict); + Pid -> + dict:update_counter(Pid, 1, Dict) + end + + end. + + +ensure_running() -> + try_start_node(server), + try_start_node(client), + clear(). + +try_start_node(Node) -> + global:unregister_name(?REG_NAME), + global:register_name(?REG_NAME, self()), + global:sync(), + N = get_node(Node), + case net_adm:ping(N) of + pong -> + io:format("Node ~p already running~n", [N]); + _ -> + io:format("Starting node ~p... ~p ", [Node, os:cmd(?NODE_CMD(Node))]), + recv() + end. + +clear() -> + s(server, stop, []), + init(). + +stop() -> + s(init, stop, []), + c(init, stop, []). + +msgs(N) -> + [c(client, put, [test_msg]) || _ <- lists:seq(1, N)], + s(server, received, [a,b]), + [dbg:flush_trace_port(Node) || Node <- [get_node(client), get_node(server)]]. + +msgs_ip(N) -> + [c(client, put, [test_msg]) || _ <- lists:seq(1, N)], + s(server, received, [a,b]), + timer:sleep(200). %% allow trace messages to arrive over tcp/ip + +run() -> + ttb({local, "A"}), + msgs(2), + c(erlang, whereis, [ttbt]). + +get() -> c(client, get, []). +put(Thing) -> c(client, put, [Thing]). + +get_node(Node) -> + {ok, Host} = inet:gethostname(), + list_to_atom(atom_to_list(Node) ++ "@" ++ Host). + +trace_setup() -> + ttb:p(all, call), + ttb:tp(server, received, []), + ttb:tp(client, put, []), + ttb:tp(client, get, []). + +ttb() -> ttb("A"). +ttb(File) -> + ttb:tracer([get_node(client), get_node(server)], [{file, File}, resume]), + ttb:p(all, [call, timestamp]), + ttb:tp(client, put, []), + ttb:tp(client, get, []), + ttb:tp(server, received, []). + +tc() -> + TC = example_config_gen:create_trace_case("dummy comment"), + Patterns = example_config_gen:create_pattern(client, put, 1, return), + Flags = example_config_gen:create_flags(all, call), + Merge = example_config_gen:create_merge_conf(show_handler(), "dummy merge comment"), + Merge2 = example_config_gen:create_merge_conf(undefined, "dummy merge comment"), + TC2 = example_config_gen:add_pattern(Patterns, TC), + TC3 = example_config_gen:add_flags(Flags, TC2), + TC4 = example_config_gen:add_merge_conf(Merge, TC3), + TC5 = example_config_gen:add_merge_conf(Merge2, TC4), + example_config_gen:add_nodes([get_node(client), get_node(server)], TC5). + + +show(X) -> + io:format(user, "Showing: ~p~n", [X]). + +state_handler() -> + {fun(_,_,I,S) -> io:format(user, "Got from ~p: ~p~n", [I,S]), S+1 end, 0}. + +show_handler() -> + {fun(A,B,_,_) -> io:format(A, "~p~n", [B]) end, []}. + +opts() -> + [[get_node(client), get_node(server)], + [{server, received, '_', []}, + {client, put, '_', []}, + {client, get, '_', []}], + {all, call}, + [{file, "TEST"}]]. + +overload_check(check) -> + true; +overload_check(_) -> + ok. +%%%Internal +s(M, F, A) -> rpc:call(get_node(server), M, F, A). +c(M, F, A) -> rpc:call(get_node(client), M, F, A). + +send_ok() -> + pong = net_adm:ping(get_node(test)), + global:sync(), + global:send(?REG_NAME, node()). + +init() -> + True = s(server, start, []), + io:format("ok1: ~p~n", [True]), + true = c(client, init, [get_node(server)]). + +recv() -> + receive + Node -> + io:format("Node ~p ready.~n", [Node]), + ok + after 5000 -> + io:format("Startup failed~n",[]), + throw(startup_failed) + end. diff --git a/lib/odbc/c_src/Makefile.in b/lib/odbc/c_src/Makefile.in index ed3eeb1d42..dda896bcd2 100644 --- a/lib/odbc/c_src/Makefile.in +++ b/lib/odbc/c_src/Makefile.in @@ -89,9 +89,10 @@ TARGET_FLAGS = @TARGET_FLAGS@ # ---------------------------------------------------- # Targets # ---------------------------------------------------- +_create_dirs := $(shell mkdir -p $(OBJ_DIR) $(BIN_DIR)) ifdef EXE_TARGET -opt debug: create_dirs $(EXE_TARGET) +opt debug: $(EXE_TARGET) else opt debug: endif @@ -119,10 +120,6 @@ endif $(OBJ_DIR)/odbcserver.o: odbcserver.c $(CC) $(CFLAGS) $(INCLUDES) $(TARGET_FLAGS) -o $@ -c odbcserver.c -create_dirs: - $(INSTALL_DIR) $(OBJ_DIR) - $(INSTALL_DIR) $(BIN_DIR) - # ---------------------------------------------------- # Release Target # ---------------------------------------------------- diff --git a/lib/odbc/doc/src/Makefile b/lib/odbc/doc/src/Makefile index e2f09733d0..3e648d854d 100644 --- a/lib/odbc/doc/src/Makefile +++ b/lib/odbc/doc/src/Makefile @@ -29,14 +29,6 @@ VSN=$(ODBC_VSN) APPLICATION=odbc # ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - -# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) @@ -89,32 +81,10 @@ EXTRA_FILES = $(DEFAULT_GIF_FILES) \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -128,8 +98,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif # Copy them to ../html $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -144,32 +112,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) # We depend just to copy them to ../html @@ -182,8 +124,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -193,32 +133,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -endif -endif - -endif release_spec: - - - - diff --git a/lib/odbc/doc/src/make.dep b/lib/odbc/doc/src/make.dep deleted file mode 100644 index d62e8dd8f0..0000000000 --- a/lib/odbc/doc/src/make.dep +++ /dev/null @@ -1,27 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex databases.tex error_handling.tex \ - getting_started.tex introduction.tex odbc.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: odbc_app_arc.ps - diff --git a/lib/orber/COSS/CosNaming/Makefile b/lib/orber/COSS/CosNaming/Makefile index d3deec7600..d4b2079036 100644 --- a/lib/orber/COSS/CosNaming/Makefile +++ b/lib/orber/COSS/CosNaming/Makefile @@ -113,7 +113,7 @@ debug: @${MAKE} TYPE=debug clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) @@ -124,13 +124,15 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_FILES): cos_naming_ext.idl cos_naming.idl +IDL-GENERATED: cos_naming_ext.idl cos_naming.idl erlc $(ERL_IDL_FLAGS) +'{this,"CosNaming::NamingContext"}' \ +'{this,"CosNaming::NamingContextExt"}' cos_naming_ext.idl erlc $(ERL_IDL_FLAGS) +'{this,"CosNaming::NamingContext"}' cos_naming.idl + >IDL-GENERATED -# echo "ic:gen(cos_naming, [{this, \"CosNaming::NamingContext\"}]), halt()."| $(ERL) $(ERL_IDL_FLAGS) +$(GEN_FILES): IDL-GENERATED +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/orber/doc/src/Makefile b/lib/orber/doc/src/Makefile index b8e26d5ba3..8a555cb408 100644 --- a/lib/orber/doc/src/Makefile +++ b/lib/orber/doc/src/Makefile @@ -28,14 +28,6 @@ VSN=$(ORBER_VSN) APPLICATION=orber # ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - -# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) @@ -128,32 +120,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -167,8 +137,6 @@ $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -184,35 +152,6 @@ clean clean_docs: rm -f errs core *~ rm -f $(JD_HTML) $(JD_PACK) -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTMLDIR)/* - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - rm -f $(JD_HTML) $(JD_PACK) - -endif - - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -224,9 +163,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk - -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -236,30 +172,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: - diff --git a/lib/orber/doc/src/Orber/ignore_config_record.inf b/lib/orber/doc/src/Orber/ignore_config_record.inf deleted file mode 100644 index 0a5053eba3..0000000000 --- a/lib/orber/doc/src/Orber/ignore_config_record.inf +++ /dev/null @@ -1 +0,0 @@ -This file makes clearmake use the -T switch for this subdirectory diff --git a/lib/orber/doc/src/make.dep b/lib/orber/doc/src/make.dep deleted file mode 100644 index cf5aad747d..0000000000 --- a/lib/orber/doc/src/make.dep +++ /dev/null @@ -1,62 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosNaming.tex CosNaming_BindingIterator.tex \ - CosNaming_NamingContext.tex CosNaming_NamingContextExt.tex \ - Module_Interface.tex any.tex book.tex ch_contents.tex \ - ch_debugging.tex ch_exceptions.tex \ - ch_idl_to_erlang_mapping.tex ch_ifr.tex ch_install.tex \ - ch_interceptors.tex ch_introduction.tex ch_naming_service.tex \ - ch_orber_kernel.tex ch_orberweb.tex ch_security.tex \ - ch_stubs.tex corba.tex corba_object.tex example_part.tex \ - fixed.tex interceptors.tex intro_part.tex \ - lname.tex lname_component.tex orber.tex orber_acl.tex \ - orber_diagnostics.tex orber_ifr.tex orber_tc.tex \ - ref_man.tex tools_debugging_part.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -ch_contents.tex: ../../../../system/doc/definitions/term.defs - -ch_idl_to_erlang_mapping.tex: ../../../../system/doc/definitions/term.defs - -ch_install.tex: ../../../../system/doc/definitions/term.defs - -ch_introduction.tex: ../../../../system/doc/definitions/term.defs - -ch_naming_service.tex: ../../../../system/doc/definitions/term.defs - -ch_orber_kernel.tex: ../../../../system/doc/definitions/term.defs - -orber_ifr.tex: ../../../../system/doc/definitions/term.defs - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: firewall_nat.ps - -book.dvi: interceptor_operations.ps - -book.dvi: dependent.ps orbs.ps - -book.dvi: name.ps - -book.dvi: iiop.ps theORB.ps - -book.dvi: dataframe1.ps dataframe2.ps dataframe3.ps \ - dataframe4.ps dataframe5.ps dataframe6.ps \ - dataframe7.ps dataframe8.ps menuframe.ps - diff --git a/lib/orber/examples/Stack/Makefile b/lib/orber/examples/Stack/Makefile index 6e7f292a04..215e57fcbe 100644 --- a/lib/orber/examples/Stack/Makefile +++ b/lib/orber/examples/Stack/Makefile @@ -64,6 +64,8 @@ HRL_FILES= ERL_FILES= $(MODULES:%=%.erl) +GEN_FILES = $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) + JAVA_CLASSES = \ StackClient @@ -94,16 +96,20 @@ ERL_COMPILE_FLAGS += \ debug opt: $(TARGET_FILES) clean: - rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES) + rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES) IDL-GENERATED rm -f errs core *~ docs: test: $(TEST_TARGET_FILES) - -$(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES): stack.idl +IDL-GENERATED: stack.idl erlc $(ERL_IDL_FLAGS) stack.idl + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/orber/priv/Makefile b/lib/orber/priv/Makefile index 2847727035..2847727035 100755..100644 --- a/lib/orber/priv/Makefile +++ b/lib/orber/priv/Makefile diff --git a/lib/orber/priv/blank.html b/lib/orber/priv/blank.html index 44e86908a0..44e86908a0 100755..100644 --- a/lib/orber/priv/blank.html +++ b/lib/orber/priv/blank.html diff --git a/lib/orber/priv/info_frames.html b/lib/orber/priv/info_frames.html index 75456a67a4..75456a67a4 100755..100644 --- a/lib/orber/priv/info_frames.html +++ b/lib/orber/priv/info_frames.html diff --git a/lib/orber/priv/main_frame.html b/lib/orber/priv/main_frame.html index 056a92812e..056a92812e 100755..100644 --- a/lib/orber/priv/main_frame.html +++ b/lib/orber/priv/main_frame.html diff --git a/lib/orber/priv/orber.tool b/lib/orber/priv/orber.tool index 910a7d7e45..910a7d7e45 100755..100644 --- a/lib/orber/priv/orber.tool +++ b/lib/orber/priv/orber.tool diff --git a/lib/orber/priv/orber_help.txt b/lib/orber/priv/orber_help.txt index a6580dc30a..a6580dc30a 100755..100644 --- a/lib/orber/priv/orber_help.txt +++ b/lib/orber/priv/orber_help.txt diff --git a/lib/orber/priv/start_info.html b/lib/orber/priv/start_info.html index 0ad521c90a..0ad521c90a 100755..100644 --- a/lib/orber/priv/start_info.html +++ b/lib/orber/priv/start_info.html diff --git a/lib/orber/src/Makefile b/lib/orber/src/Makefile index ccc449333c..e812e22b46 100644 --- a/lib/orber/src/Makefile +++ b/lib/orber/src/Makefile @@ -212,7 +212,7 @@ debug: opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) ../vsn.mk @@ -227,15 +227,14 @@ docs: # Special Build Targets # ---------------------------------------------------- -$(GEN_ERL_FILES1) $(GEN_HRL_FILES1): $(ERL_TOP)/lib/ic/include/erlang.idl +IDL-GENERATED: $(ERL_TOP)/lib/ic/include/erlang.idl CORBA.idl OrberIFR.idl erlc $(ERL_IDL_FLAGS) $(ERL_TOP)/lib/ic/include/erlang.idl - -$(GEN_ERL_FILES2) $(GEN_HRL_FILES2): CORBA.idl erlc $(ERL_IDL_FLAGS) CORBA.idl + erlc $(ERL_IDL_FLAGS) +'{this,"Orber::IFR"}' OrberIFR.idl + >IDL-GENERATED -$(GEN_ERL_FILES3) $(GEN_HRL_FILES3): OrberIFR.idl - erlc $(ERL_IDL_FLAGS) +'{this,"Orber::IFR"}' \ - OrberIFR.idl +$(GEN_ERL_FILES): IDL-GENERATED +$(TARGET_FILES): IDL-GENERATED $(GEN_ASN_ERL) $(GEN_ASN_HRL): OrberCSIv2.asn1 OrberCSIv2.set.asn erlc $(ERL_COMPILE_FLAGS) $(ASN_FLAGS) +'{inline,"OrberCSIv2"}' OrberCSIv2.set.asn diff --git a/lib/orber/src/corba.erl b/lib/orber/src/corba.erl index ecec768544..989e84f581 100644 --- a/lib/orber/src/corba.erl +++ b/lib/orber/src/corba.erl @@ -947,7 +947,7 @@ handle_cast2(M, F, A, InternalState, State, Ctx) -> {noreply, {InternalState, NewState}} end. -handle_exit(InternalState, State, {undef, [{M, F, _}|_]} = Reason, +handle_exit(InternalState, State, {undef, [{M, F, _, _}|_]} = Reason, OnewayOp, {M, F}, A) -> case catch check_exports(M:module_info(exports), F) of {'EXIT',{undef,_}} -> @@ -979,7 +979,7 @@ handle_exit(InternalState, State, {undef, [{M, F, _}|_]} = Reason, #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 4), completion_status=?COMPLETED_MAYBE}) end; -handle_exit(InternalState, State, {undef, [{M2, F2, A2}|_]} = Reason, +handle_exit(InternalState, State, {undef, [{M2, F2, A2, _}|_]} = Reason, OnewayOp, {M, F}, A) -> case catch check_exports(M2:module_info(exports), F2) of {'EXIT',{undef,_}} -> diff --git a/lib/orber/src/orber_diagnostics.erl b/lib/orber/src/orber_diagnostics.erl index c12dbfa896..c115d79524 100644 --- a/lib/orber/src/orber_diagnostics.erl +++ b/lib/orber/src/orber_diagnostics.erl @@ -130,10 +130,10 @@ missing_modules_helper([[Mod, Type]|T], ErrorsFound) when Type == ?IFR_StructDef end; missing_modules_helper([[Mod, Type]|T], ErrorsFound) when Type == ?IFR_InterfaceDef -> case catch Mod:oe_get_interface() of - {'EXIT', {undef,[{Mod, _, _}|_]}} -> + {'EXIT', {undef,[{Mod, _, _, _}|_]}} -> io:format("Missing (Interface): ~p~n", [Mod]), missing_modules_helper(T, ErrorsFound + 1); - {'EXIT', {undef,[{OtherMod, _, _}|_]}} -> + {'EXIT', {undef,[{OtherMod, _, _, _}|_]}} -> io:format("Missing (Inherited by the ~p Interface): ~p~n", [Mod, OtherMod]), missing_modules_helper(T, ErrorsFound + 1); diff --git a/lib/orber/src/orber_ifr.erl b/lib/orber/src/orber_ifr.erl index e56672be93..9631a268e4 100644 --- a/lib/orber/src/orber_ifr.erl +++ b/lib/orber/src/orber_ifr.erl @@ -500,7 +500,7 @@ get_tc(Id, Type) -> case catch Module:tc() of {'EXIT', Reason} -> case Reason of - {undef,[{Module, tc,[]}|_]} -> + {undef,[{Module, tc,[],_}|_]} -> orber:dbg("[~p] ~p:get_tc(~p);~nMissing ~p:tc()~n", [?LINE, ?MODULE, Id, Module], ?DEBUG_LEVEL), corba:raise(#'UNKNOWN'{minor=(?ORBER_VMCID bor 1), diff --git a/lib/orber/test/Makefile b/lib/orber/test/Makefile index b682bcf24b..996d0d1874 100644 --- a/lib/orber/test/Makefile +++ b/lib/orber/test/Makefile @@ -184,31 +184,17 @@ docs: # Special Targets # ---------------------------------------------------- -# -# Each IDL file produces many target files so no pattern -# rule can be used. -# -TGT_ORBER = \ - $(GEN_HRL_ORBER:%=$(IDLOUTDIR)/%) \ - $(GEN_MOD_ORBER:%=$(IDLOUTDIR)/%.erl) -TGT_IIOP = \ - $(GEN_HRL_IIOP:%=$(IDLOUTDIR)/%) \ - $(GEN_MOD_IIOP:%=$(IDLOUTDIR)/%.erl) - -TGT_TEST_SERVER = \ - $(GEN_HRL_TEST_SERVER:%=$(IDLOUTDIR)/%) \ - $(GEN_MOD_TEST_SERVER:%=$(IDLOUTDIR)/%.erl) - -$(TGT_ORBER): orber_test.idl +IDL-GENERATED: orber_test.idl iiop_test.idl orber_test_server.idl erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) orber_test.idl - -$(TGT_IIOP): iiop_test.idl erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) \ +'{preproc_flags,"-I../COSS/CosNaming"}' iiop_test.idl - -$(TGT_TEST_SERVER): orber_test_server.idl erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) \ +'{cfgfile,"orber_test_server.cfg"}' orber_test_server.idl + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Targets diff --git a/lib/os_mon/c_src/Makefile.in b/lib/os_mon/c_src/Makefile.in index 1a371eb380..b81d3f564b 100644 --- a/lib/os_mon/c_src/Makefile.in +++ b/lib/os_mon/c_src/Makefile.in @@ -82,13 +82,9 @@ ALL_CFLAGS = @CFLAGS@ @DEFS@ $(CFLAGS) # Targets # ---------------------------------------------------- -debug opt: $(OBJDIR) $(BINDIR) $(TARGET_FILES) +_create_dirs := $(shell mkdir -p $(OBJDIR) $(BINDIR)) -$(OBJDIR): - -@mkdir -p $(OBJDIR) - -$(BINDIR): - -@mkdir -p $(BINDIR) +debug opt: $(TARGET_FILES) clean: rm -f $(TARGET_FILES) diff --git a/lib/os_mon/doc/src/make.dep b/lib/os_mon/doc/src/make.dep deleted file mode 100644 index b657f2e036..0000000000 --- a/lib/os_mon/doc/src/make.dep +++ /dev/null @@ -1,21 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex cpu_sup.tex disksup.tex memsup.tex \ - nteventlog.tex os_mon.tex os_mon_mib.tex os_sup.tex \ - ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/os_mon/mibs/Makefile b/lib/os_mon/mibs/Makefile index cbbc337491..a361fef378 100644 --- a/lib/os_mon/mibs/Makefile +++ b/lib/os_mon/mibs/Makefile @@ -78,6 +78,9 @@ $(SNMP_BIN_TARGET_DIR)/OTP-MIB.bin: $(ERL_TOP)/lib/$(OTP_MIBDIR)/mibs/OTP-MI v1/%.mib.v1: %.mib $(ERL_TOP)/lib/snmp/bin/snmp-v2tov1 -o $@ $< +$(SNMP_BIN_TARGET_DIR)/OTP-OS-MON-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/OTP-REG.bin \ + $(SNMP_BIN_TARGET_DIR)/OTP-MIB.bin \ # ---------------------------------------------------- # Release Target diff --git a/lib/otp_mibs/doc/src/make.dep b/lib/otp_mibs/doc/src/make.dep deleted file mode 100644 index 2885155315..0000000000 --- a/lib/otp_mibs/doc/src/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex introduction.tex mibs.tex otp_mib.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/parsetools/doc/src/make.dep b/lib/parsetools/doc/src/make.dep deleted file mode 100644 index 3a09ecdedd..0000000000 --- a/lib/parsetools/doc/src/make.dep +++ /dev/null @@ -1,21 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex leex.tex ref_man.tex yecc.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -ref_man.tex: ../../../../system/doc/definitions/term.defs - diff --git a/lib/parsetools/include/yeccpre.hrl b/lib/parsetools/include/yeccpre.hrl index 80a3afbdb6..f638529aa4 100644 --- a/lib/parsetools/include/yeccpre.hrl +++ b/lib/parsetools/include/yeccpre.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -67,7 +67,7 @@ yeccpars0(Tokens, Tzr, State, States, Vstack) -> Error end. -yecc_error_type(function_clause, [{?MODULE,F,ArityOrArgs} | _]) -> +yecc_error_type(function_clause, [{?MODULE,F,ArityOrArgs,_} | _]) -> case atom_to_list(F) of "yeccgoto_" ++ SymbolL -> {ok,[{atom,_,Symbol}],_} = erl_scan:string(SymbolL), diff --git a/lib/parsetools/src/yeccparser.erl b/lib/parsetools/src/yeccparser.erl index 63127802ee..e4b8b06db5 100644 --- a/lib/parsetools/src/yeccparser.erl +++ b/lib/parsetools/src/yeccparser.erl @@ -17,7 +17,7 @@ line_of(Token) -> %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -83,7 +83,7 @@ yeccpars0(Tokens, Tzr, State, States, Vstack) -> Error end. -yecc_error_type(function_clause, [{?MODULE,F,ArityOrArgs} | _]) -> +yecc_error_type(function_clause, [{?MODULE,F,ArityOrArgs,_} | _]) -> case atom_to_list(F) of "yeccgoto_" ++ SymbolL -> {ok,[{atom,_,Symbol}],_} = erl_scan:string(SymbolL), diff --git a/lib/percept/doc/src/make.dep b/lib/percept/doc/src/make.dep deleted file mode 100644 index df16cffd4f..0000000000 --- a/lib/percept/doc/src/make.dep +++ /dev/null @@ -1,34 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex egd.tex egd_ug.tex part.tex percept.tex \ - percept_profile.tex percept_ug.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -egd_ug.tex: img.erl img_esi.erl - -percept_ug.tex: sorter.erl - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: img_esi_result.ps test1.ps test2.ps test3.ps \ - test4.ps - -book.dvi: percept_compare.ps percept_overview.ps percept_processes.ps \ - percept_processinfo.ps - diff --git a/lib/percept/doc/src/part_notes.xml b/lib/percept/doc/src/part_notes.xml index 4965e67640..4965e67640 100755..100644 --- a/lib/percept/doc/src/part_notes.xml +++ b/lib/percept/doc/src/part_notes.xml diff --git a/lib/percept/test/percept_SUITE_data/ipc-dist.dat b/lib/percept/test/percept_SUITE_data/ipc-dist.dat Binary files differindex 14ab6c0c5d..14ab6c0c5d 100755..100644 --- a/lib/percept/test/percept_SUITE_data/ipc-dist.dat +++ b/lib/percept/test/percept_SUITE_data/ipc-dist.dat diff --git a/lib/pman/doc/src/make.dep b/lib/pman/doc/src/make.dep deleted file mode 100644 index 2f6a8a06cd..0000000000 --- a/lib/pman/doc/src/make.dep +++ /dev/null @@ -1,26 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex pman.tex pman_chapter.tex \ - ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: main_window.ps options.ps trace.ps - diff --git a/lib/public_key/asn1/DSS.asn1 b/lib/public_key/asn1/DSS.asn1 index 77aca3808b..77aca3808b 100755..100644 --- a/lib/public_key/asn1/DSS.asn1 +++ b/lib/public_key/asn1/DSS.asn1 diff --git a/lib/public_key/asn1/InformationFramework.asn1 b/lib/public_key/asn1/InformationFramework.asn1 new file mode 100644 index 0000000000..40fbd11a2a --- /dev/null +++ b/lib/public_key/asn1/InformationFramework.asn1 @@ -0,0 +1,682 @@ +InformationFramework {joint-iso-itu-t ds(5) module(1) informationFramework(1) + 6} DEFINITIONS ::= +BEGIN + +-- EXPORTS All +-- The types and values defined in this module are exported for use in the other ASN.1 modules contained +-- within the Directory Specifications, and for the use of other applications which will use them to access +-- Directory services. Other applications may use them for their own purposes, but this will not constrain +-- extensions and modifications needed to maintain or improve the Directory service. +IMPORTS + -- from ITU-T Rec. X.501 | ISO/IEC 9594-2 + directoryAbstractService, id-ar, id-at, id-mr, id-nf, id-oa, id-oc, + id-sc, selectedAttributeTypes, serviceAdministration + FROM UsefulDefinitions {joint-iso-itu-t ds(5) module(1) + usefulDefinitions(0) 6} + SearchRule + FROM ServiceAdministration serviceAdministration + -- from ITU-T Rec. X.511 | ISO/IEC 9594-3 + TypeAndContextAssertion + FROM DirectoryAbstractService directoryAbstractService + -- from ITU-T Rec. X.520 | ISO/IEC 9594-6 + booleanMatch, commonName, generalizedTimeMatch, generalizedTimeOrderingMatch, + integerFirstComponentMatch, integerMatch, integerOrderingMatch, + objectIdentifierFirstComponentMatch, UnboundedDirectoryString + FROM SelectedAttributeTypes selectedAttributeTypes; + +-- attribute data types +Attribute{ATTRIBUTE:SupportedAttributes} ::= SEQUENCE { + type ATTRIBUTE.&id({SupportedAttributes}), + values + SET SIZE (0..MAX) OF ATTRIBUTE.&Type({SupportedAttributes}{@type}), + valuesWithContext + SET SIZE (1..MAX) OF + SEQUENCE {value ATTRIBUTE.&Type({SupportedAttributes}{@type}), + contextList SET SIZE (1..MAX) OF Context} OPTIONAL +} + +AttributeType ::= ATTRIBUTE.&id + +AttributeValue ::= ATTRIBUTE.&Type + +Context ::= SEQUENCE { + contextType CONTEXT.&id({SupportedContexts}), + contextValues + SET SIZE (1..MAX) OF CONTEXT.&Type({SupportedContexts}{@contextType}), + fallback BOOLEAN DEFAULT FALSE +} + +AttributeValueAssertion ::= SEQUENCE { + type ATTRIBUTE.&id({SupportedAttributes}), + assertion + ATTRIBUTE.&equality-match.&AssertionType + ({SupportedAttributes}{@type}), + assertedContexts + CHOICE {allContexts [0] NULL, + selectedContexts [1] SET SIZE (1..MAX) OF ContextAssertion + } OPTIONAL +} + +ContextAssertion ::= SEQUENCE { + contextType CONTEXT.&id({SupportedContexts}), + contextValues + SET SIZE (1..MAX) OF + CONTEXT.&Assertion({SupportedContexts}{@contextType}) +} + +AttributeTypeAssertion ::= SEQUENCE { + type ATTRIBUTE.&id({SupportedAttributes}), + assertedContexts SEQUENCE SIZE (1..MAX) OF ContextAssertion OPTIONAL +} + +-- Definition of the following information object set is deferred, perhaps to standardized +-- profiles or to protocol implementation conformance statements. The set is required to +-- specify a table constraint on the values component of Attribute, the value component +-- of AttributeTypeAndValue, and the assertion component of AttributeValueAssertion. +SupportedAttributes ATTRIBUTE ::= + {objectClass | aliasedEntryName, ...} + +-- Definition of the following information object set is deferred, perhaps to standardized +-- profiles or to protocol implementation conformance statements. The set is required to +-- specify a table constraint on the context specifications +SupportedContexts CONTEXT ::= + {...} + +-- naming data types +Name ::= CHOICE { -- only one possibility for now --rdnSequence RDNSequence +} + +RDNSequence ::= SEQUENCE OF RelativeDistinguishedName + +DistinguishedName ::= RDNSequence + +RelativeDistinguishedName ::= + SET SIZE (1..MAX) OF AttributeTypeAndDistinguishedValue + +AttributeTypeAndDistinguishedValue ::= SEQUENCE { + type ATTRIBUTE.&id({SupportedAttributes}), + value ATTRIBUTE.&Type({SupportedAttributes}{@type}), + primaryDistinguished BOOLEAN DEFAULT TRUE, + valuesWithContext + SET SIZE (1..MAX) OF + SEQUENCE {distingAttrValue + [0] ATTRIBUTE.&Type({SupportedAttributes}{@type}) + OPTIONAL, + contextList SET SIZE (1..MAX) OF Context} OPTIONAL +} + +-- subtree data types +SubtreeSpecification ::= SEQUENCE { + base [0] LocalName DEFAULT {}, + COMPONENTS OF ChopSpecification, + specificationFilter [4] Refinement OPTIONAL +} + +-- empty sequence specifies whole administrative area +LocalName ::= RDNSequence + +ChopSpecification ::= SEQUENCE { + specificExclusions + [1] SET SIZE (1..MAX) OF + CHOICE {chopBefore [0] LocalName, + chopAfter [1] LocalName} OPTIONAL, + minimum [2] BaseDistance DEFAULT 0, + maximum [3] BaseDistance OPTIONAL +} + +BaseDistance ::= INTEGER(0..MAX) + +Refinement ::= CHOICE { + item [0] OBJECT-CLASS.&id, + and [1] SET SIZE (1..MAX) OF Refinement, + or [2] SET SIZE (1..MAX) OF Refinement, + not [3] Refinement +} + +-- OBJECT-CLASS information object class specification +OBJECT-CLASS ::= CLASS { + &Superclasses OBJECT-CLASS OPTIONAL, + &kind ObjectClassKind DEFAULT structural, + &MandatoryAttributes ATTRIBUTE OPTIONAL, + &OptionalAttributes ATTRIBUTE OPTIONAL, + &id OBJECT IDENTIFIER UNIQUE +} +WITH SYNTAX { + [SUBCLASS OF &Superclasses] + [KIND &kind] + [MUST CONTAIN &MandatoryAttributes] + [MAY CONTAIN &OptionalAttributes] + ID &id +} + +ObjectClassKind ::= ENUMERATED {abstract(0), structural(1), auxiliary(2)} + +-- object classes +top OBJECT-CLASS ::= { + KIND abstract + MUST CONTAIN {objectClass} + ID id-oc-top +} + +alias OBJECT-CLASS ::= { + SUBCLASS OF {top} + MUST CONTAIN {aliasedEntryName} + ID id-oc-alias +} + +parent OBJECT-CLASS ::= {KIND abstract + ID id-oc-parent +} + +child OBJECT-CLASS ::= {KIND auxiliary + ID id-oc-child +} + +-- ATTRIBUTE information object class specification +ATTRIBUTE ::= CLASS { + &derivation ATTRIBUTE OPTIONAL, + &Type OPTIONAL, -- either &Type or &derivation required + &equality-match MATCHING-RULE OPTIONAL, + &ordering-match MATCHING-RULE OPTIONAL, + &substrings-match MATCHING-RULE OPTIONAL, + &single-valued BOOLEAN DEFAULT FALSE, + &collective BOOLEAN DEFAULT FALSE, + &dummy BOOLEAN DEFAULT FALSE, + -- operational extensions + &no-user-modification BOOLEAN DEFAULT FALSE, + &usage AttributeUsage DEFAULT userApplications, + &id OBJECT IDENTIFIER UNIQUE +} +WITH SYNTAX { + [SUBTYPE OF &derivation] + [WITH SYNTAX &Type] + [EQUALITY MATCHING RULE &equality-match] + [ORDERING MATCHING RULE &ordering-match] + [SUBSTRINGS MATCHING RULE &substrings-match] + [SINGLE VALUE &single-valued] + [COLLECTIVE &collective] + [DUMMY &dummy] + [NO USER MODIFICATION &no-user-modification] + [USAGE &usage] + ID &id +} + +AttributeUsage ::= ENUMERATED { + userApplications(0), directoryOperation(1), distributedOperation(2), + dSAOperation(3)} + +-- attributes +objectClass ATTRIBUTE ::= { + WITH SYNTAX OBJECT IDENTIFIER + EQUALITY MATCHING RULE objectIdentifierMatch + ID id-at-objectClass +} + +aliasedEntryName ATTRIBUTE ::= { + WITH SYNTAX DistinguishedName + EQUALITY MATCHING RULE distinguishedNameMatch + SINGLE VALUE TRUE + ID id-at-aliasedEntryName +} + +-- MATCHING-RULE information object class specification +MATCHING-RULE ::= CLASS { + &ParentMatchingRules MATCHING-RULE OPTIONAL, + &AssertionType OPTIONAL, + &uniqueMatchIndicator ATTRIBUTE OPTIONAL, + &id OBJECT IDENTIFIER UNIQUE +} +WITH SYNTAX { + [PARENT &ParentMatchingRules] + [SYNTAX &AssertionType] + [UNIQUE-MATCH-INDICATOR &uniqueMatchIndicator] + ID &id +} + +-- matching rules +objectIdentifierMatch MATCHING-RULE ::= { + SYNTAX OBJECT IDENTIFIER + ID id-mr-objectIdentifierMatch +} + +distinguishedNameMatch MATCHING-RULE ::= { + SYNTAX DistinguishedName + ID id-mr-distinguishedNameMatch +} + +MAPPING-BASED-MATCHING{SelectedBy, BOOLEAN:combinable, MappingResult, + OBJECT IDENTIFIER:matchingRule} ::= CLASS { + &selectBy SelectedBy OPTIONAL, + &ApplicableTo ATTRIBUTE, + &subtypesIncluded BOOLEAN DEFAULT TRUE, + &combinable BOOLEAN(combinable), + &mappingResults MappingResult OPTIONAL, + &userControl BOOLEAN DEFAULT FALSE, + &exclusive BOOLEAN DEFAULT TRUE, + &matching-rule MATCHING-RULE.&id(matchingRule), + &id OBJECT IDENTIFIER UNIQUE +} +WITH SYNTAX { + [SELECT BY &selectBy] + APPLICABLE TO &ApplicableTo + [SUBTYPES INCLUDED &subtypesIncluded] + COMBINABLE &combinable + [MAPPING RESULTS &mappingResults] + [USER CONTROL &userControl] + [EXCLUSIVE &exclusive] + MATCHING RULE &matching-rule + ID &id +} + +-- NAME-FORM information object class specification +NAME-FORM ::= CLASS { + &namedObjectClass OBJECT-CLASS, + &MandatoryAttributes ATTRIBUTE, + &OptionalAttributes ATTRIBUTE OPTIONAL, + &id OBJECT IDENTIFIER UNIQUE +} +WITH SYNTAX { + NAMES &namedObjectClass + WITH ATTRIBUTES &MandatoryAttributes + [AND OPTIONALLY &OptionalAttributes] + ID &id +} + +-- STRUCTURE-RULE class and DIT structure rule data types +DITStructureRule ::= SEQUENCE { + ruleIdentifier RuleIdentifier, + -- shall be unique within the scope of the subschema + nameForm NAME-FORM.&id, + superiorStructureRules SET SIZE (1..MAX) OF RuleIdentifier OPTIONAL +} + +RuleIdentifier ::= INTEGER + +STRUCTURE-RULE ::= CLASS { + &nameForm NAME-FORM, + &SuperiorStructureRules STRUCTURE-RULE OPTIONAL, + &id RuleIdentifier +} +WITH SYNTAX { + NAME FORM &nameForm + [SUPERIOR RULES &SuperiorStructureRules] + ID &id +} + +-- DIT content rule data type and CONTENT-RULE class +DITContentRule ::= SEQUENCE { + structuralObjectClass OBJECT-CLASS.&id, + auxiliaries SET SIZE (1..MAX) OF OBJECT-CLASS.&id OPTIONAL, + mandatory [1] SET SIZE (1..MAX) OF ATTRIBUTE.&id OPTIONAL, + optional [2] SET SIZE (1..MAX) OF ATTRIBUTE.&id OPTIONAL, + precluded [3] SET SIZE (1..MAX) OF ATTRIBUTE.&id OPTIONAL +} + +CONTENT-RULE ::= CLASS { + &structuralClass OBJECT-CLASS.&id UNIQUE, + &Auxiliaries OBJECT-CLASS OPTIONAL, + &Mandatory ATTRIBUTE OPTIONAL, + &Optional ATTRIBUTE OPTIONAL, + &Precluded ATTRIBUTE OPTIONAL +} +WITH SYNTAX { + STRUCTURAL OBJECT-CLASS &structuralClass + [AUXILIARY OBJECT-CLASSES &Auxiliaries] + [MUST CONTAIN &Mandatory] + [MAY CONTAIN &Optional] + [MUST-NOT CONTAIN &Precluded] +} + +CONTEXT ::= CLASS { + &Type , + &DefaultValue OPTIONAL, + &Assertion OPTIONAL, + &absentMatch BOOLEAN DEFAULT TRUE, + &id OBJECT IDENTIFIER UNIQUE +} +WITH SYNTAX { + WITH SYNTAX &Type + [DEFAULT-VALUE &DefaultValue] + [ASSERTED AS &Assertion] + [ABSENT-MATCH &absentMatch] + ID &id +} + +DITContextUse ::= SEQUENCE { + attributeType ATTRIBUTE.&id, + mandatoryContexts [1] SET SIZE (1..MAX) OF CONTEXT.&id OPTIONAL, + optionalContexts [2] SET SIZE (1..MAX) OF CONTEXT.&id OPTIONAL +} + +DIT-CONTEXT-USE-RULE ::= CLASS { + &attributeType ATTRIBUTE.&id UNIQUE, + &Mandatory CONTEXT OPTIONAL, + &Optional CONTEXT OPTIONAL +} +WITH SYNTAX { + ATTRIBUTE TYPE &attributeType + [MANDATORY CONTEXTS &Mandatory] + [OPTIONAL CONTEXTS &Optional] +} + +FRIENDS ::= CLASS { + &anchor ATTRIBUTE.&id UNIQUE, + &Friends ATTRIBUTE +}WITH SYNTAX {ANCHOR &anchor + FRIENDS &Friends +} + +-- system schema information objects +-- object classes +subentry OBJECT-CLASS ::= { + SUBCLASS OF {top} + KIND structural + MUST CONTAIN {commonName | subtreeSpecification} + ID id-sc-subentry +} + +subentryNameForm NAME-FORM ::= { + NAMES subentry + WITH ATTRIBUTES {commonName} + ID id-nf-subentryNameForm +} + +subtreeSpecification ATTRIBUTE ::= { + WITH SYNTAX SubtreeSpecification + USAGE directoryOperation + ID id-oa-subtreeSpecification +} + +administrativeRole ATTRIBUTE ::= { + WITH SYNTAX OBJECT-CLASS.&id + EQUALITY MATCHING RULE objectIdentifierMatch + USAGE directoryOperation + ID id-oa-administrativeRole +} + +createTimestamp ATTRIBUTE ::= { + WITH SYNTAX GeneralizedTime + -- as per 46.3 b) or c) of ITU-T Rec. X.680 | ISO/IEC 8824-1 + EQUALITY MATCHING RULE generalizedTimeMatch + ORDERING MATCHING RULE generalizedTimeOrderingMatch + SINGLE VALUE TRUE + NO USER MODIFICATION TRUE + USAGE directoryOperation + ID id-oa-createTimestamp +} + +modifyTimestamp ATTRIBUTE ::= { + WITH SYNTAX GeneralizedTime + -- as per 46.3 b) or c) of ITU-T Rec. X.680 | ISO/IEC 8824-1 + EQUALITY MATCHING RULE generalizedTimeMatch + ORDERING MATCHING RULE generalizedTimeOrderingMatch + SINGLE VALUE TRUE + NO USER MODIFICATION TRUE + USAGE directoryOperation + ID id-oa-modifyTimestamp +} + +subschemaTimestamp ATTRIBUTE ::= { + WITH SYNTAX GeneralizedTime + -- as per 46.3 b) or c) of ITU-T Rec. X.680 | ISO/IEC 8824-1 + EQUALITY MATCHING RULE generalizedTimeMatch + ORDERING MATCHING RULE generalizedTimeOrderingMatch + SINGLE VALUE TRUE + NO USER MODIFICATION TRUE + USAGE directoryOperation + ID id-oa-subschemaTimestamp +} + +creatorsName ATTRIBUTE ::= { + WITH SYNTAX DistinguishedName + EQUALITY MATCHING RULE distinguishedNameMatch + SINGLE VALUE TRUE + NO USER MODIFICATION TRUE + USAGE directoryOperation + ID id-oa-creatorsName +} + +modifiersName ATTRIBUTE ::= { + WITH SYNTAX DistinguishedName + EQUALITY MATCHING RULE distinguishedNameMatch + SINGLE VALUE TRUE + NO USER MODIFICATION TRUE + USAGE directoryOperation + ID id-oa-modifiersName +} + +subschemaSubentryList ATTRIBUTE ::= { + WITH SYNTAX DistinguishedName + EQUALITY MATCHING RULE distinguishedNameMatch + SINGLE VALUE TRUE + NO USER MODIFICATION TRUE + USAGE directoryOperation + ID id-oa-subschemaSubentryList +} + +accessControlSubentryList ATTRIBUTE ::= { + WITH SYNTAX DistinguishedName + EQUALITY MATCHING RULE distinguishedNameMatch + NO USER MODIFICATION TRUE + USAGE directoryOperation + ID id-oa-accessControlSubentryList +} + +collectiveAttributeSubentryList ATTRIBUTE ::= { + WITH SYNTAX DistinguishedName + EQUALITY MATCHING RULE distinguishedNameMatch + NO USER MODIFICATION TRUE + USAGE directoryOperation + ID id-oa-collectiveAttributeSubentryList +} + +contextDefaultSubentryList ATTRIBUTE ::= { + WITH SYNTAX DistinguishedName + EQUALITY MATCHING RULE distinguishedNameMatch + NO USER MODIFICATION TRUE + USAGE directoryOperation + ID id-oa-contextDefaultSubentryList +} + +serviceAdminSubentryList ATTRIBUTE ::= { + WITH SYNTAX DistinguishedName + EQUALITY MATCHING RULE distinguishedNameMatch + NO USER MODIFICATION TRUE + USAGE directoryOperation + ID id-oa-serviceAdminSubentryList +} + +hasSubordinates ATTRIBUTE ::= { + WITH SYNTAX BOOLEAN + EQUALITY MATCHING RULE booleanMatch + SINGLE VALUE TRUE + NO USER MODIFICATION TRUE + USAGE directoryOperation + ID id-oa-hasSubordinates +} + +accessControlSubentry OBJECT-CLASS ::= { + KIND auxiliary + ID id-sc-accessControlSubentry +} + +collectiveAttributeSubentry OBJECT-CLASS ::= { + KIND auxiliary + ID id-sc-collectiveAttributeSubentry +} + +collectiveExclusions ATTRIBUTE ::= { + WITH SYNTAX OBJECT IDENTIFIER + EQUALITY MATCHING RULE objectIdentifierMatch + USAGE directoryOperation + ID id-oa-collectiveExclusions +} + +contextAssertionSubentry OBJECT-CLASS ::= { + KIND auxiliary + MUST CONTAIN {contextAssertionDefaults} + ID id-sc-contextAssertionSubentry +} + +contextAssertionDefaults ATTRIBUTE ::= { + WITH SYNTAX TypeAndContextAssertion + EQUALITY MATCHING RULE objectIdentifierFirstComponentMatch + USAGE directoryOperation + ID id-oa-contextAssertionDefault +} + +serviceAdminSubentry OBJECT-CLASS ::= { + KIND auxiliary + MUST CONTAIN {searchRules} + ID id-sc-serviceAdminSubentry +} + +searchRules ATTRIBUTE ::= { + WITH SYNTAX SearchRuleDescription + EQUALITY MATCHING RULE integerFirstComponentMatch + USAGE directoryOperation + ID id-oa-searchRules +} + +SearchRuleDescription ::= SEQUENCE { + COMPONENTS OF SearchRule, + name [28] SET SIZE (1..MAX) OF UnboundedDirectoryString OPTIONAL, + description [29] UnboundedDirectoryString OPTIONAL +} + +hierarchyLevel ATTRIBUTE ::= { + WITH SYNTAX HierarchyLevel + EQUALITY MATCHING RULE integerMatch + ORDERING MATCHING RULE integerOrderingMatch + SINGLE VALUE TRUE + NO USER MODIFICATION TRUE + USAGE directoryOperation + ID id-oa-hierarchyLevel +} + +HierarchyLevel ::= INTEGER + +hierarchyBelow ATTRIBUTE ::= { + WITH SYNTAX HierarchyBelow + EQUALITY MATCHING RULE booleanMatch + SINGLE VALUE TRUE + NO USER MODIFICATION TRUE + USAGE directoryOperation + ID id-oa-hierarchyBelow +} + +HierarchyBelow ::= BOOLEAN + +hierarchyParent ATTRIBUTE ::= { + WITH SYNTAX DistinguishedName + EQUALITY MATCHING RULE distinguishedNameMatch + SINGLE VALUE TRUE + USAGE directoryOperation + ID id-oa-hierarchyParent +} + +hierarchyTop ATTRIBUTE ::= { + WITH SYNTAX DistinguishedName + EQUALITY MATCHING RULE distinguishedNameMatch + SINGLE VALUE TRUE + USAGE directoryOperation + ID id-oa-hierarchyTop +} + +-- object identifier assignments +-- object classes +id-oc-top OBJECT IDENTIFIER ::= + {id-oc 0} + +id-oc-alias OBJECT IDENTIFIER ::= {id-oc 1} + +id-oc-parent OBJECT IDENTIFIER ::= {id-oc 28} + +id-oc-child OBJECT IDENTIFIER ::= {id-oc 29} + +-- attributes +id-at-objectClass OBJECT IDENTIFIER ::= {id-at 0} + +id-at-aliasedEntryName OBJECT IDENTIFIER ::= {id-at 1} + +-- matching rules +id-mr-objectIdentifierMatch OBJECT IDENTIFIER ::= {id-mr 0} + +id-mr-distinguishedNameMatch OBJECT IDENTIFIER ::= {id-mr 1} + +-- operational attributes +id-oa-excludeAllCollectiveAttributes OBJECT IDENTIFIER ::= + {id-oa 0} + +id-oa-createTimestamp OBJECT IDENTIFIER ::= {id-oa 1} + +id-oa-modifyTimestamp OBJECT IDENTIFIER ::= {id-oa 2} + +id-oa-creatorsName OBJECT IDENTIFIER ::= {id-oa 3} + +id-oa-modifiersName OBJECT IDENTIFIER ::= {id-oa 4} + +id-oa-administrativeRole OBJECT IDENTIFIER ::= {id-oa 5} + +id-oa-subtreeSpecification OBJECT IDENTIFIER ::= {id-oa 6} + +id-oa-collectiveExclusions OBJECT IDENTIFIER ::= {id-oa 7} + +id-oa-subschemaTimestamp OBJECT IDENTIFIER ::= {id-oa 8} + +id-oa-hasSubordinates OBJECT IDENTIFIER ::= {id-oa 9} + +id-oa-subschemaSubentryList OBJECT IDENTIFIER ::= {id-oa 10} + +id-oa-accessControlSubentryList OBJECT IDENTIFIER ::= {id-oa 11} + +id-oa-collectiveAttributeSubentryList OBJECT IDENTIFIER ::= {id-oa 12} + +id-oa-contextDefaultSubentryList OBJECT IDENTIFIER ::= {id-oa 13} + +id-oa-contextAssertionDefault OBJECT IDENTIFIER ::= {id-oa 14} + +id-oa-serviceAdminSubentryList OBJECT IDENTIFIER ::= {id-oa 15} + +id-oa-searchRules OBJECT IDENTIFIER ::= {id-oa 16} + +id-oa-hierarchyLevel OBJECT IDENTIFIER ::= {id-oa 17} + +id-oa-hierarchyBelow OBJECT IDENTIFIER ::= {id-oa 18} + +id-oa-hierarchyParent OBJECT IDENTIFIER ::= {id-oa 19} + +id-oa-hierarchyTop OBJECT IDENTIFIER ::= {id-oa 20} + +-- subentry classes +id-sc-subentry OBJECT IDENTIFIER ::= {id-sc 0} + +id-sc-accessControlSubentry OBJECT IDENTIFIER ::= {id-sc 1} + +id-sc-collectiveAttributeSubentry OBJECT IDENTIFIER ::= {id-sc 2} + +id-sc-contextAssertionSubentry OBJECT IDENTIFIER ::= {id-sc 3} + +id-sc-serviceAdminSubentry OBJECT IDENTIFIER ::= {id-sc 4} + +-- Name forms +id-nf-subentryNameForm OBJECT IDENTIFIER ::= {id-nf 16} + +-- administrative roles +id-ar-autonomousArea OBJECT IDENTIFIER ::= {id-ar 1} + +id-ar-accessControlSpecificArea OBJECT IDENTIFIER ::= {id-ar 2} + +id-ar-accessControlInnerArea OBJECT IDENTIFIER ::= {id-ar 3} + +id-ar-subschemaAdminSpecificArea OBJECT IDENTIFIER ::= {id-ar 4} + +id-ar-collectiveAttributeSpecificArea OBJECT IDENTIFIER ::= {id-ar 5} + +id-ar-collectiveAttributeInnerArea OBJECT IDENTIFIER ::= {id-ar 6} + +id-ar-contextDefaultSpecificArea OBJECT IDENTIFIER ::= {id-ar 7} + +id-ar-serviceSpecificArea OBJECT IDENTIFIER ::= {id-ar 8} + +END -- InformationFramework diff --git a/lib/public_key/asn1/Makefile b/lib/public_key/asn1/Makefile index 94abec083c..2ce1168349 100644 --- a/lib/public_key/asn1/Makefile +++ b/lib/public_key/asn1/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2008-2010. All Rights Reserved. +# Copyright Ericsson AB 2008-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 @@ -38,12 +38,12 @@ RELSYSDIR = $(RELEASE_PATH)/lib/public_key-$(VSN) .SUFFIXES: .asn1 .PRECIOUS: %.erl -ASN_TOP = OTP-PUB-KEY +ASN_TOP = OTP-PUB-KEY PKCS-FRAME ASN_MODULES = PKIX1Explicit88 PKIX1Implicit88 PKIX1Algorithms88 \ - PKIXAttributeCertificate PKCS-1 PKCS-3 OTP-PKIX + PKIXAttributeCertificate PKCS-1 PKCS-3 PKCS-8 InformationFramework PKCS5v2-0 OTP-PKIX ASN_ASNS = $(ASN_MODULES:%=%.asn1) -ASN_ERLS = $(ASN_TOP).erl -ASN_HRLS = $(ASN_TOP).hrl +ASN_ERLS = $(ASN_TOP:%=%.erl) +ASN_HRLS = $(ASN_TOP:%=%.hrl) ASN_CONFIGS = OTP-PUB-KEY.asn1config ASN_DBS = $(ASN_MODULES:%=%.asn1db) OTP-PUB-KEY.asn1db ASN_TABLES = $(ASN_MODULES:%=%.table) @@ -65,7 +65,7 @@ EBIN = ../ebin EXTRA_ERLC_FLAGS = ERL_COMPILE_FLAGS += $(EXTRA_ERLC_FLAGS) -ASN_FLAGS = -bber_bin +der +compact_bit_string +optimize +noobj +asn1config +inline +ASN_FLAGS = -bber_bin +der +compact_bit_string +optimize +noobj +asn1config +inline +nif # ---------------------------------------------------- # Targets @@ -79,11 +79,11 @@ clean: docs: -%.erl: %.set.asn +%.erl %.hrl: %.set.asn erlc $(ASN_FLAGS) $< -$(HRL_FILES): $(ASN_HRLS) - cp -p $(ASN_HRLS) $(INCLUDE) +$(INCLUDE)/%.hrl: %.hrl + cp -p $< $@ # ---------------------------------------------------- # Release Target @@ -113,3 +113,9 @@ OTP-PUB-KEY.asn1db: PKIX1Algorithms88.asn1 \ PKCS-1.asn1\ PKCS-3.asn1\ OTP-PKIX.asn1 + +$(EBIN)/PKCS-FRAME.beam: PKCS-FRAME.erl PKCS-FRAME.hrl +PKCS-FRAME.erl PKCS-FRAME.hrl: PKCS-FRAME.asn1db +PKCS-FRAME.asn1db: PKCS-8.asn1\ + InformationFramework.asn1\ + PKCS5v2-0.asn1
\ No newline at end of file diff --git a/lib/public_key/asn1/PKCS-1.asn1 b/lib/public_key/asn1/PKCS-1.asn1 index b06f5efa9d..b06f5efa9d 100755..100644 --- a/lib/public_key/asn1/PKCS-1.asn1 +++ b/lib/public_key/asn1/PKCS-1.asn1 diff --git a/lib/public_key/asn1/PKCS-8.asn1 b/lib/public_key/asn1/PKCS-8.asn1 new file mode 100644 index 0000000000..7413519b57 --- /dev/null +++ b/lib/public_key/asn1/PKCS-8.asn1 @@ -0,0 +1,83 @@ +PKCS-8 {iso(1) member-body(2) us(840) rsadsi(113549) pkcs(1) pkcs-8(8) + modules(1) pkcs-8(1)} + +-- $Revision: 1.5 $ + +-- This module has been checked for conformance with the ASN.1 +-- standard by the OSS ASN.1 Tools + +DEFINITIONS IMPLICIT TAGS ::= + +BEGIN + +-- EXPORTS All -- +-- All types and values defined in this module is exported for use in other +-- ASN.1 modules. + +IMPORTS + +-- informationFramework +-- FROM UsefulDefinitions {joint-iso-itu-t(2) ds(5) module(1) +-- usefulDefinitions(0) 3} + +Attribute +-- FROM InformationFramework informationFramework + FROM InformationFramework; + +-- This import is really unnecessary since ALGORITHM-IDENTIFIER is defined as a +-- TYPE-IDENTIFIER +-- Renome this import and replace all occurences of ALGORITHM-IDENTIFIER with +-- TYPE-IDENTIFIER as a workaround for weaknesses in the ASN.1 compiler +--AlgorithmIdentifier, ALGORITHM-IDENTIFIER +-- FROM PKCS5v2-0 {iso(1) member-body(2) us(840) rsadsi(113549) +-- pkcs(1) pkcs-5(5) modules(16) pkcs-5(1)}; + +-- Inlined from PKCS5v2-0 since it is the only thing imported from that module +-- AlgorithmIdentifier { ALGORITHM-IDENTIFIER:InfoObjectSet } ::= +AlgorithmIdentifier { TYPE-IDENTIFIER:InfoObjectSet } ::= +SEQUENCE { +-- algorithm ALGORITHM-IDENTIFIER.&id({InfoObjectSet}), + algorithm TYPE-IDENTIFIER.&id({InfoObjectSet}), +-- parameters ALGORITHM-IDENTIFIER.&Type({InfoObjectSet} + parameters TYPE-IDENTIFIER.&Type({InfoObjectSet} + {@algorithm}) OPTIONAL } + +-- Private-key information syntax + +PrivateKeyInfo ::= SEQUENCE { + version Version, +-- privateKeyAlgorithm AlgorithmIdentifier {{PrivateKeyAlgorithms}}, + privateKeyAlgorithm AlgorithmIdentifier {{...}}, + privateKey PrivateKey, + attributes [0] Attributes OPTIONAL } + +Version ::= INTEGER {v1(0)} (v1,...) + +PrivateKey ::= OCTET STRING + +-- Attributes ::= SET OF Attribute +Attributes ::= SET OF Attribute {{...}} + +-- Encrypted private-key information syntax + +EncryptedPrivateKeyInfo ::= SEQUENCE { +-- encryptionAlgorithm AlgorithmIdentifier {{KeyEncryptionAlgorithms}}, + encryptionAlgorithm AlgorithmIdentifier {{...}}, + encryptedData EncryptedData +} + +EncryptedData ::= OCTET STRING + +-- PrivateKeyAlgorithms ALGORITHM-IDENTIFIER ::= { +PrivateKeyAlgorithms TYPE-IDENTIFIER ::= { + ... -- For local profiles +} + +-- KeyEncryptionAlgorithms ALGORITHM-IDENTIFIER ::= { +KeyEncryptionAlgorithms TYPE-IDENTIFIER ::= { + ... -- For local profiles +} + +END + + diff --git a/lib/public_key/asn1/PKCS-FRAME.set.asn b/lib/public_key/asn1/PKCS-FRAME.set.asn new file mode 100644 index 0000000000..a0777ff260 --- /dev/null +++ b/lib/public_key/asn1/PKCS-FRAME.set.asn @@ -0,0 +1,3 @@ +PKCS-8.asn1 +InformationFramework.asn1 +PKCS5v2-0.asn1 diff --git a/lib/public_key/asn1/PKCS5v2-0.asn1 b/lib/public_key/asn1/PKCS5v2-0.asn1 new file mode 100644 index 0000000000..fe7e16c7fa --- /dev/null +++ b/lib/public_key/asn1/PKCS5v2-0.asn1 @@ -0,0 +1,142 @@ +-- PKCS #5 v2.0 ASN.1 Module +-- Revised March 25, 1999 + +-- This module has been checked for conformance with the +-- ASN.1 standard by the OSS ASN.1 Tools + +PKCS5v2-0 {iso(1) member-body(2) us(840) rsadsi(113549) + pkcs(1) pkcs-5(5) modules(16) pkcs5v2-0(1)} + +DEFINITIONS ::= BEGIN + +-- Basic object identifiers + +rsadsi OBJECT IDENTIFIER ::= + {iso(1) member-body(2) us(840) 113549} +pkcs OBJECT IDENTIFIER ::= {rsadsi 1} +pkcs-5 OBJECT IDENTIFIER ::= {pkcs 5} + +-- Basic types and classes + +AlgorithmIdentifier { TYPE-IDENTIFIER:InfoObjectSet } ::= +SEQUENCE { + algorithm TYPE-IDENTIFIER.&id({InfoObjectSet}), + parameters TYPE-IDENTIFIER.&Type({InfoObjectSet} + {@algorithm}) OPTIONAL } + +--ALGORITHM-IDENTIFIER ::= TYPE-IDENTIFIER + +-- PBKDF2 + +-- PBKDF2Algorithms ALGORITHM-IDENTIFIER ::= +-- { {PBKDF2-params IDENTIFIED BY id-PBKDF2}, ...} + +id-PBKDF2 OBJECT IDENTIFIER ::= {pkcs-5 12} + +-- algid-hmacWithSHA1 AlgorithmIdentifier {{PBKDF2-PRFs}} ::= +-- {algorithm id-hmacWithSHA1, parameters NULL : NULL} + +PBKDF2-params ::= SEQUENCE { + salt CHOICE { + specified OCTET STRING, + otherSource AlgorithmIdentifier {{PBKDF2-SaltSources}} + }, + iterationCount INTEGER (1..MAX), + keyLength INTEGER (1..MAX) OPTIONAL, + prf AlgorithmIdentifier {{PBKDF2-PRFs}} DEFAULT +{algorithm id-hmacWithSHA1, parameters NULL : NULL}} +-- algid-hmacWithSHA1 } + +PBKDF2-SaltSources TYPE-IDENTIFIER ::= { ... } + +PBKDF2-PRFs TYPE-IDENTIFIER ::= + { {NULL IDENTIFIED BY id-hmacWithSHA1}, ... } + + -- PBES1 + +PBES1Algorithms TYPE-IDENTIFIER ::= + { {PBEParameter IDENTIFIED BY pbeWithMD2AndDES-CBC} | + {PBEParameter IDENTIFIED BY pbeWithMD2AndRC2-CBC} | + {PBEParameter IDENTIFIED BY pbeWithMD5AndDES-CBC} | + {PBEParameter IDENTIFIED BY pbeWithMD5AndRC2-CBC} | + {PBEParameter IDENTIFIED BY pbeWithSHA1AndDES-CBC} | + {PBEParameter IDENTIFIED BY pbeWithSHA1AndRC2-CBC}, ...} + +pbeWithMD2AndDES-CBC OBJECT IDENTIFIER ::= {pkcs-5 1} +pbeWithMD2AndRC2-CBC OBJECT IDENTIFIER ::= {pkcs-5 4} +pbeWithMD5AndDES-CBC OBJECT IDENTIFIER ::= {pkcs-5 3} +pbeWithMD5AndRC2-CBC OBJECT IDENTIFIER ::= {pkcs-5 6} +pbeWithSHA1AndDES-CBC OBJECT IDENTIFIER ::= {pkcs-5 10} +pbeWithSHA1AndRC2-CBC OBJECT IDENTIFIER ::= {pkcs-5 11} + +PBEParameter ::= SEQUENCE { + salt OCTET STRING (SIZE(8)), + iterationCount INTEGER } + +-- PBES2 + +PBES2Algorithms TYPE-IDENTIFIER ::= + { {PBES2-params IDENTIFIED BY id-PBES2}, ...} + +id-PBES2 OBJECT IDENTIFIER ::= {pkcs-5 13} + +PBES2-params ::= SEQUENCE { + keyDerivationFunc AlgorithmIdentifier {{PBES2-KDFs}}, + encryptionScheme AlgorithmIdentifier {{PBES2-Encs}} } + +PBES2-KDFs TYPE-IDENTIFIER ::= + { {PBKDF2-params IDENTIFIED BY id-PBKDF2}, ... } + +PBES2-Encs TYPE-IDENTIFIER ::= { ... } + +-- PBMAC1 + +PBMAC1Algorithms TYPE-IDENTIFIER ::= + { {PBMAC1-params IDENTIFIED BY id-PBMAC1}, ...} + +id-PBMAC1 OBJECT IDENTIFIER ::= {pkcs-5 14} + +PBMAC1-params ::= SEQUENCE { + keyDerivationFunc AlgorithmIdentifier {{PBMAC1-KDFs}}, + messageAuthScheme AlgorithmIdentifier {{PBMAC1-MACs}} } + +PBMAC1-KDFs TYPE-IDENTIFIER ::= + { {PBKDF2-params IDENTIFIED BY id-PBKDF2}, ... } + +PBMAC1-MACs TYPE-IDENTIFIER ::= { ... } + +-- Supporting techniques + +digestAlgorithm OBJECT IDENTIFIER ::= {rsadsi 2} +encryptionAlgorithm OBJECT IDENTIFIER ::= {rsadsi 3} + +SupportingAlgorithms TYPE-IDENTIFIER ::= + { {NULL IDENTIFIED BY id-hmacWithSHA1} | + {OCTET STRING (SIZE(8)) IDENTIFIED BY desCBC} | + {OCTET STRING (SIZE(8)) IDENTIFIED BY des-EDE3-CBC} | + {RC2-CBC-Parameter IDENTIFIED BY rc2CBC} | + {RC5-CBC-Parameters IDENTIFIED BY rc5-CBC-PAD}, ... } + +id-hmacWithSHA1 OBJECT IDENTIFIER ::= {digestAlgorithm 7} + +desCBC OBJECT IDENTIFIER ::= + {iso(1) identified-organization(3) oiw(14) secsig(3) + algorithms(2) 7} -- from OIW + +des-EDE3-CBC OBJECT IDENTIFIER ::= {encryptionAlgorithm 7} + +rc2CBC OBJECT IDENTIFIER ::= {encryptionAlgorithm 2} + +RC2-CBC-Parameter ::= SEQUENCE { + rc2ParameterVersion INTEGER OPTIONAL, + iv OCTET STRING (SIZE(8)) } + +rc5-CBC-PAD OBJECT IDENTIFIER ::= {encryptionAlgorithm 9} + +RC5-CBC-Parameters ::= SEQUENCE { + version INTEGER {v1-0(16)}, -- (v1-0), + rounds INTEGER (8..127), + blockSizeInBits INTEGER (64 | 128), + iv OCTET STRING OPTIONAL } + +END diff --git a/lib/public_key/doc/src/Makefile b/lib/public_key/doc/src/Makefile index afb17399da..9616a96195 100644 --- a/lib/public_key/doc/src/Makefile +++ b/lib/public_key/doc/src/Makefile @@ -29,14 +29,6 @@ VSN=$(PUBLIC_KEY_VSN) APPLICATION=public_key # ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - -# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) @@ -79,33 +71,10 @@ EXTRA_FILES = \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_PART_FILES:%.xml=%.tex) \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = public_key-$(VSN).pdf -TOP_PS_FILE = public_key-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -118,8 +87,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -134,33 +101,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ min_head.gif \ - $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -173,8 +113,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -184,30 +122,6 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -endif -endif - -endif - release_spec: info: diff --git a/lib/public_key/doc/src/introduction.xml b/lib/public_key/doc/src/introduction.xml index 8cf11ee10e..a21fcf3576 100644 --- a/lib/public_key/doc/src/introduction.xml +++ b/lib/public_key/doc/src/introduction.xml @@ -48,5 +48,13 @@ of the concepts of using public keys.</p> </section> + <section> + <title>Performance tips</title> + <p>The public_key decode and encode functions will try to use the nifs + which are in the asn1 compilers runtime modules if they can be found. + So for the best performance you want to have the asn1 application in the + path of your system. </p> + </section> + </chapter> diff --git a/lib/public_key/doc/src/make.dep b/lib/public_key/doc/src/make.dep deleted file mode 100644 index 2675556f1b..0000000000 --- a/lib/public_key/doc/src/make.dep +++ /dev/null @@ -1,21 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex cert_records.tex introduction.tex \ - part.tex public_key.tex public_key_records.tex \ - ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 9a3832c68b..821e7a2300 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -61,11 +61,14 @@ <p><code>string = [bytes()]</code></p> <p><code>pki_asn1_type() = 'Certificate' | 'RSAPrivateKey'| 'RSAPublicKey' - 'DSAPrivateKey' | 'DSAPublicKey' | 'DHParameter' | 'SubjectPublicKeyInfo'</code></p> + 'DSAPrivateKey' | 'DSAPublicKey' | 'DHParameter' | 'SubjectPublicKeyInfo'| 'PrivateKeyInfo'</code></p> <p><code>pem_entry () = {pki_asn1_type(), binary(), %% DER or encrypted DER - not_encrypted | {"DES-CBC" | "DES-EDE3-CBC", crypto:rand_bytes(8)}}.</code></p> - + not_encrypted | cipher_info()} </code></p> + + <p><code>cipher_info() = {"RC2-CBC | "DES-CBC" | "DES-EDE3-CBC", crypto:rand_bytes(8)} | + 'PBES2-params'} </code></p> + <p><code>rsa_public_key() = #'RSAPublicKey'{}</code></p> <p><code>rsa_private_key() = #'RSAPrivateKey'{} </code></p> @@ -118,7 +121,8 @@ <funcs> <func> - <name>decrypt_private(CipherText, Key [, Options]) -> binary()</name> + <name>decrypt_private(CipherText, Key) -> binary()</name> + <name>decrypt_private(CipherText, Key, Options) -> binary()</name> <fsummary>Public key decryption.</fsummary> <type> <v>CipherText = binary()</v> @@ -131,7 +135,8 @@ </func> <func> - <name>decrypt_public(CipherText, Key [, Options]) - > binary()</name> + <name>decrypt_public(CipherText, Key) - > binary()</name> + <name>decrypt_public(CipherText, Key, Options) - > binary()</name> <fsummary></fsummary> <type> <v>CipherText = binary()</v> @@ -198,7 +203,8 @@ </func> <func> - <name>pem_entry_decode(PemEntry [, Password]) -> term()</name> + <name>pem_entry_decode(PemEntry) -> term()</name> + <name>pem_entry_decode(PemEntry, Password) -> term()</name> <fsummary>Decodes a pem entry.</fsummary> <type> <v> PemEntry = pem_entry() </v> @@ -213,7 +219,8 @@ </func> <func> - <name>pem_entry_encode(Asn1Type, Entity [,{CipherInfo, Password}]) -> pem_entry()</name> + <name>pem_entry_encode(Asn1Type, Entity) -> pem_entry()</name> + <name>pem_entry_encode(Asn1Type, Entity, {CipherInfo, Password}) -> pem_entry()</name> <fsummary> Creates a pem entry that can be fed to pem_encode/1.</fsummary> <type> <v>Asn1Type = pki_asn1_type()</v> @@ -224,7 +231,7 @@ dsa_public_key() and this function will create the appropriate 'SubjectPublicKeyInfo' entry. </d> - <v>CipherInfo = {"DES-CBC" | "DES-EDE3-CBC", crypto:rand_bytes(8)}</v> + <v>CipherInfo = cipher_info()</v> <v>Password = string()</v> </type> <desc> diff --git a/lib/public_key/include/public_key.hrl b/lib/public_key/include/public_key.hrl index 5f97d80f7e..2475295974 100644 --- a/lib/public_key/include/public_key.hrl +++ b/lib/public_key/include/public_key.hrl @@ -23,6 +23,7 @@ -define(public_key, true). -include("OTP-PUB-KEY.hrl"). +-include("PKCS-FRAME.hrl"). -record('SubjectPublicKeyInfoAlgorithm', { algorithm, diff --git a/lib/public_key/src/Makefile b/lib/public_key/src/Makefile index 5a24b02d2a..062c495a65 100644 --- a/lib/public_key/src/Makefile +++ b/lib/public_key/src/Makefile @@ -42,10 +42,11 @@ MODULES = \ public_key \ pubkey_pem \ pubkey_ssh \ + pubkey_pbe \ pubkey_cert \ - pubkey_cert_records + pubkey_cert_records -HRL_FILES = $(INCLUDE)/public_key.hrl +HRL_FILES = $(INCLUDE)/public_key.hrl INTERNAL_HRL_FILES = @@ -109,4 +110,3 @@ release_spec: opt $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) $(RELSYSDIR)/ebin release_docs_spec: - diff --git a/lib/public_key/src/pubkey_pbe.erl b/lib/public_key/src/pubkey_pbe.erl new file mode 100644 index 0000000000..43f6c42f10 --- /dev/null +++ b/lib/public_key/src/pubkey_pbe.erl @@ -0,0 +1,213 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-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% +%% +%% Description: Implements Password Based Encryption PKCS-5, RFC-2898 + +-module(pubkey_pbe). + +-include("public_key.hrl"). + +-export([encode/4, decode/4, decrypt_parameters/1]). +-export([pbdkdf1/4, pbdkdf2/6]). + +-define(DEFAULT_SHA_MAC_KEYLEN, 20). +-define(ASN1_OCTET_STR_TAG, 4). +-define(IV_LEN, 8). + +%%==================================================================== +%% Internal application API +%%==================================================================== + +%%-------------------------------------------------------------------- +-spec encode(binary(), string(), string(), term()) -> binary(). +%% +%% Description: Performs password based encoding +%%-------------------------------------------------------------------- +encode(Data, Password, "DES-CBC" = Cipher, KeyDevParams) -> + {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), + crypto:des_cbc_encrypt(Key, IV, Data); + +encode(Data, Password, "DES-EDE3-CBC" = Cipher, KeyDevParams) -> + {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), + <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, + crypto:des_ede3_cbc_encrypt(Key1, Key2, Key3, IV, Data); + +encode(Data, Password, "RC2-CBC" = Cipher, KeyDevParams) -> + {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), + crypto:rc2_cbc_encrypt(Key, IV, Data). +%%-------------------------------------------------------------------- +-spec decode(binary(), string(), string(), term()) -> binary(). +%% +%% Description: Performs password based decoding +%%-------------------------------------------------------------------- +decode(Data, Password,"DES-CBC"= Cipher, KeyDevParams) -> + {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), + crypto:des_cbc_decrypt(Key, IV, Data); + +decode(Data, Password,"DES-EDE3-CBC" = Cipher, KeyDevParams) -> + {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), + <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, + crypto:des_ede3_cbc_decrypt(Key1, Key2, Key3, IV, Data); + +decode(Data, Password,"RC2-CBC"= Cipher, KeyDevParams) -> + {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), + crypto:rc2_cbc_decrypt(Key, IV, Data). + +%%-------------------------------------------------------------------- +-spec pbdkdf1(string(), iodata(), integer(), atom()) -> binary(). +%% +%% Description: Implements password based decryption key derive function 1. +%% Exported mainly for testing purposes. +%%-------------------------------------------------------------------- +pbdkdf1(_, _, 0, Acc) -> + Acc; +pbdkdf1(Password, Salt, Count, Hash) -> + Result = crypto:Hash([Password, Salt]), + do_pbdkdf1(Result, Count-1, Result, Hash). + +%%-------------------------------------------------------------------- +-spec pbdkdf2(string(), iodata(), integer(), integer(), fun(), integer()) + -> binary(). +%% +%% Description: Implements password based decryption key derive function 2. +%% Exported mainly for testing purposes. +%%-------------------------------------------------------------------- +pbdkdf2(Password, Salt, Count, DerivedKeyLen, Prf, PrfOutputLen)-> + NumBlocks = ceiling(DerivedKeyLen / PrfOutputLen), + NumLastBlockOctets = DerivedKeyLen - (NumBlocks - 1) * PrfOutputLen , + blocks(NumBlocks, NumLastBlockOctets, 1, Password, Salt, + Count, Prf, PrfOutputLen, <<>>). +%%-------------------------------------------------------------------- +-spec decrypt_parameters(#'EncryptedPrivateKeyInfo_encryptionAlgorithm'{}) -> + {Cipher::string(), #'PBES2-params'{}}. +%% +%% Description: Performs ANS1-decoding of encryption parameters. +%%-------------------------------------------------------------------- +decrypt_parameters(#'EncryptedPrivateKeyInfo_encryptionAlgorithm'{ + algorithm = Oid, parameters = Param}) -> + decrypt_parameters(Oid, Param). + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +password_to_key_and_iv(Password, _, #'PBES2-params'{} = Params) -> + {Salt, ItrCount, KeyLen, PseudoRandomFunction, PseudoOtputLen, IV} = + key_derivation_params(Params), + <<Key:KeyLen/binary, _/binary>> = + pbdkdf2(Password, Salt, ItrCount, KeyLen, PseudoRandomFunction, PseudoOtputLen), + {Key, IV}; +password_to_key_and_iv(Password, Cipher, Salt) -> + KeyLen = derived_key_length(Cipher, undefined), + <<Key:KeyLen/binary, _/binary>> = + pem_encrypt(<<>>, Password, Salt, ceiling(KeyLen div 16), <<>>, md5), + %% Old PEM encryption does not use standard encryption method + %% pbdkdf1 and uses then salt as IV + {Key, Salt}. + +pem_encrypt(_, _, _, 0, Acc, _) -> + Acc; +pem_encrypt(Prev, Password, Salt, Count, Acc, Hash) -> + Result = crypto:Hash([Prev, Password, Salt]), + pem_encrypt(Result, Password, Salt, Count-1 , <<Acc/binary, Result/binary>>, Hash). + +do_pbdkdf1(_, 0, Acc, _) -> + Acc; +do_pbdkdf1(Prev, Count, Acc, Hash) -> + Result = crypto:Hash(Prev), + do_pbdkdf1(Result, Count-1 , <<Result/binary, Acc/binary>>, Hash). + +iv(#'PBES2-params_encryptionScheme'{algorithm = Algo, + parameters = ASNIV}) when (Algo == ?'desCBC') or + (Algo == ?'des-EDE3-CBC') -> + %% This is an so called open ASN1-type that in this + %% case will be an octet-string of length 8 + <<?ASN1_OCTET_STR_TAG, ?IV_LEN, IV:?IV_LEN/binary>> = ASNIV, + IV; +iv(#'PBES2-params_encryptionScheme'{algorithm = ?'rc2CBC', + parameters = ASN1IV}) -> + {ok, #'RC2-CBC-Parameter'{iv = IV}} = 'PKCS-FRAME':decode('RC2-CBC-Parameter', ASN1IV), + iolist_to_binary(IV). + +blocks(1, N, Index, Password, Salt, Count, Prf, PrfLen, Acc) -> + <<XorSum:N/binary, _/binary>> = xor_sum(Password, Salt, Count, Index, Prf, PrfLen), + <<Acc/binary, XorSum/binary>>; +blocks(NumBlocks, N, Index, Password, Salt, Count, Prf, PrfLen, Acc) -> + XorSum = xor_sum(Password, Salt, Count, Index, Prf, PrfLen), + blocks(NumBlocks -1, N, Index +1, Password, Salt, Count, Prf, + PrfLen, <<Acc/binary, XorSum/binary>>). + +xor_sum(Password, Salt, Count, Index, Prf, PrfLen) -> + Result = Prf(Password, [Salt,<<Index:32/unsigned-big-integer>>], PrfLen), + do_xor_sum(Prf, PrfLen, Result, Password, Count-1, Result). + +do_xor_sum(_, _, _, _, 0, Acc) -> + Acc; +do_xor_sum(Prf, PrfLen, Prev, Password, Count, Acc)-> + Result = Prf(Password, Prev, PrfLen), + do_xor_sum(Prf, PrfLen, Result, Password, Count-1, crypto:exor(Acc, Result)). + +decrypt_parameters(?'id-PBES2', DekParams) -> + {ok, Params} = 'PKCS-FRAME':decode('PBES2-params', DekParams), + {cipher(Params#'PBES2-params'.encryptionScheme), Params}. + +key_derivation_params(#'PBES2-params'{keyDerivationFunc = KeyDerivationFunc, + encryptionScheme = EncScheme}) -> + #'PBES2-params_keyDerivationFunc'{algorithm = ?'id-PBKDF2', + parameters = + #'PBKDF2-params'{salt = {specified, OctetSalt}, + iterationCount = Count, + keyLength = Length, + prf = Prf}} = KeyDerivationFunc, + #'PBES2-params_encryptionScheme'{algorithm = Algo} = EncScheme, + {PseudoRandomFunction, PseudoOtputLen} = pseudo_random_function(Prf), + KeyLen = derived_key_length(Algo, Length), + {OctetSalt, Count, KeyLen, + PseudoRandomFunction, PseudoOtputLen, iv(EncScheme)}. + +%% This function currently matches a tuple that ougth to be the value +%% ?'id-hmacWithSHA1, but we need some kind of ASN1-fix for this. +pseudo_random_function(#'PBKDF2-params_prf'{algorithm = + {_,_, _,'id-hmacWithSHA1'}}) -> + {fun crypto:sha_mac/3, pseudo_output_length(?'id-hmacWithSHA1')}; +pseudo_random_function(#'PBKDF2-params_prf'{algorithm = ?'id-hmacWithSHA1'}) -> + {fun crypto:sha_mac/3, pseudo_output_length(?'id-hmacWithSHA1')}. + +pseudo_output_length(?'id-hmacWithSHA1') -> + ?DEFAULT_SHA_MAC_KEYLEN. + +derived_key_length(_, Len) when is_integer(Len) -> + Len; +derived_key_length(Cipher,_) when (Cipher == ?'desCBC') or + (Cipher == "DES-CBC") -> + 8; +derived_key_length(Cipher,_) when (Cipher == ?'rc2CBC') or + (Cipher == "RC2-CBC") -> + 16; +derived_key_length(Cipher,_) when (Cipher == ?'des-EDE3-CBC') or + (Cipher == "DES-EDE3-CBC") -> + 24. + +cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'desCBC'}) -> + "DES-CBC"; +cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'des-EDE3-CBC'}) -> + "DES-EDE3-CBC"; +cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'rc2CBC'}) -> + "RC2-CBC". + +ceiling(Float) -> + erlang:round(Float + 0.5). diff --git a/lib/public_key/src/pubkey_pem.erl b/lib/public_key/src/pubkey_pem.erl index c26815bc04..910473d629 100644 --- a/lib/public_key/src/pubkey_pem.erl +++ b/lib/public_key/src/pubkey_pem.erl @@ -43,8 +43,6 @@ -include("public_key.hrl"). -export([encode/1, decode/1, decipher/2, cipher/3]). -%% Backwards compatibility --export([decode_key/2]). -define(ENCODED_LINE_LENGTH, 64). @@ -69,23 +67,23 @@ encode(PemEntries) -> encode_pem_entries(PemEntries). %%-------------------------------------------------------------------- --spec decipher({pki_asn1_type(), DerEncrypted::binary(),{Cipher :: string(), - Salt :: binary()}}, +-spec decipher({pki_asn1_type(), DerEncrypted::binary(), + {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{}}}, string()) -> Der::binary(). %% %% Description: Deciphers a decrypted pem entry. %%-------------------------------------------------------------------- -decipher({_, DecryptDer, {Cipher,Salt}}, Password) -> - decode_key(DecryptDer, Password, Cipher, Salt). +decipher({_, DecryptDer, {Cipher, KeyDevParams}}, Password) -> + pubkey_pbe:decode(DecryptDer, Password, Cipher, KeyDevParams). %%-------------------------------------------------------------------- --spec cipher(Der::binary(),{Cipher :: string(), Salt :: binary()} , +-spec cipher(Der::binary(), {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{}} , string()) -> binary(). %% %% Description: Ciphers a PEM entry %%-------------------------------------------------------------------- -cipher(Der, {Cipher,Salt}, Password)-> - encode_key(Der, Password, Cipher, Salt). +cipher(Der, {Cipher, KeyDevParams}, Password)-> + pubkey_pbe:encode(Der, Password, Cipher, KeyDevParams). %%-------------------------------------------------------------------- %%% Internal functions @@ -127,8 +125,20 @@ decode_pem_entry(Start, Lines) -> Type = asn1_type(Start), Cs = erlang:iolist_to_binary(Lines), Decoded = base64:mime_decode(Cs), - {Type, Decoded, not_encrypted}. - + case Type of + 'EncryptedPrivateKeyInfo'-> + decode_encrypted_private_keyinfo(Decoded); + _ -> + {Type, Decoded, not_encrypted} + end. + +decode_encrypted_private_keyinfo(Der) -> + #'EncryptedPrivateKeyInfo'{encryptionAlgorithm = AlgorithmInfo, + encryptedData = Data} = + public_key:der_decode('EncryptedPrivateKeyInfo', Der), + DecryptParams = pubkey_pbe:decrypt_parameters(AlgorithmInfo), + {'PrivateKeyInfo', iolist_to_binary(Data), DecryptParams}. + split_bin(Bin) -> split_bin(0, Bin). @@ -160,37 +170,6 @@ join_entry([<<"-----END ", _/binary>>| Lines], Entry) -> join_entry([Line | Lines], Entry) -> join_entry(Lines, [Line | Entry]). -decode_key(Data, Password, "DES-CBC", Salt) -> - Key = password_to_key(Password, Salt, 8), - IV = Salt, - crypto:des_cbc_decrypt(Key, IV, Data); -decode_key(Data, Password, "DES-EDE3-CBC", Salt) -> - Key = password_to_key(Password, Salt, 24), - IV = Salt, - <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, - crypto:des_ede3_cbc_decrypt(Key1, Key2, Key3, IV, Data). - -encode_key(Data, Password, "DES-CBC", Salt) -> - Key = password_to_key(Password, Salt, 8), - IV = Salt, - crypto:des_cbc_encrypt(Key, IV, Data); -encode_key(Data, Password, "DES-EDE3-CBC", Salt) -> - Key = password_to_key(Password, Salt, 24), - IV = Salt, - <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, - crypto:des_ede3_cbc_encrypt(Key1, Key2, Key3, IV, Data). - -password_to_key(Data, Salt, KeyLen) -> - <<Key:KeyLen/binary, _/binary>> = - password_to_key(<<>>, Data, Salt, KeyLen, <<>>), - Key. - -password_to_key(_, _, _, Len, Acc) when Len =< 0 -> - Acc; -password_to_key(Prev, Data, Salt, Len, Acc) -> - M = crypto:md5([Prev, Data, Salt]), - password_to_key(M, Data, Salt, Len - size(M), <<Acc/binary, M/binary>>). - unhex(S) -> unhex(S, []). @@ -228,6 +207,10 @@ pem_end(<<"-----BEGIN DSA PRIVATE KEY-----">>) -> <<"-----END DSA PRIVATE KEY-----">>; pem_end(<<"-----BEGIN DH PARAMETERS-----">>) -> <<"-----END DH PARAMETERS-----">>; +pem_end(<<"-----BEGIN PRIVATE KEY-----">>) -> + <<"-----END PRIVATE KEY-----">>; +pem_end(<<"-----BEGIN ENCRYPTED PRIVATE KEY-----">>) -> + <<"-----END ENCRYPTED PRIVATE KEY-----">>; pem_end(_) -> undefined. @@ -242,18 +225,14 @@ asn1_type(<<"-----BEGIN PUBLIC KEY-----">>) -> asn1_type(<<"-----BEGIN DSA PRIVATE KEY-----">>) -> 'DSAPrivateKey'; asn1_type(<<"-----BEGIN DH PARAMETERS-----">>) -> - 'DHParameter'. + 'DHParameter'; +asn1_type(<<"-----BEGIN PRIVATE KEY-----">>) -> + 'PrivateKeyInfo'; +asn1_type(<<"-----BEGIN ENCRYPTED PRIVATE KEY-----">>) -> + 'EncryptedPrivateKeyInfo'. pem_decrypt() -> <<"Proc-Type: 4,ENCRYPTED">>. pem_decrypt_info(Cipher, Salt) -> io_lib:format("DEK-Info: ~s,~s", [Cipher, lists:flatten(hexify(Salt))]). - -%%-------------------------------------------------------------------- -%%% Deprecated -%%-------------------------------------------------------------------- -decode_key({_Type, Bin, not_encrypted}, _) -> - Bin; -decode_key({_Type, Bin, {Chipher,Salt}}, Password) -> - decode_key(Bin, Password, Chipher, Salt). diff --git a/lib/public_key/src/public_key.app.src b/lib/public_key/src/public_key.app.src index 1963bd05d4..4cc81ea573 100644 --- a/lib/public_key/src/public_key.app.src +++ b/lib/public_key/src/public_key.app.src @@ -3,10 +3,12 @@ {vsn, "%VSN%"}, {modules, [ public_key, pubkey_pem, + pubkey_pbe, pubkey_ssh, pubkey_cert, pubkey_cert_records, - 'OTP-PUB-KEY' + 'OTP-PUB-KEY', + 'PKCS-FRAME' ]}, {applications, [crypto, kernel, stdlib]}, {registered, []}, diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 33fcce2c44..753322b46d 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -45,13 +45,6 @@ ssh_decode/2, ssh_encode/2 ]). -%% Deprecated --export([decode_private_key/1, decode_private_key/2, pem_to_der/1]). - --deprecated({pem_to_der, 1, next_major_release}). --deprecated({decode_private_key, 1, next_major_release}). --deprecated({decode_private_key, 2, next_major_release}). - -type rsa_padding() :: 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' | 'rsa_no_padding'. -type public_crypt_options() :: [{rsa_pad, rsa_padding()}]. @@ -104,22 +97,23 @@ pem_entry_decode({Asn1Type, Der, not_encrypted}) when is_atom(Asn1Type), pem_entry_decode({Asn1Type, Der, not_encrypted}, _) when is_atom(Asn1Type), is_binary(Der) -> der_decode(Asn1Type, Der); +pem_entry_decode({Asn1Type, CryptDer, {Cipher, #'PBES2-params'{}}} = PemEntry, + Password) when is_atom(Asn1Type) andalso + is_binary(CryptDer) andalso + is_list(Cipher) -> + do_pem_entry_decode(PemEntry, Password); pem_entry_decode({Asn1Type, CryptDer, {Cipher, Salt}} = PemEntry, - Password) when is_atom(Asn1Type), - is_binary(CryptDer), - is_list(Cipher), - is_binary(Salt), - erlang:byte_size(Salt) == 8 - -> - Der = pubkey_pem:decipher(PemEntry, Password), - der_decode(Asn1Type, Der). + Password) when is_atom(Asn1Type) andalso + is_binary(CryptDer) andalso + is_list(Cipher) andalso + is_binary(Salt) andalso + erlang:byte_size(Salt) == 8 -> + do_pem_entry_decode(PemEntry, Password). %%-------------------------------------------------------------------- -spec pem_entry_encode(pki_asn1_type(), term()) -> pem_entry(). --spec pem_entry_encode(pki_asn1_type(), term(), - {{Cipher :: string(), Salt :: binary()}, string()}) -> - pem_entry(). -% +-spec pem_entry_encode(pki_asn1_type(), term(), term()) -> pem_entry(). +%% %% Description: Creates a pem entry that can be feed to pem_encode/1. %%-------------------------------------------------------------------- pem_entry_encode('SubjectPublicKeyInfo', Entity=#'RSAPublicKey'{}) -> @@ -137,21 +131,36 @@ pem_entry_encode('SubjectPublicKeyInfo', pem_entry_encode(Asn1Type, Entity) when is_atom(Asn1Type) -> Der = der_encode(Asn1Type, Entity), {Asn1Type, Der, not_encrypted}. -pem_entry_encode(Asn1Type, Entity, - {{Cipher, Salt}= CipherInfo, Password}) when is_atom(Asn1Type), - is_list(Cipher), - is_binary(Salt), - erlang:byte_size(Salt) == 8, - is_list(Password)-> - Der = der_encode(Asn1Type, Entity), - DecryptDer = pubkey_pem:cipher(Der, CipherInfo, Password), - {Asn1Type, DecryptDer, CipherInfo}. - +pem_entry_encode(Asn1Type, Entity, {{Cipher, #'PBES2-params'{}} = CipherInfo, + Password}) when is_atom(Asn1Type) andalso + is_list(Password) andalso + is_list(Cipher) -> + do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password); + +pem_entry_encode(Asn1Type, Entity, {{Cipher, Salt} = CipherInfo, + Password}) when is_atom(Asn1Type) andalso + is_list(Password) andalso + is_list(Cipher) andalso + is_binary(Salt) andalso + erlang:byte_size(Salt) == 8 -> + do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password). + %%-------------------------------------------------------------------- -spec der_decode(asn1_type(), Der::binary()) -> term(). %% %% Description: Decodes a public key asn1 der encoded entity. %%-------------------------------------------------------------------- +der_decode(Asn1Type, Der) when (Asn1Type == 'PrivateKeyInfo') or + (Asn1Type == 'EncryptedPrivateKeyInfo') + andalso is_binary(Der) -> + try + {ok, Decoded} = 'PKCS-FRAME':decode(Asn1Type, Der), + Decoded + catch + error:{badmatch, {error, _}} = Error -> + erlang:error(Error) + end; + der_decode(Asn1Type, Der) when is_atom(Asn1Type), is_binary(Der) -> try {ok, Decoded} = 'OTP-PUB-KEY':decode(Asn1Type, Der), @@ -166,6 +175,16 @@ der_decode(Asn1Type, Der) when is_atom(Asn1Type), is_binary(Der) -> %% %% Description: Encodes a public key entity with asn1 DER encoding. %%-------------------------------------------------------------------- +der_encode(Asn1Type, Entity) when (Asn1Type == 'PrivateKeyInfo') or + (Asn1Type == 'EncryptedPrivateKeyInfo') -> + try + {ok, Encoded} = 'PKCS-FRAME':encode(Asn1Type, Entity), + iolist_to_binary(Encoded) + catch + error:{badmatch, {error, _}} = Error -> + erlang:error(Error) + end; + der_encode(Asn1Type, Entity) when is_atom(Asn1Type) -> try {ok, Encoded} = 'OTP-PUB-KEY':encode(Asn1Type, Entity), @@ -535,6 +554,14 @@ ssh_encode(Entries, Type) when is_list(Entries), %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- +do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password) -> + Der = der_encode(Asn1Type, Entity), + DecryptDer = pubkey_pem:cipher(Der, CipherInfo, Password), + {Asn1Type, DecryptDer, CipherInfo}. + +do_pem_entry_decode({Asn1Type,_, _} = PemEntry, Password) -> + Der = pubkey_pem:decipher(PemEntry, Password), + der_decode(Asn1Type, Der). encrypt_public(PlainText, N, E, Options)-> Padding = proplists:get_value(rsa_pad, Options, rsa_pkcs1_padding), @@ -632,20 +659,3 @@ validate(DerCert, #path_validation_state{working_issuer_name = Issuer, sized_binary(Binary) -> Size = size(Binary), <<?UINT32(Size), Binary/binary>>. - -%%-------------------------------------------------------------------- -%%% Deprecated functions -%%-------------------------------------------------------------------- -pem_to_der(CertSource) -> - {ok, Bin} = file:read_file(CertSource), - {ok, pubkey_pem:decode(Bin)}. - -decode_private_key(KeyInfo) -> - decode_private_key(KeyInfo, no_passwd). - -decode_private_key(KeyInfo = {'RSAPrivateKey', _, _}, Password) -> - DerEncoded = pubkey_pem:decode_key(KeyInfo, Password), - 'OTP-PUB-KEY':decode('RSAPrivateKey', DerEncoded); -decode_private_key(KeyInfo = {'DSAPrivateKey', _, _}, Password) -> - DerEncoded = pubkey_pem:decode_key(KeyInfo, Password), - 'OTP-PUB-KEY':decode('DSAPrivateKey', DerEncoded). diff --git a/lib/public_key/test/Makefile b/lib/public_key/test/Makefile index 6889ae9a8a..b7f91981a5 100644 --- a/lib/public_key/test/Makefile +++ b/lib/public_key/test/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2008-2010. All Rights Reserved. +# Copyright Ericsson AB 2008-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 @@ -30,6 +30,7 @@ INCLUDES= -I. -I ../include MODULES= \ erl_make_certs \ public_key_SUITE \ + pbe_SUITE \ pkits_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/public_key/test/pbe_SUITE.erl b/lib/public_key/test/pbe_SUITE.erl new file mode 100644 index 0000000000..380a67db7b --- /dev/null +++ b/lib/public_key/test/pbe_SUITE.erl @@ -0,0 +1,259 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-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% +%% + +-module(pbe_SUITE). + +-include_lib("test_server/include/test_server.hrl"). +-include_lib("public_key/include/public_key.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). +%% Test server callback functions +%%-------------------------------------------------------------------- +%% Function: init_per_suite(Config) -> Config +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Initialization before the whole suite +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + try crypto:start() of + ok -> + Config + catch _:_ -> + {skip, "Crypto did not start"} + end. +%%-------------------------------------------------------------------- +%% Function: end_per_suite(Config) -> _ +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Cleanup after the whole suite +%%-------------------------------------------------------------------- +end_per_suite(_Config) -> + application:stop(crypto). + +%%-------------------------------------------------------------------- +%% Function: init_per_testcase(TestCase, Config) -> Config +%% Case - atom() +%% Name of the test case that is about to be run. +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% +%% Description: Initialization before each test case +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%% Description: Initialization before each test case +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% Function: end_per_testcase(TestCase, Config) -> _ +%% Case - atom() +%% Name of the test case that is about to be run. +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Cleanup after each test case +%%-------------------------------------------------------------------- +end_per_testcase(_TestCase, _Config) -> + ok. + +%%-------------------------------------------------------------------- +%% Function: all(Clause) -> TestCases +%% Clause - atom() - suite | doc +%% TestCases - [Case] +%% Case - atom() +%% Name of a test case. +%% Description: Returns a list of all test cases in this test suite +%%-------------------------------------------------------------------- +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + pbdkdf1, + pbdkdf2, + encrypted_private_key_info]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +%% Test cases starts here. +%%-------------------------------------------------------------------- +pbdkdf1(doc) -> + ["Test with PKCS #5 PBKDF1 Test Vectors"]; +pbdkdf1(Config) when is_list(Config) -> + %%Password = "password" + %% = (0x)70617373776F7264 + %%Salt = (0x)78578E5A5D63CB06 + %%Count = 1000 + %%kLen = 16 + %%Key = PBKDF1(Password, Salt, Count, kLen) + %%= (0x)DC19847E05C64D2FAF10EBFB4A3D2A20 + + Password = "password", + Salt = <<16#78,16#57,16#8E,16#5A,16#5D,16#63,16#CB,16#06>>, + Count = 1000, + + <<16#DC, 16#19, 16#84, 16#7E, + 16#05, 16#C6, 16#4D, 16#2F, + 16#AF, 16#10, 16#EB, 16#FB, + 16#4A, 16#3D, 16#2A, 16#20, _/binary>> = + pubkey_pbe:pbdkdf1(Password, Salt, Count, sha). + +pbdkdf2(doc) -> + ["Test with PKCS #5 PBKDF2 Test Vectors"]; +pbdkdf2(Config) when is_list(Config) -> + %% Input: + %% P = "password" (8 octets) + %% S = "salt" (4 octets) + %% c = 1 + %% dkLen = 20 + + %% Output: + %% DK = 0c 60 c8 0f 96 1f 0e 71 + %% f3 a9 b5 24 af 60 12 06 + %% 2f e0 37 a6 (20 octets) + + <<16#0c, 16#60, 16#c8, 16#0f, 16#96, 16#1f, 16#0e, 16#71, + 16#f3, 16#a9, 16#b5, 16#24, 16#af, 16#60, 16#12, 16#06, + 16#2f, 16#e0, 16#37, 16#a6>> = pubkey_pbe:pbdkdf2("password", "salt", 1, 20, fun crypto:sha_mac/3, 20), + + %% Input: + %% P = "password" (8 octets) + %% S = "salt" (4 octets) + %% c = 2 + %% dkLen = 20 + + %% Output: + %% DK = ea 6c 01 4d c7 2d 6f 8c + %% cd 1e d9 2a ce 1d 41 f0 + %% d8 de 89 57 (20 octets) + + <<16#ea, 16#6c, 16#01, 16#4d, 16#c7, 16#2d, 16#6f, 16#8c, + 16#cd, 16#1e, 16#d9, 16#2a, 16#ce, 16#1d, 16#41, 16#f0, + 16#d8, 16#de, 16#89, 16#57>> = + pubkey_pbe:pbdkdf2("password", "salt", 2, 20, fun crypto:sha_mac/3, 20), + + %% Input: + %% P = "password" (8 octets) + %% S = "salt" (4 octets) + %% c = 4096 + %% dkLen = 20 + + %% Output: + %% DK = 4b 00 79 01 b7 65 48 9a + %% be ad 49 d9 26 f7 21 d0 + %% 65 a4 29 c1 (20 octets) + + <<16#4b, 16#00, 16#79, 16#01, 16#b7, 16#65, 16#48, 16#9a, + 16#be, 16#ad, 16#49, 16#d9, 16#26, 16#f7, 16#21, 16#d0, + 16#65, 16#a4, 16#29, 16#c1>> = pubkey_pbe:pbdkdf2("password", "salt", 4096, 20, fun crypto:sha_mac/3, 20), + + %% Input: + %% P = "password" (8 octets) + %% S = "salt" (4 octets) + %% c = 16777216 + %% dkLen = 20 + + %% Output: + %% DK = ee fe 3d 61 cd 4d a4 e4 + %% e9 94 5b 3d 6b a2 15 8c + %% 26 34 e9 84 (20 octets) + + + <<16#ee, 16#fe, 16#3d, 16#61, 16#cd, 16#4d, 16#a4, 16#e4, + 16#e9, 16#94, 16#5b, 16#3d, 16#6b, 16#a2, 16#15, 16#8c, + 16#26, 16#34, 16#e9, 16#84>> = pubkey_pbe:pbdkdf2("password", "salt", 16777216, 20, fun crypto:sha_mac/3, 20), + + %% Input: + %% P = "passwordPASSWORDpassword" (24 octets) + %% S = "saltSALTsaltSALTsaltSALTsaltSALTsalt" (36 octets) + %% c = 4096 + %% dkLen = 25 + + %% Output: + %% DK = 3d 2e ec 4f e4 1c 84 9b + %% 80 c8 d8 36 62 c0 e4 4a + %% 8b 29 1a 96 4c f2 f0 70 + %% 38 (25 octets) + + <<16#3d, 16#2e, 16#ec, 16#4f, 16#e4, 16#1c, 16#84, 16#9b, + 16#80, 16#c8, 16#d8, 16#36, 16#62, 16#c0, 16#e4, 16#4a, + 16#8b, 16#29, 16#1a, 16#96, 16#4c, 16#f2, 16#f0, 16#70, + 16#38>> + = pubkey_pbe:pbdkdf2("passwordPASSWORDpassword", + "saltSALTsaltSALTsaltSALTsaltSALTsalt", 4096, 25, fun crypto:sha_mac/3, 20), + + %% Input: + %% P = "pass\0word" (9 octets) + %% S = "sa\0lt" (5 octets) + %% c = 4096 + %% dkLen = 16 + + %% Output: + %% DK = 56 fa 6a a7 55 48 09 9d + %% cc 37 d7 f0 34 25 e0 c3 (16 octets) + + <<16#56, 16#fa, 16#6a, 16#a7, 16#55, 16#48, 16#09, 16#9d, + 16#cc, 16#37, 16#d7, 16#f0, 16#34, 16#25, 16#e0, 16#c3>> + = pubkey_pbe:pbdkdf2("pass\0word", + "sa\0lt", 4096, 16, fun crypto:sha_mac/3, 20). + +encrypted_private_key_info(doc) -> + ["Tests reading a EncryptedPrivateKeyInfo file encrypted with different ciphers"]; +encrypted_private_key_info(Config) when is_list(Config) -> + Datadir = ?config(data_dir, Config), + {ok, PemDes} = file:read_file(filename:join(Datadir, "des_cbc_enc_key.pem")), + + PemDesEntry = public_key:pem_decode(PemDes), + test_server:format("Pem entry: ~p" , [PemDesEntry]), + [{'PrivateKeyInfo', _, {"DES-CBC",_}} = PubEntry0] = PemDesEntry, + KeyInfo = public_key:pem_entry_decode(PubEntry0, "password"), + + {ok, Pem3Des} = file:read_file(filename:join(Datadir, "des_ede3_cbc_enc_key.pem")), + + Pem3DesEntry = public_key:pem_decode(Pem3Des), + test_server:format("Pem entry: ~p" , [Pem3DesEntry]), + [{'PrivateKeyInfo', _, {"DES-EDE3-CBC",_}} = PubEntry1] = Pem3DesEntry, + KeyInfo = public_key:pem_entry_decode(PubEntry1, "password"), + + {ok, PemRc2} = file:read_file(filename:join(Datadir, "rc2_cbc_enc_key.pem")), + + PemRc2Entry = public_key:pem_decode(PemRc2), + test_server:format("Pem entry: ~p" , [PemRc2Entry]), + [{'PrivateKeyInfo', _, {"RC2-CBC",_}} = PubEntry2] = PemRc2Entry, + KeyInfo = public_key:pem_entry_decode(PubEntry2, "password"), + + check_key_info(KeyInfo). + + +check_key_info(#'PrivateKeyInfo'{privateKeyAlgorithm = + #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?rsaEncryption}, + privateKey = Key}) -> + #'RSAPrivateKey'{} = public_key:der_decode('RSAPrivateKey', iolist_to_binary(Key)). diff --git a/lib/public_key/test/pbe_SUITE_data/des_cbc_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/des_cbc_enc_key.pem new file mode 100644 index 0000000000..eaa06145aa --- /dev/null +++ b/lib/public_key/test/pbe_SUITE_data/des_cbc_enc_key.pem @@ -0,0 +1,11 @@ +-----BEGIN ENCRYPTED PRIVATE KEY----- +MIIBozA9BgkqhkiG9w0BBQ0wMDAbBgkqhkiG9w0BBQwwDgQIfWBDXwLp4K4CAggA +MBEGBSsOAwIHBAiaCF/AvOgQ6QSCAWDWX4BdAzCRNSQSANSuNsT5X8mWYO27mr3Y +9c9LoBVXGNmYWKA77MI4967f7SmjNcgXj3xNE/jmnVz6hhsjS8E5VPT3kfyVkpdZ +0lr5e9Yk2m3JWpPU7++v5zBkZmC4V/MwV/XuIs6U+vykgzMgpxQg0oZKS9zgmiZo +f/4dOCL0UtCDnyOSvqT7mCVIcMDIEKu8QbVlgZYBop08l60EuEU3gARUo8WsYQmO +Dz/ldx0Z+znIT0SXVuOwc+RVItC5T/Qx+aijmmpt+9l14nmaGBrEkmuhmtdvU/4v +aptewGRgmjOfD6cqK+zs0O5NrrJ3P/6ZSxXj91CQgrThGfOv72bUncXEMNtc8pks +2jpHFjGMdKufnadAD7XuMgzkkaklEXZ4f5tU6heIIwr51g0GBEGF96gYPFnjnSQM +75JE02Clo+DfcfXpcybPTwwFg2jd6JTTOfkdf6OdSlA/1XNK43FA +-----END ENCRYPTED PRIVATE KEY----- diff --git a/lib/public_key/test/pbe_SUITE_data/des_ede3_cbc_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/des_ede3_cbc_enc_key.pem new file mode 100644 index 0000000000..22ea46d56f --- /dev/null +++ b/lib/public_key/test/pbe_SUITE_data/des_ede3_cbc_enc_key.pem @@ -0,0 +1,11 @@ +-----BEGIN ENCRYPTED PRIVATE KEY----- +MIIBpjBABgkqhkiG9w0BBQ0wMzAbBgkqhkiG9w0BBQwwDgQIeFeOWl1jywYCAggA +MBQGCCqGSIb3DQMHBAjUJ5eGBhQGtQSCAWBrHrRgqO8UUMLcWzZEtpk1l3mjxiF/ +koCMkHsFwowgyWhEbgIkTgbSViK54LVK8PskekcGNLph+rB6bGZ7pPbL5pbXASJ8 ++MkQcG3FZdlS4Ek9tTJDApj3O1UubZGFG4uvTlJJFbF1BOJ3MkY3XQ9Gl1qwv7j5 +6e103Da7Cq9+oIDKmznza78XXQYrUsPo8mJGjUxPskEYlzwvHjKubRnYm/K6RKhi +5f4zX4BQ/Dt3H812ZjRXrsjAJP0KrD/jyD/jCT7zNBVPH1izBds+RwizyQAHwfNJ +BFR78TH4cgzB619X47FDVOnT0LqQNVd0O3cSwnPrXE9XR3tPayE+iOB15llFSmi8 +z0ByOXldEpkezCn92Umk++suzIVj1qfsK+bv2phZWJPbLEIWPDRHUbYf76q5ArAr +u4xtxT/hoK3krEs/IN3d70qjlUJ36SEw1UaZ82PWhakQbdtu39ZraMJB +-----END ENCRYPTED PRIVATE KEY----- diff --git a/lib/public_key/test/pbe_SUITE_data/rc2_cbc_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/rc2_cbc_enc_key.pem new file mode 100644 index 0000000000..618cddcfd7 --- /dev/null +++ b/lib/public_key/test/pbe_SUITE_data/rc2_cbc_enc_key.pem @@ -0,0 +1,12 @@ +-----BEGIN ENCRYPTED PRIVATE KEY----- +MIIBrjBIBgkqhkiG9w0BBQ0wOzAeBgkqhkiG9w0BBQwwEQQIrHyQPBZqWLUCAggA +AgEQMBkGCCqGSIb3DQMCMA0CAToECEhbh7YZKiPSBIIBYCT1zp6o5jpFlIkgwPop +7bW1+8ACr4exqzkeb3WflQ8cWJ4cURxzVdvxUnXeW1VJdaQZtjS/QHs5GhPTG/0f +wtvnaPfwrIJ3FeGaZfcg2CrYhalOFmEb4xrE4KyoEQmUN8tb/Cg94uzd16BOPw21 +RDnE8bnPdIGY7TyL95kbkqH23mK53pi7h+xWIgduW+atIqDyyt55f7WMZcvDvlj6 +VpN/V0h+qxBHL274WA4dj6GYgeyUFpi60HdGCK7By2TBy8h1ZvKGjmB9h8jZvkx1 +MkbRumXxyFsowTZawyYvO8Um6lbfEDP9zIEUq0IV8RqH2MRyblsPNSikyYhxX/cz +tdDxRKhilySbSBg5Kr8OfcwKp9bpinN96nmG4xr3Tch1bnVvqJzOQ5+Vva2WwVvH +2JkWvYm5WaANg4Q6bRxu9vz7DuhbJjQdZbxFezIAgrJdSe92B00jO/0Kny1WjiVO +6DA= +-----END ENCRYPTED PRIVATE KEY----- diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl index b11e4d092a..a91dcfa029 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -23,8 +23,8 @@ %% Note: This directive should only be used in test suites. -compile(export_all). --include_lib("common_test/include/ct.hrl"). --include_lib("test_server/include/test_server_line.hrl"). +%%-include_lib("common_test/include/ct.hrl"). +-include_lib("test_server/include/test_server.hrl"). -include_lib("public_key/include/public_key.hrl"). @@ -107,7 +107,7 @@ all() -> {group, ssh_public_key_decode_encode}, encrypt_decrypt, {group, sign_verify}, - pkix, pkix_path_validation, deprecated]. + pkix, pkix_path_validation]. groups() -> [{pem_decode_encode, [], [dsa_pem, rsa_pem, encrypted_pem, @@ -699,27 +699,6 @@ pkix_path_validation(Config) when is_list(Config) -> VerifyFunAndState1}]), ok. -%%-------------------------------------------------------------------- -deprecated(doc) -> - ["Check deprecated functions."]; -deprecated(suite) -> - []; -deprecated(Config) when is_list(Config) -> - Datadir = ?config(data_dir, Config), - {ok, [DsaKey = {'DSAPrivateKey', _DsaKey, _}]} = - public_key:pem_to_der(filename:join(Datadir, "dsa.pem")), - {ok, [RsaKey = {'RSAPrivateKey', _RsaKey,_}]} = - public_key:pem_to_der(filename:join(Datadir, "client_key.pem")), - {ok, [ProtectedRsaKey = {'RSAPrivateKey', _ProtectedRsaKey,_}]} = - public_key:pem_to_der(filename:join(Datadir, "rsa.pem")), - - {ok, #'DSAPrivateKey'{}} = public_key:decode_private_key(DsaKey), - {ok, #'RSAPrivateKey'{}} = public_key:decode_private_key(RsaKey), - {ok, #'RSAPrivateKey'{}} = public_key:decode_private_key(ProtectedRsaKey, "abcd1234"), - ok. - -%%-------------------------------------------------------------------- - check_entry_type(#'DSAPrivateKey'{}, 'DSAPrivateKey') -> true; check_entry_type(#'RSAPrivateKey'{}, 'RSAPrivateKey') -> diff --git a/lib/reltool/doc/src/make.dep b/lib/reltool/doc/src/make.dep deleted file mode 100644 index 59e77e8162..0000000000 --- a/lib/reltool/doc/src/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex ref_man.tex reltool.tex \ - reltool_examples.tex reltool_intro.tex reltool_usage.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/runtime_tools/c_src/Makefile.in b/lib/runtime_tools/c_src/Makefile.in index 840de39f07..73ab6cdc11 100644 --- a/lib/runtime_tools/c_src/Makefile.in +++ b/lib/runtime_tools/c_src/Makefile.in @@ -89,42 +89,31 @@ endif # Targets # ---------------------------------------------------- -debug opt: $(OBJDIR) $(BINDIR) $(SOLIBS) +_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) -$(OBJDIR): - -@mkdir -p $(OBJDIR) - -$(BINDIR): - -@mkdir -p $(BINDIR) +debug opt: $(SOLIBS) $(OBJDIR)/%.o: %.c - $(INSTALL_DIR) $(OBJDIR) $(CC) -c -o $@ $(ALL_CFLAGS) $< $(LIBDIR)/trace_ip_drv.so: $(TRACE_IP_DRV_OBJS) - $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $^ -lc $(LIBS) $(LIBDIR)/trace_file_drv.so: $(TRACE_FILE_DRV_OBJS) - $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $^ -lc $(LIBS) $(LIBDIR)/trace_ip_drv.dll: $(TRACE_IP_DRV_OBJS) - $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $^ $(LIBS) $(LIBDIR)/trace_file_drv.dll: $(TRACE_FILE_DRV_OBJS) - $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $^ $(LIBS) # # VxWorks is simply to different from Unix in this sense. # Here are the inference rules for VxWorks # $(LIBDIR)/trace_ip_drv.eld: $(TRACE_IP_DRV_OBJS) - $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $^ $(LIBDIR)/trace_file_drv.eld: $(TRACE_FILE_DRV_OBJS) - $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $^ clean: diff --git a/lib/runtime_tools/doc/src/dbg.xml b/lib/runtime_tools/doc/src/dbg.xml index f26789fa21..c7c5cd4ff0 100644 --- a/lib/runtime_tools/doc/src/dbg.xml +++ b/lib/runtime_tools/doc/src/dbg.xml @@ -316,7 +316,8 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard) c <v>Module = atom() | '_'</v> <v>Function = atom() | '_'</v> <v>Arity = integer() |'_'</v> - <v>MatchSpec = integer() | atom() | [] | match_spec()</v> + <v>MatchSpec = integer() | Built-inAlias | [] | match_spec()</v> + <v>Built-inAlias = x | c | cx</v> <v>MatchDesc = [MatchInfo]</v> <v>MatchInfo = {saved, integer()} | MatchNum</v> <v>MatchNum = {matched, node(), integer()} | {matched, node(), 0, RPCError}</v> @@ -349,8 +350,9 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard) c if the MatchSpec is other than []. The integer <c>N</c> may then be used in subsequent calls to this function and will stand as an - "alias" for the given expression. There are also built-in - aliases named with atoms (see also <c>ltp/0</c> below).</p> + "alias" for the given expression. There are also a couple of + built-in aliases for common expressions, see <c>ltp/0</c> below + for details.</p> <p>If an error is returned, it can be due to errors in compilation of the match specification. Such errors are presented as a list of tuples <c>{error, string()}</c> where @@ -528,6 +530,21 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard) c <p>Match specifications used can be saved in a file (if a read-write file system is present) for use in later debugging sessions, see <c>wtp/1</c> and <c>rtp/1</c></p> + <p>There are three built-in trace patterns: + <c>exception_trace</c>, <c>caller_trace</c> + and <c>caller_exception_trace</c> (or <c>x</c>, <c>c</c> and + <c>cx</c> respectively). + Exception trace sets a trace which will show function names, + parameters, return values and exceptions thrown from functions. + Caller traces display function names, parameters and information + about which function called it. An example using a built-in alias:</p> + <pre> +(x@y)4> <input>dbg:tp(lists,sort,cx).</input> +{ok,[{matched,nonode@nohost,2},{saved,cx}]} +(x@y)4> <input>lists:sort([2,1]).</input> +(<0.32.0>) call lists:sort([2,1]) ({erl_eval,do_apply,5}) +(<0.32.0>) returned from lists:sort/1 -> [1,2] +[1,2]</pre> </desc> </func> <func> diff --git a/lib/runtime_tools/doc/src/make.dep b/lib/runtime_tools/doc/src/make.dep deleted file mode 100644 index 85eae88adf..0000000000 --- a/lib/runtime_tools/doc/src/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex dbg.tex erts_alloc_config.tex refman.tex \ - runtime_tools_app.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: refman.xml - diff --git a/lib/runtime_tools/src/Makefile b/lib/runtime_tools/src/Makefile index 4f831f3dd8..46b570210a 100644 --- a/lib/runtime_tools/src/Makefile +++ b/lib/runtime_tools/src/Makefile @@ -46,7 +46,8 @@ MODULES= \ runtime_tools_sup \ dbg \ percept_profile \ - observer_backend + observer_backend \ + ttb_autostart HRL_FILES= ../include/observer_backend.hrl ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl index 56283f4d3d..385047ee73 100644 --- a/lib/runtime_tools/src/dbg.erl +++ b/lib/runtime_tools/src/dbg.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -32,7 +32,7 @@ -export([fun2ms/1]). %% Local exports --export([erlang_trace/3,get_info/0]). +-export([erlang_trace/3,get_info/0,deliver_and_flush/1]). %% Debug exports -export([wrap_presort/2, wrap_sort/2, wrap_postsort/1, wrap_sortfix/2, @@ -348,17 +348,16 @@ trace_port_control(Operation) -> trace_port_control(node(), Operation). trace_port_control(Node, flush) -> - Ref = erlang:trace_delivered(all), - receive - {trace_delivered,all,Ref} -> ok - end, - case trace_port_control(Node, $f, "") of - {ok, [0]} -> - ok; - {ok, _} -> - {error, not_supported_by_trace_driver}; - Other -> - Other + case get_tracer(Node) of + {ok, Port} when is_port(Port) -> + case catch rpc:call(Node,?MODULE,deliver_and_flush,[Port]) of + [0] -> + ok; + _ -> + {error, not_supported_by_trace_driver} + end; + _ -> + {error, no_trace_driver} end; trace_port_control(Node,get_listen_port) -> case trace_port_control(Node,$p, "") of @@ -378,7 +377,14 @@ trace_port_control(Node, Command, Arg) -> {error, no_trace_driver} end. - +%% A bit more than just flush - it also makes sure all trace messages +%% are delivered first, before flushing the driver. +deliver_and_flush(Port) -> + Ref = erlang:trace_delivered(all), + receive + {trace_delivered,all,Ref} -> ok + end, + erlang:port_control(Port, $f, ""). trace_port(file, {Filename, wrap, Tail}) -> @@ -684,18 +690,12 @@ loop({C,T}=SurviveLinks, Table) -> %% tracing on the node it removes from the list of active trace nodes, %% we will call erlang:trace_delivered/1 on ALL nodes that we have %% connections to. - Delivered = fun() -> - Ref = erlang:trace_delivered(all), - receive - {trace_delivered,all,Ref} -> ok - end - end, - catch rpc:multicall(nodes(), erlang, apply, [Delivered,[]]), - Ref = erlang:trace_delivered(all), - receive - {trace_delivered,all,Ref} -> - exit(done) - end; + %% If it is a file trace driver, we will also flush the port. + lists:foreach(fun({Node,{_Relay,Port}}) -> + rpc:call(Node,?MODULE,deliver_and_flush,[Port]) + end, + get()), + exit(done); {From, {link_to, Pid}} -> case (catch link(Pid)) of {'EXIT', Reason} -> @@ -1449,6 +1449,19 @@ new_pattern_table() -> ets:insert(PT, {exception_trace, term_to_binary(x)}), + ets:insert(PT, + {c, + term_to_binary([{'_',[],[{message,{caller}}]}])}), + ets:insert(PT, + {caller_trace, + term_to_binary(c)}), + ets:insert(PT, + {cx, + term_to_binary([{'_',[],[{exception_trace}, + {message,{caller}}]}])}), + ets:insert(PT, + {caller_exception_trace, + term_to_binary(cx)}), PT. diff --git a/lib/runtime_tools/src/erts_alloc_config.erl b/lib/runtime_tools/src/erts_alloc_config.erl index 0bcb202fd8..1a57c94443 100644 --- a/lib/runtime_tools/src/erts_alloc_config.erl +++ b/lib/runtime_tools/src/erts_alloc_config.erl @@ -1,6 +1,7 @@ +%% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2010. 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 @@ -16,6 +17,7 @@ %% The Initial Developer of the Original Code is Ericsson AB. %% %% %CopyrightEnd% +%% %%%------------------------------------------------------------------- %%% File : erts_alloc_config.erl @@ -71,6 +73,7 @@ A == binary_alloc; A == std_alloc; A == ets_alloc; + A == fix_alloc; A == eheap_alloc; A == ll_alloc; A == sl_alloc; @@ -94,6 +97,7 @@ [{binary_alloc, 131072}, {std_alloc, 131072}, {ets_alloc, 131072}, + {fix_alloc, 131072}, {eheap_alloc, 524288}, {ll_alloc, 2097152}, {sl_alloc, 131072}, @@ -104,6 +108,7 @@ [{binary_alloc, 10}, {std_alloc, 10}, {ets_alloc, 10}, + {fix_alloc, 10}, {eheap_alloc, 10}, {ll_alloc, 0}, {sl_alloc, 10}, @@ -438,9 +443,6 @@ conf_alloc(#conf{format_to = FTO} = Conf, #alloc{name = A} = Alc) -> chk_xnote(Conf, Alc). chk_xnote(#conf{format_to = FTO}, - #alloc{name = fix_alloc}) -> - fcp(FTO, "Cannot be configured."); -chk_xnote(#conf{format_to = FTO}, #alloc{name = sys_alloc}) -> fcp(FTO, "Cannot be configured. Default malloc implementation used."); chk_xnote(#conf{format_to = FTO}, diff --git a/lib/runtime_tools/src/inviso_rt.erl b/lib/runtime_tools/src/inviso_rt.erl index ac7ac2a584..b162f5b045 100644 --- a/lib/runtime_tools/src/inviso_rt.erl +++ b/lib/runtime_tools/src/inviso_rt.erl @@ -2359,8 +2359,8 @@ list_wrapset(Prefix,Suffix) -> list_wrapset_2([File|Rest],RegExp) -> Length=length(File), - case regexp:first_match(File,RegExp) of - {match,1,Length} -> % This is a member of the set. + case re:run(File,RegExp) of + {match,[{0,Length}]} -> % This is a member of the set. [File|list_wrapset_2(Rest,RegExp)]; _ -> list_wrapset_2(Rest,RegExp) diff --git a/lib/runtime_tools/src/inviso_rt_lib.erl b/lib/runtime_tools/src/inviso_rt_lib.erl index 2c6964e53e..ee6a72ae0c 100644 --- a/lib/runtime_tools/src/inviso_rt_lib.erl +++ b/lib/runtime_tools/src/inviso_rt_lib.erl @@ -197,15 +197,15 @@ match_modules(RegExpDir,RegExpMod,Actions) -> handle_expand_regexp_2([{Mod,Path}|Rest],RegExpDir,RegExpMod,Result) -> ModStr=atom_to_list(Mod), ModLen=length(ModStr), - case regexp:first_match(ModStr,RegExpMod) of - {match,1,ModLen} -> % Ok, The regexp matches the module. + case re:run(ModStr,RegExpMod) of + {match,[{0,ModLen}]} -> % Ok, The regexp matches the module. if is_list(RegExpDir),is_atom(Path) -> % Preloaded or covercompiled... handle_expand_regexp_2(Rest,RegExpDir,RegExpMod,Result); is_list(RegExpDir),is_list(Path) -> % Dir reg-exp is used! PathOnly=filename:dirname(Path), % Must remove beam-file name. - case regexp:first_match(PathOnly,RegExpDir) of - {match,_,_} -> % Did find a match, that is enough! + case re:run(PathOnly,RegExpDir,[{capture,none}]) of + match -> % Did find a match, that is enough! handle_expand_regexp_2(Rest,RegExpDir,RegExpMod,[Mod|Result]); _ -> % Either error or nomatch. handle_expand_regexp_2(Rest,RegExpDir,RegExpMod,Result) @@ -233,8 +233,8 @@ handle_expand_regexp_3([Path|Rest],RegExpDir,RegExpMod,AllLoaded,Result) -> volumerelative -> % Only on Windows!? filename:absname(Path) end, - case regexp:first_match(AbsPath,RegExpDir) of - {match,_,_} -> % Ok, the directory is allowed. + case re:run(AbsPath,RegExpDir,[{capture,none}]) of + match -> % Ok, the directory is allowed. NewResult=handle_expand_regexp_3_1(Path,RegExpMod,AllLoaded,Result), handle_expand_regexp_3(Rest,RegExpDir,RegExpMod,AllLoaded,NewResult); _ -> % This directory does not qualify. @@ -262,8 +262,8 @@ handle_expand_regexp_3_2([File|Rest],RegExpMod,AllLoaded,Result) -> case {lists:keysearch(Mod,1,AllLoaded),lists:member(Mod,Result)} of {false,false} -> % This module is not tried before. ModLen=length(ModStr), - case regexp:first_match(ModStr,RegExpMod) of - {match,1,ModLen} -> % This module satisfies the regexp. + case re:run(ModStr,RegExpMod) of + {match,[{0,ModLen}]} -> % This module satisfies the regexp. handle_expand_regexp_3_2(Rest,RegExpMod,AllLoaded,[Mod|Result]); _ -> % Error or not perfect match. handle_expand_regexp_3_2(Rest,RegExpMod,AllLoaded,Result) diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index 0f428de07a..9c1f9da5b1 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -31,6 +31,7 @@ ttb_write_binary/2, ttb_stop/1, ttb_fetch/2, + ttb_resume_trace/0, ttb_get_filenames/1]). -define(CHUNKSIZE,8191). % 8 kbytes - 1 byte @@ -92,16 +93,22 @@ etop_collect([], Acc) -> Acc. %% %% ttb backend %% -ttb_init_node(MetaFile,PI,Traci) -> +ttb_init_node(MetaFile_0,PI,Traci) -> if - is_list(MetaFile); - is_atom(MetaFile) -> + is_list(MetaFile_0); + is_atom(MetaFile_0) -> + {ok, Cwd} = file:get_cwd(), + MetaFile = filename:join(Cwd, MetaFile_0), file:delete(MetaFile); true -> % {local,_,_} - ok + MetaFile = MetaFile_0 + end, + case proplists:get_value(resume, Traci) of + {true, _} -> (autostart_module()):write_config(Traci); + _ -> ok end, Self = self(), - MetaPid = spawn(fun() -> ttb_meta_tracer(MetaFile,PI,Self) end), + MetaPid = spawn(fun() -> ttb_meta_tracer(MetaFile,PI,Self,Traci) end), receive {MetaPid,started} -> ok end, MetaPid ! {metadata,Traci}, case PI of @@ -111,13 +118,14 @@ ttb_init_node(MetaFile,PI,Traci) -> false -> ok end, - {ok,MetaPid}. + {ok,MetaFile,MetaPid}. ttb_write_trace_info(MetaPid,Key,What) -> MetaPid ! {metadata,Key,What}, ok. -ttb_meta_tracer(MetaFile,PI,Parent) -> +ttb_meta_tracer(MetaFile,PI,Parent,SessionData) -> + erlang:monitor(process, proplists:get_value(ttb_control, SessionData)), case PI of true -> ReturnMS = [{'_',[],[{return_trace}]}], @@ -130,22 +138,29 @@ ttb_meta_tracer(MetaFile,PI,Parent) -> ok end, Parent ! {self(),started}, - ttb_meta_tracer_loop(MetaFile,PI,dict:new()). + case proplists:get_value(overload_check, SessionData) of + {Ms, M, F} -> + catch M:F(init), + erlang:send_after(Ms, self(), overload_check); + _ -> + ok + end, + ttb_meta_tracer_loop(MetaFile,PI,dict:new(),SessionData). -ttb_meta_tracer_loop(MetaFile,PI,Acc) -> +ttb_meta_tracer_loop(MetaFile,PI,Acc,State) -> receive {trace_ts,_,call,{erlang,register,[Name,Pid]},_} -> ttb_store_meta({pid,{Pid,Name}},MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {trace_ts,_,call,{global,register_name,[Name,Pid]},_} -> ttb_store_meta({pid,{Pid,{global,Name}}},MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {trace_ts,CallingPid,call,{erlang,spawn_opt,[{M,F,Args,_}]},_} -> MFA = {M,F,length(Args)}, NewAcc = dict:update(CallingPid, fun(Old) -> [MFA|Old] end, [MFA], Acc), - ttb_meta_tracer_loop(MetaFile,PI,NewAcc); + ttb_meta_tracer_loop(MetaFile,PI,NewAcc,State); {trace_ts,CallingPid,return_from,{erlang,spawn_opt,_Arity},Ret,_} -> case Ret of {NewPid,_Mref} when is_pid(NewPid) -> ok; @@ -158,14 +173,14 @@ ttb_meta_tracer_loop(MetaFile,PI,Acc) -> T end, Acc), - ttb_meta_tracer_loop(MetaFile,PI,NewAcc); + ttb_meta_tracer_loop(MetaFile,PI,NewAcc,State); {trace_ts,CallingPid,call,{erlang,Spawn,[M,F,Args]},_} when Spawn==spawn;Spawn==spawn_link -> MFA = {M,F,length(Args)}, NewAcc = dict:update(CallingPid, fun(Old) -> [MFA|Old] end, [MFA], Acc), - ttb_meta_tracer_loop(MetaFile,PI,NewAcc); + ttb_meta_tracer_loop(MetaFile,PI,NewAcc,State); {trace_ts,CallingPid,return_from,{erlang,Spawn,_Arity},NewPid,_} when Spawn==spawn;Spawn==spawn_link -> @@ -176,28 +191,53 @@ ttb_meta_tracer_loop(MetaFile,PI,Acc) -> T end, Acc), - ttb_meta_tracer_loop(MetaFile,PI,NewAcc); + ttb_meta_tracer_loop(MetaFile,PI,NewAcc,State); {metadata,Data} when is_list(Data) -> ttb_store_meta(Data,MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {metadata,Key,Fun} when is_function(Fun) -> ttb_store_meta([{Key,Fun()}],MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {metadata,Key,What} -> ttb_store_meta([{Key,What}],MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); - - stop when PI=:=true -> - erlang:trace_pattern({erlang,spawn,3},false,[meta]), + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); + overload_check -> + {Ms, M, F} = proplists:get_value(overload_check, State), + case catch M:F(check) of + true -> + erlang:trace(all, false, [all]), + ControlPid = proplists:get_value(ttb_control, State), + ControlPid ! {node_overloaded, node()}, + catch M:F(stop), + ttb_meta_tracer_loop(MetaFile,PI,Acc,lists:keydelete(overload_check, 1, State)); + _ -> + erlang:send_after(Ms, self(), overload_check), + ttb_meta_tracer_loop(MetaFile,PI,Acc, State) + end; + {'DOWN', _, _, _, _} -> + stop_seq_trace(), + self() ! stop, + ttb_meta_tracer_loop(MetaFile,PI,Acc, State); + stop when PI=:=true -> + try_stop_resume(State), + try_stop_overload_check(State), + erlang:trace_pattern({erlang,spawn,3},false,[meta]), erlang:trace_pattern({erlang,spawn_link,3},false,[meta]), erlang:trace_pattern({erlang,spawn_opt,1},false,[meta]), erlang:trace_pattern({erlang,register,2},false,[meta]), erlang:trace_pattern({global,register_name,2},false,[meta]); stop -> - ok + try_stop_resume(State), + try_stop_overload_check(State) + end. + +try_stop_overload_check(State) -> + case proplists:get_value(overload, State) of + undefined -> ok; + {_, M, F} -> catch M:F(stop) end. pnames() -> @@ -222,6 +262,40 @@ pinfo(P,Globals) -> undefined -> [] % the process has terminated end. +autostart_module() -> + element(2, application:get_env(runtime_tools, ttb_autostart_module)). + +try_stop_resume(State) -> + case proplists:get_value(resume, State) of + true -> (autostart_module()):delete_config(); + _ -> ok + end. + +ttb_resume_trace() -> + case (autostart_module()):read_config() of + {error, _} -> + ok; + {ok, Data} -> + Pid = proplists:get_value(ttb_control, Data), + {_, Timeout} = proplists:get_value(resume, Data), + case rpc:call(node(Pid), erlang, whereis, [ttb]) of + Pid -> + Pid ! {noderesumed, node(), self()}, + wait_for_fetch_ready(Timeout); + _ -> + ok + end, + (autostart_module()):delete_config(), + ok + end. + +wait_for_fetch_ready(Timeout) -> + receive + trace_resumed -> + ok + after Timeout -> + ok + end. ttb_store_meta(Data,{local,MetaFile,Port}) when is_list(Data) -> ttb_send_to_port(Port,MetaFile,Data); @@ -273,6 +347,9 @@ ttb_stop(MetaPid) -> %% returns, and then the Port (in {local,MetaFile,Port}) %% cannot be accessed any more. receive {'DOWN', Ref, process, MetaPid, _Info} -> ok end, + stop_seq_trace(). + +stop_seq_trace() -> seq_trace:reset_trace(), seq_trace:set_system_tracer(false). @@ -287,7 +364,7 @@ ttb_fetch(MetaFile,{Port,Host}) -> send_files({Sock,Host},[File|Files]) -> {ok,Fd} = file:open(File,[raw,read,binary]), - gen_tcp:send(Sock,<<1,(list_to_binary(File))/binary>>), + gen_tcp:send(Sock,<<1,(list_to_binary(filename:basename(File)))/binary>>), send_chunks(Sock,Fd), file:delete(File), send_files({Sock,Host},Files); diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src index e6dc7a21d4..095567b165 100644 --- a/lib/runtime_tools/src/runtime_tools.app.src +++ b/lib/runtime_tools/src/runtime_tools.app.src @@ -22,7 +22,8 @@ {modules, [dbg,observer_backend,percept_profile, inviso_rt,inviso_rt_lib,inviso_rt_meta, inviso_as_lib,inviso_autostart,inviso_autostart_server, - runtime_tools,runtime_tools_sup,erts_alloc_config]}, + runtime_tools,runtime_tools_sup,erts_alloc_config, + ttb_autostart]}, {registered, [runtime_tools_sup,inviso_rt,inviso_rt_meta]}, {applications, [kernel, stdlib]}, % {env, [{inviso_autostart_mod,your_own_autostart_module}]}, diff --git a/lib/runtime_tools/src/runtime_tools_sup.erl b/lib/runtime_tools/src/runtime_tools_sup.erl index 1a872c355d..4fcb2292d0 100644 --- a/lib/runtime_tools/src/runtime_tools_sup.erl +++ b/lib/runtime_tools/src/runtime_tools_sup.erl @@ -38,6 +38,8 @@ init(AutoModArgs) -> Flags = {one_for_one, 0, 3600}, Children = [{inviso_rt, {inviso_rt, start_link_auto, [AutoModArgs]}, - temporary, 3000, worker, [inviso_rt]}], + temporary, 3000, worker, [inviso_rt]}, + {ttb_autostart, {ttb_autostart, start_link, []}, + temporary, 3000, worker, [ttb_autostart]}], {ok, {Flags, Children}}. %% ----------------------------------------------------------------------------- diff --git a/lib/runtime_tools/src/ttb_autostart.erl b/lib/runtime_tools/src/ttb_autostart.erl new file mode 100644 index 0000000000..4c6971c119 --- /dev/null +++ b/lib/runtime_tools/src/ttb_autostart.erl @@ -0,0 +1,55 @@ +%%%------------------------------------------------------------------- +%%% File : ttb_autostart.erl +%%% Author : Bartłomiej Puzoń <[email protected]> +%%% Description : This supervisor is used to resume ttb tracing +%%% Users are able to provide custom restart modules for *_config, as +%%% file:write/read/delete may not be possible on diskless nodes. +%%% +%%% Created : 31 Jul 2010 by <[email protected]> +%%%------------------------------------------------------------------- +-module(ttb_autostart). + +-behaviour(gen_server). + +%% API +-export([start_link/0, + read_config/0, + write_config/1, + delete_config/0]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-define(DEF_AUTOSTART_MODULE, ?MODULE). +-define(AUTOSTART_FILENAME, "ttb_autostart.bin"). + +start_link() -> + gen_server:start_link(?MODULE, no_args, []). + +delete_config() -> + file:delete(?AUTOSTART_FILENAME). + +read_config() -> + case file:read_file(?AUTOSTART_FILENAME) of + {ok, Data} -> {ok, binary_to_term(Data)}; + Error -> Error + end. + +write_config(Data) -> + file:write_file(?AUTOSTART_FILENAME, term_to_binary(Data)). + +init(no_args) -> + case application:get_env(runtime_tools, ttb_autostart_module) of + {ok, _} -> ok; + undefined -> application:set_env(runtime_tools, ttb_autostart_module, ?DEF_AUTOSTART_MODULE) + end, + observer_backend:ttb_resume_trace(), + %%As the process is not needed any more, it will shut itself down + {ok, no_args, 10000}. + +handle_call(_,_,_) -> {noreply, no_args}. +handle_cast(_,_) -> {noreply, no_args}. +handle_info(timeout,_) -> {stop, normal, no_args}. +terminate(_,_) -> ok. +code_change(_,_,_) -> {ok, no_args}. diff --git a/lib/runtime_tools/test/inviso_SUITE.erl b/lib/runtime_tools/test/inviso_SUITE.erl index 3ae8d34dd6..758867cf45 100644 --- a/lib/runtime_tools/test/inviso_SUITE.erl +++ b/lib/runtime_tools/test/inviso_SUITE.erl @@ -1380,9 +1380,10 @@ fetch_log_dist_trace_2(Config) -> io:format("~p~n",[NodeResults]), CheckFun=fun({N,{complete,[{trace_log,FileResults1},{ti_log,[{ok,TiFile}]}]}}) -> Fun2=fun({ok,File}) -> - {match,1,_}= - regexp:first_match(File, - "^"++"p1"++Name++atom_to_list(N)), + match= + re:run(File, + "^"++"p1"++Name++atom_to_list(N), + [{capture,none}]), true; (_) -> false @@ -1425,8 +1426,8 @@ fetch_log_dist_trace_3(Config) -> CheckFun=fun({N,{ok,[{trace_log,PrivDir2,[F1,F2]},{ti_log,PrivDir2,[F3]}]}})-> PrivDir2=PrivDir, RegExp="^"++Name++atom_to_list(N)++"[0-9]+"++"\.log", - {match,1,_}=regexp:first_match(F1,RegExp), - {match,1,_}=regexp:first_match(F2,RegExp), + match=re:run(F1,RegExp,[{capture,none}]), + match=re:run(F2,RegExp,[{capture,none}]), F3=Name++"_ti_"++atom_to_list(N)++".ti", true; (_) -> @@ -1439,9 +1440,10 @@ fetch_log_dist_trace_3(Config) -> io:format("~p~n",[NodeResults2]), CheckFun2=fun({N,{complete,[{trace_log,FileResults1},{ti_log,[{ok,TiFile}]}]}}) -> Fun2=fun({ok,File}) -> - {match,1,_}= - regexp:first_match(File, - "^"++"p1"++Name++atom_to_list(N)), + match= + re:run(File, + "^"++"p1"++Name++atom_to_list(N), + [{capture,none}]), true; (_) -> false @@ -2649,8 +2651,8 @@ check_on_nodes([],_,_,_,_) -> how_many_files_regexp([],_,N) -> {ok,N}; how_many_files_regexp([FName|Rest],RegExp,N) -> - case regexp:first_match(FName,RegExp) of - {match,1,_} -> + case re:run(FName,RegExp,[{capture,none}]) of + match -> how_many_files_regexp(Rest,RegExp,N+1); nomatch -> how_many_files_regexp(Rest,RegExp,N); diff --git a/lib/sasl/doc/src/make.dep b/lib/sasl/doc/src/make.dep deleted file mode 100644 index 4843b7934a..0000000000 --- a/lib/sasl/doc/src/make.dep +++ /dev/null @@ -1,22 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: alarm_handler.tex appup.tex book.tex error_logging.tex \ - overload.tex part.tex rb.tex ref_man.tex rel.tex \ - release_handler.tex relup.tex sasl_app.tex \ - sasl_intro.tex script.tex systools.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/sasl/test/release_handler_SUITE_data/heart_restart.bat b/lib/sasl/test/release_handler_SUITE_data/heart_restart.bat index ede1ad4ff3..ede1ad4ff3 100755..100644 --- a/lib/sasl/test/release_handler_SUITE_data/heart_restart.bat +++ b/lib/sasl/test/release_handler_SUITE_data/heart_restart.bat diff --git a/lib/snmp/doc/src/Makefile b/lib/snmp/doc/src/Makefile index aa9431477c..df597c8ba7 100644 --- a/lib/snmp/doc/src/Makefile +++ b/lib/snmp/doc/src/Makefile @@ -28,14 +28,6 @@ VSN = $(SNMP_VSN) APPLICATION=snmp # ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - -# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) @@ -88,40 +80,10 @@ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) MAN7_FILES = $(MIB_FILES:$(MIBSDIR)/%.mib=$(MAN7DIR)/%.7) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = \ - $(XML_REF1_FILES:%.xml=%.tex) \ - $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_REF6_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_PART_FILES = $(XML_PART_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = snmp-$(VSN).pdf -TOP_PS_FILE = snmp-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - @echo "building $(TOP_PDF_FILE)" - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - @echo "building $(TOP_PS_FILE)" - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -TOP_HTML_FILES = $(INDEX_TARGET) - -endif - INDEX_FILE = index.html INDEX_SRC = $(INDEX_FILE).src INDEX_TARGET = $(DOCDIR)/$(INDEX_FILE) @@ -141,8 +103,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif # Copy them to ../html $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man ldocs: local_docs $(INDEX_TARGET) @@ -157,47 +117,6 @@ html2: html $(INDEX_TARGET) clean clean_docs: clean_html clean_man clean_pdf rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(TOP_HTML_FILES) gifs - -html2: gifs $(TOP_HTML_FILES) $(HTML_FILES) $(HTML_REF1_FILES) $(HTML_REF3_FILES) $(HTML_REF6_FILES) $(HTML_CHAP_FILES) - -clean: clean_tex clean_html clean_man clean_docs - - -clean_tex: - @echo "cleaning tex:" - rm -f $(TEX_FILES_USERS_GUIDE) - rm -f $(TEX_FILES_REF_MAN) - rm -f $(TEX_PART_FILES) - rm -f $(TEX_FILES_BOOK) - -clean_docs: - @echo "cleaning docs:" - rm -f $(TOP_PDF_FILE) - rm -f $(TOP_PS_FILE) - rm -f core $(LATEX_CLEAN) - - -$(HTML_PART_FILES): notes.xml - -endif - $(INDEX_TARGET): $(INDEX_SRC) ../../vsn.mk # Create top make file sed -e 's;%VSN%;$(VSN);' $< > $@ # inserting version number @@ -250,8 +169,6 @@ $(MAN1DIR)/snmpc.1: snmpc_cmd.xml include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -268,55 +185,13 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELEASE_PATH)/man/man7 $(INSTALL_DATA) $(MAN7DIR)/* $(RELEASE_PATH)/man/man7 -else - - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man1 - $(INSTALL_DATA) $(MAN1_FILES) $(RELEASE_PATH)/man/man1 - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - $(INSTALL_DIR) $(RELEASE_PATH)/man/man6 - $(INSTALL_DATA) $(MAN6_FILES) $(RELEASE_PATH)/man/man6 - $(INSTALL_DIR) $(RELEASE_PATH)/man/man7 - $(INSTALL_DATA) $(MAN7_FILES) $(RELEASE_PATH)/man/man7 - $(INSTALL_DATA) $(TOP_HTML_FILES) \ - $(RELSYSDIR)/doc -endif -endif - -endif - release_spec: -ifdef DOCSUPPORT info: info_xml info_man info_html @echo "MAN1DIR: $(MAN1DIR)" @echo "MAN3DIR: $(MAN3DIR)" @echo "MAN6DIR: $(MAN6DIR)" @echo "MAN7DIR: $(MAN7DIR)" -else -info: info_xml info_man info_html info_tex - @echo "DVI2PS = $(DVI2PS)" - @echo "DVIPS_FLAGS = $(DVIPS_FLAGS)" - @echo "" - @echo "DISTILL = $(DISTILL)" - @echo "DISTILL_FLAGS = $(DISTILL_FLAGS)" -endif info_man: @echo "man files:" @@ -362,14 +237,3 @@ info_html: @echo "HTML_REF3_FILES = $(HTML_REF3_FILES)" @echo "HTML_REF6_FILES = $(HTML_REF6_FILES)" @echo "HTML_CHAP_FILES = $(HTML_CHAP_FILES)" - -info_tex: - @echo "tex files:" - @echo "TEX_FILES_USERS_GUIDE = $(TEX_FILES_USERS_GUIDE)" - @echo "TEX_FILES_REF_MAN = $(TEX_FILES_REF_MAN)" - @echo "TEX_PART_FILES = $(TEX_PART_FILES)" - @echo "TEX_FILES_BOOK = $(TEX_FILES_BOOK)" - -ifndef DOCSUPPORT -include depend.mk -endif diff --git a/lib/snmp/doc/src/depend.mk b/lib/snmp/doc/src/depend.mk deleted file mode 100644 index 20a523dd8c..0000000000 --- a/lib/snmp/doc/src/depend.mk +++ /dev/null @@ -1,83 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %CopyrightBegin% -# -# Copyright Ericsson AB 2004-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% - -$(HTMLDIR)/part_notes.html: \ - part_notes_history.xml \ - part_notes.xml \ - notes_history.xml \ - notes.xml - -$(HTMLDIR)/part.html: \ - part.xml \ - snmp_intro.xml \ - snmp_agent_funct_descr.xml \ - snmp_manager_funct_descr.xml \ - snmp_mib_compiler.xml \ - snmp_config.xml \ - snmp_agent_config_files.xml \ - snmp_manager_config_files.xml \ - snmp_impl_example_agent.xml \ - snmp_impl_example_manager.xml \ - snmp_instr_functions.xml \ - snmp_def_instr_functions.xml \ - snmp_agent_netif.xml \ - snmp_manager_netif.xml \ - snmp_audit_trail_log.xml \ - snmp_advanced_agent.xml \ - snmp_app_a.xml \ - snmp_app_b.xml - -$(HTMLDIR)/ref_man.html: \ - ref_man.xml \ - snmp_app.xml \ - snmp.xml \ - snmpc.xml \ - snmpc_cmd.xml \ - snmpa.xml \ - snmpa_conf.xml \ - snmpa_discovery_handler.xml \ - snmpa_error_report.xml \ - snmpa_error.xml \ - snmpa_error_io.xml \ - snmpa_error_logger.xml \ - snmpa_local_db.xml \ - snmpa_mpd.xml \ - snmpa_network_interface.xml \ - snmpa_network_interface_filter.xml \ - snmpa_notification_delivery_info_receiver.xml \ - snmpa_notification_filter.xml \ - snmpa_supervisor.xml \ - snmp_community_mib.xml \ - snmp_framework_mib.xml \ - snmp_generic.xml \ - snmp_index.xml \ - snmp_notification_mib.xml \ - snmp_pdus.xml \ - snmp_standard_mib.xml \ - snmp_target_mib.xml \ - snmp_user_based_sm_mib.xml \ - snmp_view_based_acm_mib.xml \ - snmpm.xml \ - snmpm_conf.xml \ - snmpm_mpd.xml \ - snmpm_network_interface.xml \ - snmpm_network_interface_filter.xml \ - snmpm_user.xml - - diff --git a/lib/snmp/doc/src/make.dep b/lib/snmp/doc/src/make.dep deleted file mode 100644 index 223e197f25..0000000000 --- a/lib/snmp/doc/src/make.dep +++ /dev/null @@ -1,77 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-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% - -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex ref_man.tex snmp.tex snmp_advanced_agent.tex \ - snmp_agent_config_files.tex snmp_agent_funct_descr.tex \ - snmp_agent_netif.tex snmp_app.tex snmp_app_a.tex \ - snmp_app_b.tex snmp_audit_trail_log.tex \ - snmp_community_mib.tex \ - snmp_config.tex snmp_def_instr_functions.tex \ - snmp_framework_mib.tex snmp_generic.tex \ - snmp_impl_example_agent.tex \ - snmp_impl_example_manager.tex snmp_index.tex \ - snmp_instr_functions.tex snmp_intro.tex \ - snmp_manager_config_files.tex \ - snmp_manager_funct_descr.tex snmp_manager_netif.tex \ - snmp_mib_compiler.tex snmp_notification_mib.tex \ - snmp_pdus.tex snmp_standard_mib.tex snmp_target_mib.tex \ - snmp_user_based_sm_mib.tex snmp_view_based_acm_mib.tex \ - snmpa.tex snmpa_conf.tex snmpa_error.tex snmpa_error_io.tex \ - snmpa_error_logger.tex snmpa_error_report.tex \ - snmpa_local_db.tex snmpa_mpd.tex \ - snmpa_discovery_handler.tex \ - snmpa_network_interface.tex \ - snmpa_network_interface_filter.tex \ - snmpa_notification_delivery_info_receiver.tex \ - snmpa_notification_filter.tex \ - snmpa_supervisor.tex \ - snmpc.tex snmpc_cmd.tex snmpm.tex snmpm_conf.tex snmpm_mpd.tex \ - snmpm_network_interface.tex snmpm_network_interface_filter.tex \ - snmpm_user.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: MIB_mechanism.ps snmp-um-1-image-1.ps snmp-um-1-image-2.ps \ - snmp-um-1-image-3.ps - -book.dvi: snmp_agent_netif_1.ps - -book.dvi: getnext1.ps getnext2.ps getnext3.ps getnext4.ps - -book.dvi: snmp_manager_netif_1.ps - diff --git a/lib/snmp/mibs/Makefile.in b/lib/snmp/mibs/Makefile.in index 3af74eca75..993a67c6f2 100644 --- a/lib/snmp/mibs/Makefile.in +++ b/lib/snmp/mibs/Makefile.in @@ -41,8 +41,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/snmp-$(VSN) # ---------------------------------------------------- # NOTE: -# 1) Order is important; some MIBs include others -# 2) The OTP-REG mib actually belongs to another +# The OTP-REG mib actually belongs to another # application (otp_mibs), and is exported by this # app. But since that app is built later, we have # to built it here in order to be able to build @@ -148,6 +147,35 @@ $(ERL_TOP)/lib/snmp/bin/snmp-v2tov1: $(ERL_TOP)/lib/snmp/bin/snmp-v2tov1.src $(SNMP_BIN_TARGET_DIR)/OTP-REG.bin: $(ERL_TOP)/lib/$(OTP_MIBDIR)/mibs/OTP-REG.mib $(ERLC) -pa $(SNMP_TOOLKIT)/ebin -I $(SNMP_TOOLKIT)/priv/mibs $(SNMP_FLAGS) -o $(SNMP_BIN_TARGET_DIR) $< +# To support parallel make, we'll need explicit dependencies +# to ensure that an imported MIB has been compiled when it's needed. + +$(SNMP_BIN_TARGET_DIR)/STANDARD-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/RFC1213-MIB.bin + +$(SNMP_BIN_TARGET_DIR)/SNMP-TARGET-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/SNMP-FRAMEWORK-MIB.bin + +$(SNMP_BIN_TARGET_DIR)/SNMP-NOTIFICATION-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/SNMP-FRAMEWORK-MIB.bin \ + $(SNMP_BIN_TARGET_DIR)/SNMP-TARGET-MIB.bin + +$(SNMP_BIN_TARGET_DIR)/SNMP-COMMUNITY-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/SNMP-FRAMEWORK-MIB.bin \ + $(SNMP_BIN_TARGET_DIR)/SNMP-TARGET-MIB.bin + +$(SNMP_BIN_TARGET_DIR)/SNMP-USER-BASED-SM-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/SNMP-FRAMEWORK-MIB.bin + +$(SNMP_BIN_TARGET_DIR)/SNMP-VIEW-BASED-ACM-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/SNMP-FRAMEWORK-MIB.bin + +$(SNMP_BIN_TARGET_DIR)/SNMP-USM-AES-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/SNMP-FRAMEWORK-MIB.bin + +$(SNMP_BIN_TARGET_DIR)/OTP-SNMPEA-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/OTP-REG.bin + clean: rm -f $(TARGET_FILES) @@ -185,7 +213,7 @@ info: @echo "VSN = $(VSN)" @echo "RELSYSDIR = $(RELSYSDIR)" -v1/%.mib.v1: %.mib +v1/%.mib.v1: %.mib $(ERL_TOP)/lib/snmp/bin/snmp-v2tov1 $(ERL_TOP)/lib/snmp/bin/snmp-v2tov1 -o $@ $< diff --git a/lib/snmp/src/agent/snmpa_set_lib.erl b/lib/snmp/src/agent/snmpa_set_lib.erl index 191029f6db..00c77a0cdb 100644 --- a/lib/snmp/src/agent/snmpa_set_lib.erl +++ b/lib/snmp/src/agent/snmpa_set_lib.erl @@ -378,15 +378,15 @@ dbg_apply(M,F,A) -> Res end, case Result of - {'EXIT', {undef, [{M, F, A} | _]}} -> + {'EXIT', {undef, [{M, F, A, _} | _]}} -> {'EXIT', {hook_undef, {M, F, A}}}; - {'EXIT', {function_clause, [{M, F, A} | _]}} -> + {'EXIT', {function_clause, [{M, F, A, _} | _]}} -> {'EXIT', {hook_function_clause, {M, F, A}}}; % XXX: Old format for compatibility - {'EXIT', {undef, {M, F, A}}} -> + {'EXIT', {undef, {M, F, A, _}}} -> {'EXIT', {hook_undef, {M, F, A}}}; - {'EXIT', {function_clause, {M, F, A}}} -> + {'EXIT', {function_clause, {M, F, A, _}}} -> {'EXIT', {hook_function_clause, {M, F, A}}}; Result -> diff --git a/lib/snmp/test/Makefile b/lib/snmp/test/Makefile index 5530805bc1..78ffb1c255 100644 --- a/lib/snmp/test/Makefile +++ b/lib/snmp/test/Makefile @@ -220,6 +220,10 @@ appup: make $(MAYBE_ESTOP) +$(SNMP_BIN_TARGET_DIR)/Klas4.bin: $(SNMP_BIN_TARGET_DIR)/Klas3.bin + +$(SNMP_BIN_TARGET_DIR)/SA-MIB.bin: $(SNMP_BIN_TARGET_DIR)/OLD-SNMPEA-MIB.bin + # ---------------------------------------------------- # Release Target # ---------------------------------------------------- diff --git a/lib/snmp/test/snmp_manager_user_old.erl b/lib/snmp/test/snmp_manager_user_old.erl index edffc80dd4..edffc80dd4 100755..100644 --- a/lib/snmp/test/snmp_manager_user_old.erl +++ b/lib/snmp/test/snmp_manager_user_old.erl diff --git a/lib/ssh/doc/src/Makefile b/lib/ssh/doc/src/Makefile index c4d8d9901c..c97c99cf52 100644 --- a/lib/ssh/doc/src/Makefile +++ b/lib/ssh/doc/src/Makefile @@ -29,15 +29,6 @@ VSN=$(SSH_VSN) APPLICATION=ssh # ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - - -ifndef DOCSUPPORT -include make.dep -endif - -# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) @@ -76,33 +67,10 @@ EXTRA_FILES = \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -115,8 +83,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -131,32 +97,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) @@ -168,8 +108,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -179,28 +117,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -endif -endif - -endif release_spec: diff --git a/lib/ssh/doc/src/make.dep b/lib/ssh/doc/src/make.dep deleted file mode 100644 index cfe2f9617b..0000000000 --- a/lib/ssh/doc/src/make.dep +++ /dev/null @@ -1,19 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex ref_man.tex ssh.tex ssh_channel.tex \ - ssh_connection.tex ssh_sftp.tex ssh_sftpd.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml diff --git a/lib/ssh/src/DSS.asn1 b/lib/ssh/src/DSS.asn1 index 77aca3808b..77aca3808b 100755..100644 --- a/lib/ssh/src/DSS.asn1 +++ b/lib/ssh/src/DSS.asn1 diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile index 42880fa80b..e7cf2c6723 100644 --- a/lib/ssh/src/Makefile +++ b/lib/ssh/src/Makefile @@ -127,13 +127,10 @@ $(APP_TARGET): $(APP_SRC) ../vsn.mk $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk sed -e 's;%VSN%;$(VSN);' $< > $@ -%.hrl: %.asn1 - erlc $(ASN_FLAGS) $< +%.erl %.hrl: %.asn1 + $(ERLC) $(ASN_FLAGS) $< -DSS.hrl DSS.erl: DSS.asn1 -PKCS-1.hrl PKCS-1.erl: PKCS-1.asn1 - -$(EBIN)/ssh_file.$(EMULATOR): $(ASN_HRLS) +$(EBIN)/ssh_file.$(EMULATOR) $(EBIN)/ssh_rsa.$(EMULATOR): $(ASN_HRLS) docs: diff --git a/lib/ssh/src/PKCS-1.asn1 b/lib/ssh/src/PKCS-1.asn1 index e7d6b18c63..e7d6b18c63 100755..100644 --- a/lib/ssh/src/PKCS-1.asn1 +++ b/lib/ssh/src/PKCS-1.asn1 diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl index 3f0a06575c..3f0a06575c 100755..100644 --- a/lib/ssh/src/ssh_bits.erl +++ b/lib/ssh/src/ssh_bits.erl diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl index 34d4ff8fc1..34d4ff8fc1 100755..100644 --- a/lib/ssh/src/ssh_connect.hrl +++ b/lib/ssh/src/ssh_connect.hrl diff --git a/lib/ssh/src/ssh_dsa.erl b/lib/ssh/src/ssh_dsa.erl index 1b9a396f0c..1b9a396f0c 100755..100644 --- a/lib/ssh/src/ssh_dsa.erl +++ b/lib/ssh/src/ssh_dsa.erl diff --git a/lib/ssh/src/ssh_file.erl b/lib/ssh/src/ssh_file.erl index 12180f56bb..12180f56bb 100755..100644 --- a/lib/ssh/src/ssh_file.erl +++ b/lib/ssh/src/ssh_file.erl diff --git a/lib/ssh/src/ssh_io.erl b/lib/ssh/src/ssh_io.erl index 915fd63e4f..915fd63e4f 100755..100644 --- a/lib/ssh/src/ssh_io.erl +++ b/lib/ssh/src/ssh_io.erl diff --git a/lib/ssh/src/ssh_math.erl b/lib/ssh/src/ssh_math.erl index 510eb16aa6..510eb16aa6 100755..100644 --- a/lib/ssh/src/ssh_math.erl +++ b/lib/ssh/src/ssh_math.erl diff --git a/lib/ssh/src/ssh_rsa.erl b/lib/ssh/src/ssh_rsa.erl index 91b8285b2e..91b8285b2e 100755..100644 --- a/lib/ssh/src/ssh_rsa.erl +++ b/lib/ssh/src/ssh_rsa.erl diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index f000558100..f000558100 100755..100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl diff --git a/lib/ssh/src/ssh_userauth.hrl b/lib/ssh/src/ssh_userauth.hrl index 8eb2d46ed1..8eb2d46ed1 100755..100644 --- a/lib/ssh/src/ssh_userauth.hrl +++ b/lib/ssh/src/ssh_userauth.hrl diff --git a/lib/ssh/src/ssh_xfer.hrl b/lib/ssh/src/ssh_xfer.hrl index 4a4f1a4291..4a4f1a4291 100755..100644 --- a/lib/ssh/src/ssh_xfer.hrl +++ b/lib/ssh/src/ssh_xfer.hrl diff --git a/lib/ssl/Makefile b/lib/ssl/Makefile index daad7dc3e6..a7a95004a6 100644 --- a/lib/ssl/Makefile +++ b/lib/ssl/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2010. All Rights Reserved. +# Copyright Ericsson AB 1999-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 @@ -25,7 +25,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # Macros # -SUB_DIRECTORIES = src c_src doc/src examples/certs examples/src +SUB_DIRECTORIES = src doc/src examples/certs examples/src include vsn.mk VSN = $(SSL_VSN) diff --git a/lib/ssl/c_src/Makefile.dist b/lib/ssl/c_src/Makefile.dist deleted file mode 100644 index 2468468921..0000000000 --- a/lib/ssl/c_src/Makefile.dist +++ /dev/null @@ -1,33 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-2009. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% -# - -# Makefile for SSL on Unix -# -# Placed in obj directory. -# -CC = gcc - -BINDIR = %BINDIR% -LIBS = %LIBS% -SSL_LIBDIR = %SSL_LIBDIR% -OBJS = %OBJS% - -$(BINDIR)/ssl_esock: $(OBJS) - $(CC) -L$(SSL_LIBDIR) -Wl,-R$(SSL_LIBDIR) -o $@ $^ \ - $(LIBS) -lssl -lcrypto diff --git a/lib/ssl/c_src/Makefile.in b/lib/ssl/c_src/Makefile.in deleted file mode 100644 index 6e413e7e8e..0000000000 --- a/lib/ssl/c_src/Makefile.in +++ /dev/null @@ -1,215 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-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% -# - -# -# Makefile only for Unix and Win32/Cygwin. -# - -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk -# ---------------------------------------------------- -# SSL locations and include options from configure -# ---------------------------------------------------- -SSL_LIBDIR = @SSL_LIBDIR@ -SSL_INCLUDE = @SSL_INCLUDE@ -SSL_CRYPTO_LIBNAME = @SSL_CRYPTO_LIBNAME@ -SSL_SSL_LIBNAME = @SSL_SSL_LIBNAME@ - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(SSL_VSN) - -# ---------------------------------------------------- -# Commands -# ---------------------------------------------------- -CC = @CC@ -LD = @LD@ -SHELL = /bin/sh -LIBS = @LIBS@ -PLAIN_CFLAGS = @CFLAGS@ - -# ---------------------------------------------------- -# Includes and libs -# ---------------------------------------------------- - -ALL_CFLAGS = @WFLAGS@ @CFLAGS@ @DEFS@ $(TYPE_FLAGS) -TARGET = @host@ - -ifeq ($(TYPE),debug) -TYPEMARKER = .debug -TYPE_FLAGS = -g -DDEBUG @DEBUG_FLAGS@ -else -TYPEMARKER = -TYPE_FLAGS = -O2 -endif - -PRIVDIR = ../priv -BINDIR = $(PRIVDIR)/bin/$(TARGET) -OBJDIR = $(PRIVDIR)/obj/$(TARGET) - -# ---------------------------------------------------- -# File suffixes -# ---------------------------------------------------- -exe = @EXEEXT@ -obj = .@OBJEXT@ - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/ssl-$(VSN) - -# ---------------------------------------------------- -# Common Macros -# ---------------------------------------------------- -OBJS = $(OBJDIR)/esock$(obj) \ - $(OBJDIR)/debuglog$(obj) \ - $(OBJDIR)/esock_poll$(obj) \ - $(OBJDIR)/esock_osio$(obj) \ - $(OBJDIR)/esock_utils$(obj) \ - $(OBJDIR)/esock_posix_str$(obj) \ - $(OBJDIR)/esock_openssl$(obj) - -PORT_PROGRAM = $(BINDIR)/ssl_esock$(exe) - -SKIP_BUILDING_BINARIES := false - -# Try to be BC for R10 -ifeq ($(findstring @SSL_,@SSL_DYNAMIC_ONLY@),@SSL_) -DYNAMIC_CRYPTO_LIB=yes -else -DYNAMIC_CRYPTO_LIB=@SSL_DYNAMIC_ONLY@ -endif - - -ifeq ($(DYNAMIC_CRYPTO_LIB),yes) - -ifneq ($(findstring win32,$(TARGET)),win32) -SSL_MAKEFILE = $(OBJDIR)/Makefile -else -SSL_MAKEFILE = -endif - -CC_R_FLAG=@CFLAG_RUNTIME_LIBRARY_PATH@ - -ifeq ($(findstring @,$(CC_R_FLAG)),@) -# Old erts configure used which hasn't replaced @CFLAG_RUNTIME_LIBRARY_PATH@; -# we try our best here instead... - -ifeq ($(findstring darwin,$(TARGET)),darwin) # darwin: no flag -CC_R_FLAG = -else -ifeq ($(findstring osf,$(TARGET)),osf) # osf1: -Wl,-rpath, -CC_R_FLAG = -Wl,-rpath, -else # Default: -Wl,-R -CC_R_FLAG = -Wl,-R -endif -endif -endif - -ifeq ($(strip $(CC_R_FLAG)),) -CC_R_OPT = -else -CC_R_OPT = $(CC_R_FLAG)$(SSL_LIBDIR) -endif - -SSL_CC_RUNTIME_LIBRARY_PATH=@SSL_CC_RUNTIME_LIBRARY_PATH@ -# Sigh... -ifeq ($(findstring @,$(SSL_CC_RUNTIME_LIBRARY_PATH)),@) -SSL_CC_RUNTIME_LIBRARY_PATH = $(CC_R_OPT) -endif - -SSL_LINK_LIB=-L$(SSL_LIBDIR) -l$(SSL_SSL_LIBNAME) -l$(SSL_CRYPTO_LIBNAME) -else -# not dynamic crypto lib (default from R11B-5) -NEED_KERBEROS=@SSL_LINK_WITH_KERBEROS@ -NEED_ZLIB=@SSL_LINK_WITH_ZLIB@ -SSL_MAKEFILE = -CC_R_OPT = -SSL_CC_RUNTIME_LIBRARY_PATH= -SSL_LINK_LIB = $(SSL_LIBDIR)/lib$(SSL_SSL_LIBNAME).a $(SSL_LIBDIR)/lib$(SSL_CRYPTO_LIBNAME).a -ifeq ($(NEED_KERBEROS),yes) -SSL_LINK_LIB += @STATIC_KERBEROS_LIBS@ -endif -ifeq ($(NEED_ZLIB),yes) -SSL_LINK_LIB += @STATIC_ZLIB_LIBS@ -endif -endif - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(OBJDIR) $(BINDIR) $(OBJS) $(PORT_PROGRAM) $(SSL_MAKEFILE) - -$(OBJDIR): - -@mkdir -p $(OBJDIR) - -$(BINDIR): - -@mkdir -p $(BINDIR) - -$(OBJDIR)/esock_openssl$(obj): esock_openssl.c - $(CC) -c -o $@ $(ALL_CFLAGS) $(SSL_INCLUDE) $< - -$(OBJDIR)/%$(obj): %.c - $(CC) -c -o $@ $(ALL_CFLAGS) $< - -# Unix -$(BINDIR)/ssl_esock: $(OBJS) - $(CC) $(PLAIN_CFLAGS) $(LDFLAGS) -o $@ $^ $(LIBS) $(SSL_CC_RUNTIME_LIBRARY_PATH) $(SSL_LINK_LIB) - -# Win32/Cygwin -$(BINDIR)/ssl_esock.exe: $(OBJS) - $(LD) $(SSL_CC_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) -o $@ $^ -lwsock32 -l$(SSL_CRYPTO_LIBNAME) -l$(SSL_SSL_LIBNAME) - -# Unix only, and only when linking statically -$(SSL_MAKEFILE): - sed -e "s;%BINDIR%;../../bin/$(TARGET);" \ - -e "s;%SSL_LIBDIR%;$(SSL_LIBDIR);" \ - -e "s;%OBJS;$(OBJS);" \ - -e "s;%LIBS%;$(LIBS);" ./Makefile.dist \ - > $(OBJDIR)/Makefile - - -clean: - rm -f $(PORT_PROGRAM) $(OBJS) core *~ $(SSL_MAKEFILE) - -docs: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/priv/bin - $(INSTALL_PROGRAM) $(PORT_PROGRAM) $(RELSYSDIR)/priv/bin -ifneq ($(SSL_MAKEFILE),) - $(INSTALL_DIR) $(RELSYSDIR)/priv/obj - $(INSTALL_DATA) $(OBJS) $(RELSYSDIR)/priv/obj - sed -e "s;%BINDIR%;../bin;" \ - -e "s;%SSL_LIBDIR%;$(SSL_LIBDIR);" \ - -e "s;%OBJS;$(OBJS);" \ - -e "s;%LIBS%;$(LIBS);" ./Makefile.dist \ - > $(RELSYSDIR)/priv/obj/Makefile -endif - -release_docs_spec: - diff --git a/lib/ssl/c_src/Makefile.win32 b/lib/ssl/c_src/Makefile.win32 deleted file mode 100644 index 668cd2a28d..0000000000 --- a/lib/ssl/c_src/Makefile.win32 +++ /dev/null @@ -1,147 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-2009. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% -# - -# -# SSL - Makefile for Windows NT -# -# It is assumed that the following environment variables have been set: -# -# INCLUDE X:\MSDEV\INCLUDE -# LIB X:\MSDEV\LIB -# -# so that standard include files, and the socket library can be found. -# -# When ssl_esock.exe is run, the PATH environment variable must contain -# the name of a directory that contains ssleay32.dll and libeay32.dll, -# and windows socket dll. -# - -# Roots -!ifndef OPENSSL_ROOT -! error "Makefile.win32: ssl: OPENSSL_ROOT not set" -!endif - -TARGET = win32 - -BINDIR = ..\priv\bin\$(TARGET) -OBJDIR = ..\priv\obj\$(TARGET) - -!if !exist($(BINDIR)) -! if [mkdir $(BINDIR)] -! error "SSL: cannot create BINDIR" -! endif -!endif - -!if !exist($(OBJDIR)) -! if [mkdir $(OBJDIR)] -! error "SSL: cannot create OBJDIR" -! endif -!endif - -# Includes -# -OPENSSL_INCLUDE = $(OPENSSL_ROOT)\inc32 - -INCLUDES = /I. /I$(OPENSSL_INCLUDE) - -# Libraries -# -OPENSSL_LIBDIR = $(OPENSSL_ROOT)\out32dll -OPENSSL_LIBS = \ - $(OPENSSL_LIBDIR)\ssleay32.lib \ - $(OPENSSL_LIBDIR)\libeay32.lib - -!ifdef ESOCK_WINSOCK2 -WINSOCK_LIB = ws2_32.lib -DEFS = -DESOCK_WINSOCK2 -!else -WINSOCK_LIB = wsock32.lib -!endif - -# Compiler options -# -# NOTE: Size of fd_set is set in esock_winsock.h but can be overridden -# with a -D option here. -# -OPTS = /MDd /G5 /Ox /O2 /Ob2 /Z7 -DEFS = -D__WIN32__ -DWIN32 $(DEFS) -CFLAGS = $(INCLUDES) /nologo $(OPTS) $(DEFS) - -# Object files -# -SSL_BASE_OBJS = \ - $(OBJDIR)\esock.obj \ - $(OBJDIR)\debuglog.obj \ - $(OBJDIR)\esock_poll$(obj) \ - $(OBJDIR)\esock_osio.obj \ - $(OBJDIR)\esock_utils.obj \ - $(OBJDIR)\esock_posix_str.obj - -OPENSSL_OBJS = \ - $(OBJDIR)\esock_openssl.obj - -# -# Targets -# - -all: $(SSL_BASE_OBJS) $(OPENSSL_OBJS) $(BINDIR)\ssl_esock.exe - -clean: - del $(BINDIR)\*.exe - del $(OBJDIR)\*.obj - -# Inference rule .c.obj: -# -{.}.c{$(OBJDIR)}.obj: - $(CC) $(CFLAGS) /c /Fo$@ $(*B).c - -# Binary -# -$(BINDIR)\ssl_esock.exe: $(SSL_BASE_OBJS) $(OPENSSL_OBJS) - $(CC) /nologo $(SSL_BASE_OBJS) $(OPENSSL_OBJS) $(OPENSSL_LIBS) \ - $(WINSOCK_LIB) /Fe$(BINDIR)\ssl_esock.exe - - - -# Dependencies -# -$(OBJDIR)\esock.o: esock.h debuglog.h esock_ssl.h esock_osio.h \ - esock_utils.h esock_winsock.h -$(OBJDIR)\debuglog.o: debuglog.h esock_ssl.h esock_utils.h -$(OBJDIR)\esock_osio.o: esock_osio.h esock.h debuglog.h esock_utils.h \ - esock_winsock.h -$(OBJDIR)\esock_utils.o: esock_utils.h -$(OBJDIR)\esock_posix_str.o: esock_posix_str.h esock_winsock.h - -$(OBJDIR)\esock_openssl.o: esock.h esock_ssl.h debuglog.h esock_utils.h \ - $(OPENSSL_INCLUDE)\crypto.h \ - $(OPENSSL_INCLUDE)\ssl.h \ - $(OPENSSL_INCLUDE)\err.h - - - - - - - - - - - - diff --git a/lib/ssl/c_src/Makefile.win32.dist b/lib/ssl/c_src/Makefile.win32.dist deleted file mode 100644 index 8510c44e08..0000000000 --- a/lib/ssl/c_src/Makefile.win32.dist +++ /dev/null @@ -1,45 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-2009. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% -# - -# Makefile.win32.dist for SSL -# -# To be placed in obj directory. -# - -CC = cl - -BINDIR = %BINDIR% - -OPENSSL_LIBS = \ - $(BINDIR)\ssleay32.lib \ - $(BINDIR)\libeay32.lib - -WINSOCK_LIB = ws2_32.lib - -SSL_BASE_OBJS = esock.obj debuglog.obj esock_osio.obj esock_utils.obj \ - esock_posix_str.obj - -OPENSSL_OBJS = esock_openssl.obj - -$(BINDIR)\ssl_esock.exe: $(SSL_BASE_OBJS) $(OPENSSL_OBJS) - $(CC) /nologo $(SSL_BASE_OBJS) $(OPENSSL_OBJS) $(OPENSSL_LIBS) \ - $(WINSOCK_LIB) /Fe$(BINDIR)\ssl_esock.exe - - - diff --git a/lib/ssl/c_src/debuglog.c b/lib/ssl/c_src/debuglog.c deleted file mode 100644 index e2e55df4b2..0000000000 --- a/lib/ssl/c_src/debuglog.c +++ /dev/null @@ -1,251 +0,0 @@ -/*<copyright> - * <year>1999-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * 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. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -/* - * Purpose: Various routines for debug printouts and logs. - */ - -#include <stdlib.h> -#include <stdio.h> -#include <stdarg.h> -#include <string.h> -#include <ctype.h> -#include <time.h> -#include "debuglog.h" -#include "esock_utils.h" - -#ifndef __WIN32__ -static char tr_format_buf[256]; -static char *tr_format(const char *format); -static int vfprintclistf(FILE *fp, const char *format, va_list args); -#endif - -int debug = 0; -int debugmsg = 0; -FILE *ssllogfp = NULL; -FILE *__locallogfp = NULL; - -void open_ssllog(char *path) -{ - ssllogfp = openlog(path); -} - -void close_ssllog(void) -{ - if (ssllogfp) - closelog(ssllogfp); -} - -FILE *openlog(char *s) -{ - FILE *fp; - time_t t = time(NULL); - - if ((fp = fopen(s, "a"))) { - setbuf(fp, NULL); - fprintf(fp, "===== Opened [%s] %s", s, ctime(&t)); - } - return fp; -} - -void closelog(FILE *fp) -{ - time_t t = time(NULL); - - if (fp) { - fprintf(fp, "Closed %s", ctime(&t)); - fclose(fp); - } -} - -int __debugprintf(const char *format, ...) -{ - va_list args; - int ret; -#ifndef __WIN32__ - char *newformat; - - va_start(args, format); - newformat = tr_format(format); - ret = vfprintf(stderr, newformat, args); - if (newformat != format && newformat != tr_format_buf) - esock_free(newformat); -#else - va_start(args, format); - ret = vfprintf(stderr, format, args); -#endif - va_end(args); - if (ssllogfp) { - va_start(args, format); - vfprintf(ssllogfp, format, args); - va_end(args); - } - return ret; -} - -int __debugprintclistf(const char *format, ...) -{ - va_list args; - int ret; -#ifndef __WIN32__ - char *newformat; - - va_start(args, format); - newformat = tr_format(format); - ret = vfprintclistf(stderr, newformat, args); - if (newformat != format && newformat != tr_format_buf) - esock_free(newformat); -#else - va_start(args, format); - ret = vfprintclistf(stderr, format, args); -#endif - if (ssllogfp) - vfprintclistf(ssllogfp, format, args); - va_end(args); - return ret; -} - -int __debuglogf(const char *format, ...) -{ - va_list args; - int ret; - - va_start(args, format); - ret = vfprintf(__locallogfp, format, args); - va_end(args); - return ret; -} - -#ifndef __WIN32__ - -/* Insert `\r' before each `\n' i format */ -static char *tr_format(const char *format) -{ - char *newformat, *s, *t; - int len; - - len = strlen(format); - if ((newformat = (len > 127) ? esock_malloc(len) : tr_format_buf)) { - for (s = (char *)format, t = newformat; *s; *t++ = *s++) - if (*s == '\n') - *t++ = '\r'; - *t = '\0'; - } else - newformat = (char *)format; - return newformat; -} - -#endif - -/* This function is for printing arrays of characters with formats - * %FPa or %FPb, where F and P are the ordinary specifiers for - * field width and precision, respectively. - * - * The conversion specifier `a' implies hex-string output, while - * the `b' specifier provides character output (for non-printable - * characters a `.' is written. - * - * The F specifier contains the width for each character. The - * P specifier tells how many characters to print. - * - * Example: Suppose we have a function myprintf(char *format, ...) - * that calls our vfprintclistf(), and that - * - * char buf[] = "h\r\n"; - * len = 3; - * - * Then - * - * myprintf("%.2b", buf) prints "h." - * myprintf("%2.3b", buf) prints "h . . " - * myprintf("%3.*a", len, buf) prints "68 0d 0a" - * - */ - -static int vfprintclistf(FILE *fp, const char *format, va_list args) -{ - - int i, len, width, prec, written = 0; - char *s, *prevs, *fstart; - unsigned char *buf; - - if (!format || !*format) - return 0; - - /* %{[0-9]*|\*}{.{[0-9]*|\*}{a|b} */ - - prevs = (char *)format; /* format is const */ - s = strchr(format, '%'); - while (s && *s) { - if (s - prevs > 0) - written += fprintf(fp, "%.*s", s - prevs, prevs); - width = prec = 0; - fstart = s; - s++; - if (*s != '%') { /* otherwise it is not a format */ - if (*s == '*') { /* width in arg */ - s++; - width = va_arg(args, int); - } else if ((len = strspn(s, "0123456789"))) { /* const width */ - width = atoi(s); - s += len; - } else - width = 0; - if (*s == '.') { /* precision specified */ - s++; - if (*s == '*') { /* precision in arg */ - s++; - prec = va_arg(args, int); - } else if ((len = strspn(s, "0123456789"))) { /* const prec */ - prec = atoi(s); - s += len; - } else /* no precision value, defaults to zero */ - prec = 0; - } else - prec = 0; /* no precision defaults to zero */ - if (*s == 'a' || *s == 'b') { /* only valid specifiers */ - buf = va_arg(args, unsigned char *); - if (*s == 'a') { - for (i = 0; i < prec; i++) - written += fprintf(fp, "%*.2x", width, buf[i]); - }else if (*s == 'b') { - for (i = 0; i < prec; i++) { - if (isprint(buf[i])) - written += fprintf(fp, "%*c", width, buf[i]); - else - written += fprintf(fp, "%*c", width, '.'); - } - } - } else { - fprintf(stderr, "fprintclistf: format \"%s\" invalid.\n", - format); - va_end(args); - return written; - } - } - s++; - /* Now s points to the next character after the format */ - prevs = s; - s = strchr(s, '%'); - } - if (format + strlen(format) + 1 - prevs > 0) - written += fprintf(fp, "%s", prevs); - return written; -} - diff --git a/lib/ssl/c_src/debuglog.h b/lib/ssl/c_src/debuglog.h deleted file mode 100644 index 5699e6b495..0000000000 --- a/lib/ssl/c_src/debuglog.h +++ /dev/null @@ -1,50 +0,0 @@ -/*<copyright> - * <year>1998-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * 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. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -/* - * Purpose: Debug functions and macros. - * - */ - -#ifndef __DEBUGLOG_H_ -#define __DEBUGLOG_H_ - -#include <stdio.h> -#include "esock_ssl.h" - -#define DEBUGF(x) if (debug) __debugprintf x; -#define DEBUGMSGF(x) if (debugmsg) __debugprintclistf x; -#define LOGF(fp, x) if (fp) { __locallogfp = fp; __debuglogf x; } -#define SSLDEBUGF() if (debug) { esock_ssl_print_errors_fp(stderr); \ - if (ssllogfp) esock_ssl_print_errors_fp(ssllogfp); } - -int debug; -int debugmsg; -FILE *ssllogfp; -FILE *__locallogfp; - -void open_ssllog(char *path); -void close_ssllog(void); -FILE *openlog(char *); -void closelog(FILE *); -int __debugprintf(const char *, ...); -int __debugprintclistf(const char *, ...); -int __debuglogf(const char *, ...); - -#endif diff --git a/lib/ssl/c_src/esock.c b/lib/ssl/c_src/esock.c deleted file mode 100644 index 78d08f7c29..0000000000 --- a/lib/ssl/c_src/esock.c +++ /dev/null @@ -1,1904 +0,0 @@ -/*<copyright> - * <year>1999-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * 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. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ - -/* - * Purpose: Implementation of Secure Socket Layer (SSL). - * - * This is an "SSL proxy" for Erlang in the form of a port - * program. - * - * The implementation has borrowed somewhat from the original - * implementation of `socket' by Claes Wikstr�m, and the former - * implementation of `ssl_socket' by Helen Ariyan. - * - * All I/O is now non-blocking. - * - * When a connection (cp) is in the state JOINED we have the following - * picture: - * - * proxy->fd fd - * | | - * proxy->eof | --------> wq -----------> | bp - * | | - * Erlang | | SSL - * | | - * proxy->bp | <------ proxy->wq --------- | eof - * | | - * - * We read from Erlang (proxy->fd) and write to SSL (fd); and read from - * SSL (fd) and write to Erlang (proxy->fd). - * - * The variables bp (broken pipe) and eof (end of file) take the - * values 0 and 1. - * - * What has been read and cannot be immediately written is put in a - * write queue (wq). A wq is emptied before reads are continued, which - * means that at most one chunk that is read can be in a wq. - * - * The proxy-to-ssl part of a cp is valid iff - * - * !bp && (wq.len > 0 || !proxy->eof). - * - * The ssl-to-proxy part of a cp is valid iff - * - * !proxy->bp && (proxy->wq.len > 0 || !eof). - * - * The connection is valid if any of the above parts are valid, i.e. - * invalid if both parts are invalid. - * - * Every SELECT_TIMEOUT second we try to write to those file - * descriptors that have non-empty wq's (the only way to detect that a - * far end has gone away is to write to it). - * - * STATE TRANSITIONS - * - * Below (*) means that the corresponding file descriptor is published - * (i.e. kwown outside this port program) when the state is entered, - * and thus cannot be closed without synchronization with the - * ssl_server. - * - * Listen: - * - * STATE_NONE ---> (*) PASSIVE_LISTENING <---> ACTIVE_LISTENING - * - * Accept: - * - * STATE_NONE ---> SSL_ACCEPT ---> (*) CONNECTED ---> JOINED ---> - * ---> SSL_SHUTDOWN ---> DEFUNCT - * - * Connect: - * - * STATE_NONE ---> (*) WAIT_CONNECT ---> SSL_CONNECT ---> CONNECTED ---> - * ---> JOINED ---> SSL_SHUTDOWN ---> DEFUNCT - * - * In states where file descriptors has been published, and where - * something goes wrong, the state of the connection is set to - * DEFUNCT. A connection in such a state can only be closed by a CLOSE - * message from Erlang (a reception of such a message is registered in - * cp->closed). The possible states are: WAIT_CONNECT, SSL_CONNECT, - * CONNECTED, JOINED, and SSL_SHUTDOWN. - * - * A connection in state SSL_ACCEPT can be closed and removed without - * synchronization. - * - */ -#ifdef HAVE_CONFIG_H -#include "config.h" -#endif -#ifdef __WIN32__ -#include "esock_winsock.h" -#endif - -#include <stdio.h> -#include <stdlib.h> -#include <stdarg.h> -#include <string.h> -#include <time.h> -#include <ctype.h> -#include <sys/types.h> -#include <errno.h> - -#ifdef __WIN32__ -#include <process.h> -#else -#include <unistd.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <netinet/tcp.h> -#include <sys/time.h> -#include <netdb.h> -#include <arpa/inet.h> -#include <fcntl.h> -#endif - -#ifndef INADDR_NONE -#define INADDR_NONE 0xffffffff /* Should be in <netinet/in.h>. */ -#endif - -#include "esock.h" -#include "debuglog.h" -#include "esock_utils.h" -#include "esock_ssl.h" -#include "esock_osio.h" -#include "esock_posix_str.h" -#include "esock_poll.h" - -#define MAJOR_VERSION 2 -#define MINOR_VERSION 0 -#define MAXREPLYBUF 256 -#define RWBUFLEN (32*1024) -#define IS_CLIENT 0 -#define IS_SERVER 1 -#define SELECT_TIMEOUT 2 /* seconds */ - -#define psx_errstr() esock_posix_str(sock_errno()) -#define ssl_errstr() esock_ssl_errstr - -#define PROXY_TO_SSL_VALID(cp) (!(cp)->bp && \ - ((cp)->wq.len > 0 || !(cp)->proxy->eof)) - -#define SSL_TO_PROXY_VALID(cp) (!(cp)->proxy->bp && \ - ((cp)->proxy->wq.len > 0 || !(cp)->eof)) - -#define JOINED_STATE_INVALID(cp) (!(PROXY_TO_SSL_VALID(cp)) && \ - !(SSL_TO_PROXY_VALID(cp))) -static int loop(void); -static int set_poll_conns(Connection *cp, EsockPoll *ep, int verbose); -static Connection *next_polled_conn(Connection *cp, Connection **cpnext, - EsockPoll *ep, int set_wq_fds); - -static void leave_joined_state(Connection *cp); -static void do_shutdown(Connection *cp); -static void close_and_remove_connection(Connection *cp); -static int reply(int cmd, char *fmt, ...); -static int input(char *fmt, ...); -static int put_pars(unsigned char *buf, char *fmt, va_list args); -static int get_pars(unsigned char *buf, char *fmt, va_list args); -static FD do_connect(char *lipstring, int lport, char *fipstring, int fport); -static FD do_listen(char *ipstring, int lport, int backlog, int *aport); -static FD do_accept(FD listensock, struct sockaddr *saddr, int *len); -static void print_connections(void); -static void dump_connections(void); -static int check_num_sock_fds(FD fd); -static void safe_close(FD fd); -static Connection *new_connection(int state, FD fd); -static Connection *get_connection(FD fd); -static void remove_connection(Connection *conn); -static Proxy *get_proxy_by_peerport(int port); -static Proxy *new_proxy(FD fd); -static void remove_proxy(Proxy *proxy); -static void ensure_write_queue(WriteQueue *wq, int size); -static void clean_up(void); - -static Connection *connections = NULL; -static int num_sock_fds; /* On UNIX all file descriptors */ -static Proxy *proxies = NULL; -static int proxy_listensock = INVALID_FD; -static int proxy_listenport = 0; -static int proxy_backlog = 128; -static int proxysock_last_err = 0; -static int proxysock_err_cnt = 0; -static char rwbuf[RWBUFLEN]; -static unsigned char *ebuf = NULL; /* Set by read_ctrl() */ - -static char *connstr[] = { - "STATE_NONE", - "ACTIVE_LISTENING", - "PASSIVE_LISTENING", - "CONNECTED", - "WAIT_CONNECT", - "SSL_CONNECT", - "SSL_ACCEPT", - "TRANSPORT_ACCEPT", - "JOINED", - "SSL_SHUTDOWN", - "DEFUNCT" -}; - -static char *originstr[] = { - "listen", - "accept", - "connect" -}; - -int main(int argc, char **argv) -{ - char *logfile = NULL; - int i; - esock_version *vsn; - char *ciphers; -#ifdef __WIN32__ - int pid; - WORD version; - WSADATA wsa_data; - - set_binary_mode(); - setvbuf(stderr, NULL, _IONBF, 0); - /* Two sockets for the stdin socket pipe (local thread). */ - num_sock_fds = 2; -#else - pid_t pid; - num_sock_fds = 3; /* 0, 1, 2 */ -#endif - - pid = getpid(); - i = 1; - while (i < argc) { - if (strcmp(argv[i], "-d") == 0) { - debug = 1; - i++; - } else if (strcmp(argv[i], "-dm") == 0) { - debugmsg = 1; - i++; - } else if (strcmp(argv[i], "-pp") == 0) { - i++; - proxy_listenport = atoi(argv[i]); - i++; - } else if (strcmp(argv[i], "-pb") == 0) { - i++; - proxy_backlog = atoi(argv[i]); - i++; - } else if (strcmp(argv[i], "-pv") == 0) { - i++; - protocol_version = atoi(argv[i]); - i++; - } else if (strcmp(argv[i], "-dd") == 0) { - i++; - logfile = esock_malloc(strlen(argv[i]) + 64); - sprintf(logfile, "%s/ssl_esock.%d.log", argv[i], (int)pid); - i++; - } else if (strcmp(argv[i], "-ersa") == 0) { - ephemeral_rsa = 1; - i++; - } else if (strcmp(argv[i], "-edh") == 0) { - ephemeral_dh = 1; - i++; - } - } - if (debug || debugmsg) { - DEBUGF(("Starting ssl_esock\n")); - if (logfile) { - open_ssllog(logfile); -#ifndef __WIN32__ - num_sock_fds++; -#endif - } - atexit(close_ssllog); - DEBUGF(("pid = %d\n", getpid())); - } - if (esock_ssl_init() < 0) { - fprintf(stderr, "esock: Could not do esock_ssl_init\n"); - exit(EXIT_FAILURE); - } - - atexit(esock_ssl_finish); - -#ifdef __WIN32__ - /* Start Windows' sockets */ - version = MAKEWORD(MAJOR_VERSION, MINOR_VERSION); - if (WSAStartup(version, &wsa_data) != 0) { - fprintf(stderr, "esock: Could not start up Windows' sockets\n"); - exit(EXIT_FAILURE); - } - atexit((void (*)(void))WSACleanup); - if (LOBYTE(wsa_data.wVersion) < MAJOR_VERSION || - (LOBYTE(wsa_data.wVersion) == MAJOR_VERSION && - HIBYTE(wsa_data.wVersion) < MINOR_VERSION)) { - fprintf(stderr, "esock: Windows socket version error. " - "Requested version:" - "%d.%d, version found: %d.%d\n", MAJOR_VERSION, - MINOR_VERSION, LOBYTE(wsa_data.wVersion), - HIBYTE(wsa_data.wVersion)); - exit(EXIT_FAILURE); - } - DEBUGF(("Using Windows socket version: %d.%d\n", - LOBYTE(wsa_data.wVersion), HIBYTE(wsa_data.wVersion))); - DEBUGF(("Maximum number of sockets available: %d\n", - wsa_data.iMaxSockets)); - - if (esock_osio_init() < 0) { - fprintf(stderr, "esock: Could not init osio\n"); - exit(EXIT_FAILURE); - } - atexit(esock_osio_finish); -#endif - - /* Create the local proxy listen socket and set it to non-blocking */ - proxy_listensock = do_listen("127.0.0.1", proxy_listenport, - proxy_backlog, &proxy_listenport); - if (proxy_listensock == INVALID_FD) { - fprintf(stderr, "esock: Cannot create local listen socket\n"); - exit(EXIT_FAILURE); - } - SET_NONBLOCKING(proxy_listensock); - DEBUGF(("Local proxy listen socket: fd = %d, port = %d\n", - proxy_listensock, proxy_listenport)); - - vsn = esock_ssl_version(); - ciphers = esock_ssl_ciphers(); - - /* Report: port number of the local proxy listen socket, the native - * os pid, the compile and lib versions of the ssl library, and - * the list of available ciphers. */ - reply(ESOCK_PROXY_PORT_REP, "24sss", proxy_listenport, (int)pid, - vsn->compile_version, vsn->lib_version, ciphers); - - atexit(clean_up); - - loop(); - - if (logfile) - esock_free(logfile); - exit(EXIT_SUCCESS); -} - - -/* - * Local functions - * - */ - -static int loop(void) -{ - EsockPoll pollfd; - FD fd, msgsock, listensock, connectsock, proxysock; - int cc, wc, fport, lport, pport, length, backlog, intref, op; - int value; - char *lipstring, *fipstring; - char *flags; - char *protocol_vsn, *cipher; - unsigned char *cert, *bin; - int certlen, binlen; - struct sockaddr_in iserv_addr; - int sret = 1; - Connection *cp, *cpnext, *newcp; - Proxy *pp; - time_t last_time = 0, now = 0; - int set_wq_fds; - - esock_poll_init(&pollfd); - - while(1) { - esock_poll_zero(&pollfd); - esock_poll_fd_set_read(&pollfd, proxy_listensock); - esock_poll_fd_set_read(&pollfd, local_read_fd); - - set_wq_fds = 0; - - if (sret) /* sret == 1 the first time. */ - DEBUGF(("==========LOOP=============\n")); - - cc = set_poll_conns(connections, &pollfd, sret) + 1; - - if (sret) { - print_connections(); - DEBUGF(("Before poll/select: %d descriptor%s (total %d)\n", - cc, (cc == 1) ? "" : "s", num_sock_fds)); - } - - sret = esock_poll(&pollfd, SELECT_TIMEOUT); - if (sret < 0) { - DEBUGF(("select/poll error: %s\n", psx_errstr())); - continue; - } - - time(&now); - if (now >= last_time + SELECT_TIMEOUT) { - set_wq_fds = 1; - last_time = now; - } - /* - * First accept as many connections as possible on the - * proxy listen socket. We record the peer port, which - * is later used as a reference for joining a proxy - * connection with a network connection. - */ - - if (esock_poll_fd_isset_read(&pollfd, proxy_listensock)) { - while (1) { - length = sizeof(iserv_addr); - proxysock = do_accept(proxy_listensock, - (struct sockaddr *)&iserv_addr, - (int*)&length); - if(proxysock == INVALID_FD) { - if (sock_errno() != ERRNO_BLOCK) { - /* We can here for example get the error - * EMFILE, i.e. no more file descriptors - * available, but we do not have any specific - * connection to report the error to. We - * increment the error counter and saves the - * last err. - */ - proxysock_err_cnt++; - proxysock_last_err = sock_errno(); - DEBUGF(("accept error (proxy_listensock): %s\n", - psx_errstr())); - } - break; - } else { - /* Get peer port number */ -/* length = sizeof(iserv_addr); */ -/* if (getpeername(proxysock, (struct sockaddr *)&iserv_addr, */ -/* &length) < 0) { */ -/* DEBUGF(("Can't get peername of proxy socket")); */ -/* safe_close(proxysock); */ -/* } else { */ - /* Add to pending proxy connections */ - SET_NONBLOCKING(proxysock); - pp = new_proxy(proxysock); - pp->peer_port = ntohs(iserv_addr.sin_port); - DEBUGF(("-----------------------------------\n")); - DEBUGF(("[PROXY_LISTEN_SOCK] conn accepted: " - "proxyfd = %d, " - "peer port = %d\n", proxysock, pp->peer_port)); -/* } */ - } - } - } - - /* - * Read control messages from Erlang - */ - if (esock_poll_fd_isset_read(&pollfd, local_read_fd)) { - cc = read_ctrl(&ebuf); - if ( cc < 0 ) { - DEBUGF(("Read loop -1 or 0\n")); - return -1; - } else if (cc == 0) { /* not eof */ - DEBUGF(("GOT empty string \n")); - - } else { - - switch((int)*ebuf) { - - case ESOCK_SET_SEED_CMD: - /* - * ebuf = {cmd(1), binary(N) } - */ - input("b", &binlen, &bin); - DEBUGF(("[SET_SEED_CMD]\n")); - esock_ssl_seed(bin, binlen); - /* no reply */ - break; - - case ESOCK_GETPEERNAME_CMD: - /* - * ebuf = {cmd(1), fd(4)} - */ - input("4", &fd); - DEBUGF(("[GETPEERNAME_CMD] fd = %d\n", fd)); - cp = get_connection(fd); - length = sizeof(iserv_addr); - if (!cp) { - sock_set_errno(ERRNO_NOTSOCK); - reply(ESOCK_GETPEERNAME_ERR, "4s", fd, psx_errstr()); - } else if (getpeername(fd, - (struct sockaddr *) &iserv_addr, - &length) < 0) { - reply(ESOCK_GETPEERNAME_ERR, "4s", fd, psx_errstr()); - } else { - /* - * reply = {cmd(1), fd(4), port(2), - * ipstring(N), 0(1)} - */ - reply(ESOCK_GETPEERNAME_REP, "42s", fd, - ntohs(iserv_addr.sin_port), - inet_ntoa(iserv_addr.sin_addr)); - } - break; - - case ESOCK_GETSOCKNAME_CMD: - /* - * ebuf = {cmd(1), fd(4)} - */ - input("4", &fd); - DEBUGF(("[GETSOCKNAME_CMD] fd = %d\n", fd)); - cp = get_connection(fd); - length = sizeof(iserv_addr); - if (!cp) { - sock_set_errno(ERRNO_NOTSOCK); - reply(ESOCK_GETSOCKNAME_ERR, "4s", fd, psx_errstr()); - } else if (getsockname(fd, - (struct sockaddr *)&iserv_addr, - &length) < 0) { - reply(ESOCK_GETSOCKNAME_ERR, "4s", fd, psx_errstr()); - } else { - /* - * reply = {cmd(1), fd(4), port(2), - * ipstring(N), 0(1)} - */ - reply(ESOCK_GETSOCKNAME_REP, "42s", fd, - ntohs(iserv_addr.sin_port), - inet_ntoa(iserv_addr.sin_addr)); - } - break; - - case ESOCK_GETCONNINFO_CMD: - /* - * ebuf = {cmd(1), fd(4)} - */ - input("4", &fd); - DEBUGF(("[GETCONNINFO_CMD] fd = %d\n", fd)); - cp = get_connection(fd); - if (!cp) { - sock_set_errno(ERRNO_NOTSOCK); - reply(ESOCK_GETCONNINFO_ERR, "4s", fd, psx_errstr()); - } else { - if (esock_ssl_getprotocol_version(cp, - &protocol_vsn) < 0) - reply(ESOCK_GETCONNINFO_ERR, "4s", fd, psx_errstr()); - else if (esock_ssl_getcipher(cp, &cipher) < 0) - reply(ESOCK_GETCONNINFO_ERR, "4s", fd, psx_errstr()); - else - /* - * reply = {cmd(1), fd(4), protocol(N), 0(1), - * cipher(N), 0(1)} - */ - reply(ESOCK_GETCONNINFO_REP, "4ss", fd, - protocol_vsn, cipher); - } - break; - - case ESOCK_GETPEERCERT_CMD: - /* - * ebuf = {cmd(1), fd(4)} - */ - input("4", &fd); - DEBUGF(("[GETPEERCERT_CMD] fd = %d\n", fd)); - cp = get_connection(fd); - if (!cp) { - sock_set_errno(ERRNO_NOTSOCK); - reply(ESOCK_GETPEERCERT_ERR, "4s", fd, psx_errstr()); - } else { - if ((certlen = esock_ssl_getpeercert(cp, &cert)) < 0) - reply(ESOCK_GETPEERCERT_ERR, "4s", fd, psx_errstr()); - else { - /* - * reply = {cmd(1), fd(4), certlen(4), cert(N)} - */ - reply(ESOCK_GETPEERCERT_REP, "4b", fd, - certlen, cert); - esock_free(cert); - } - } - break; - - case ESOCK_CONNECT_CMD: - /* - * ebuf = {cmd(1), intref(4), - * lport(2), lipstring(N), 0(1), -- local - * fport(2), fipstring(N), 0(1), -- foreign - * flags(N), 0(1)} - */ - input("42s2ss", &intref, &lport, &lipstring, - &fport, &fipstring, &flags); - DEBUGF(("[CONNECT_CMD] intref = %d, " - "lipstring = %s lport = %d, " - "fipstring = %s fport = %d, " - "flags = %s\n", intref, lipstring, lport, - fipstring, fport, flags)); - connectsock = do_connect(lipstring, lport, - fipstring, fport); - if(connectsock == INVALID_FD) { - reply(ESOCK_CONNECT_SYNC_ERR, "4s", intref, psx_errstr()); - break; - } - DEBUGF((" fd = %d\n", connectsock)); - cp = new_connection(ESOCK_WAIT_CONNECT, connectsock); - cp->origin = ORIG_CONNECT; - length = strlen(flags); - cp->flags = esock_malloc(length + 1); - strcpy(cp->flags, flags); - DEBUGF(("-> WAIT_CONNECT fd = %d\n", connectsock)); - /* Publish connectsock */ - reply(ESOCK_CONNECT_WAIT_REP, "44", intref, connectsock); - break; - - case ESOCK_TERMINATE_CMD: - /* - * ebuf = {cmd(1)} - */ - exit(EXIT_SUCCESS); - break; - - case ESOCK_CLOSE_CMD: - /* - * ebuf = {cmd(1), fd(4)} - */ - input("4", &fd); - if ((cp = get_connection(fd))) { - DEBUGF(("%s[CLOSE_CMD]: fd = %d\n", - connstr[cp->state], fd)); - if (cp->proxy) - cp->proxy->bp = 1; - switch (cp->state) { - case ESOCK_JOINED: - cp->close = 1; - if (JOINED_STATE_INVALID(cp)) - leave_joined_state(cp); - break; - case ESOCK_SSL_SHUTDOWN: - cp->close = 1; - DEBUGF((" close flag set\n")); - break; - default: - DEBUGF(("-> (removal)\n")); - close_and_remove_connection(cp); - } - } else - DEBUGF(("[CLOSE_CMD]: ERROR: fd = %d not found\n", fd)); - break; - - case ESOCK_SET_SOCKOPT_CMD: - /* - * ebuf = {cmd(1), fd(4), op(1), on(1)} - */ - input("411", &fd, &op, &value); - switch(op) { - case ESOCK_SET_TCP_NODELAY: - if(setsockopt(fd, IPPROTO_TCP, TCP_NODELAY, - (void *)&value, sizeof(value)) < 0) { - DEBUGF(("Error: setsockopt TCP_NODELAY\n")); - reply(ESOCK_IOCTL_ERR, "4s", fd, psx_errstr()); - } else { - reply(ESOCK_IOCTL_OK, "4", fd); - } - break; - default: - DEBUGF(("Error: set_sock_opt - Not implemented\n")); - sock_set_errno(ERRNO_OPNOTSUPP); - reply(ESOCK_IOCTL_ERR, "4", fd, psx_errstr()); - break; - } - break; - - case ESOCK_LISTEN_CMD: - /* - * ebuf = {cmd(1), intref(4), lport(2), ipstring(N), 0(1), - * backlog(2), flags(N), 0(1)} - */ - input("42s2s", &intref, &lport, &lipstring, &backlog, - &flags); - DEBUGF(("[LISTEN_CMD] intref = %d, port = %d, " - "ipstring = %s, backlog = %d, flags = %s\n", - intref, lport, lipstring, backlog, flags)); - - listensock = do_listen(lipstring, lport, backlog, &lport); - if(listensock == INVALID_FD) { - reply(ESOCK_LISTEN_SYNC_ERR, "4s", intref, psx_errstr()); - break; - } - cp = new_connection(ESOCK_PASSIVE_LISTENING, listensock); - /* Flags may be an empty string */ - length = strlen(flags); - cp->flags = esock_malloc(length + 1); - strcpy(cp->flags, flags); - - cp->origin = ORIG_LISTEN; - if (esock_ssl_listen_init(cp) < 0) { - DEBUGF(("esock_ssl_listen_init() failed.\n")); - reply(ESOCK_LISTEN_SYNC_ERR, "4s", intref, - ssl_errstr()); - close_and_remove_connection(cp); - break; - } - DEBUGF(("-> PASSIVE_LISTENING (fd = %d)\n", listensock)); - /* Publish listensock */ - reply(ESOCK_LISTEN_REP, "442", intref, listensock, - ntohs(iserv_addr.sin_port)); - break; - - case ESOCK_TRANSPORT_ACCEPT_CMD: - /* - * ebuf = { op(1), fd(4), flags(N), 0(1)} - */ - input("4s", &fd, &flags); - DEBUGF(("[TRANSPORT_ACCEPT_CMD] listenfd = %d, flags = %s\n", fd, - flags)); - cp = get_connection(fd); - if (cp) { - /* We store the flags in the listen socket's - * connection, and overwrite previous flags. - */ - if ((length = strlen(flags)) > 0) { - if (cp->flags) - cp->flags = esock_realloc(cp->flags, - length + 1); - else - cp->flags = esock_malloc(length + 1); - strcpy(cp->flags, flags); - } - if (cp->flags && cp->flags[0] != '\0') { - cp->acceptors++; - cp->state = ESOCK_ACTIVE_LISTENING; - DEBUGF(("-> ACTIVE_LISTENING\n")); - break; - } - DEBUGF(("ERROR: flags empty\n")); - } - reply(ESOCK_TRANSPORT_ACCEPT_ERR, "4s", fd, "ebadf"); - break; - - case ESOCK_SSL_ACCEPT_CMD: - input("4s", &fd, &flags); - DEBUGF(("[SSL_ACCEPT_CMD] fd = %d, flags = %s\n", fd, flags)); - cp = get_connection(fd); - if (cp) - cp->state = ESOCK_SSL_ACCEPT; - //reply(ESOCK_SSL_ACCEPT_REP, "4", fd); - break; - - case ESOCK_NOACCEPT_CMD: - /* - * ebuf = {cmd(1), fd(4)} - */ - input("4", &fd); - DEBUGF(("[NOACCEPT_CMD] listenfd = %d\n", fd)); - cp = get_connection(fd); - if (cp && (--cp->acceptors <= 0)) { - cp->acceptors = 0; - cp->state = ESOCK_PASSIVE_LISTENING; - esock_poll_clear_event(&pollfd, fd); - DEBUGF(("-> PASSIVE_LISTENING\n")); - } - break; - - case ESOCK_PROXY_JOIN_CMD: - /* - * ebuf = {cmd(1), fd(4), portnum(2)} - * - * fd - file descriptor of a connection in state - * CONNECTED - * portnum - port number of the Erlang proxy peer - */ - input("42", &fd, &pport); - cp = get_connection(fd); - pp = get_proxy_by_peerport(pport); - if (cp && cp->state == ESOCK_CONNECTED && pp) { - DEBUGF(("CONNECTED[PROXY_JOIN_CMD] fd = %d " - "portnum = %d\n", fd, pport)); - cp->proxy = pp; - pp->conn = cp; - reply(ESOCK_PROXY_JOIN_REP, "4", fd); - cp->state = ESOCK_JOINED; - DEBUGF(("-> JOINED\n")); - break; - } - if (!cp) { - DEBUGF(("[PROXY_JOIN_CMD] ERROR: No connection " - "having fd = %d\n", fd)); - reply(ESOCK_PROXY_JOIN_ERR, "4s", fd, "ebadsocket"); - } else if (cp->state != ESOCK_CONNECTED) { - DEBUGF(("%s[PROXY_JOIN_CMD] ERROR: Bad state: " - "fd = %d\n", connstr[cp->state], cp->fd)); - reply(ESOCK_PROXY_JOIN_ERR, "4s", fd, "ebadstate"); - } else { - DEBUGF(("ERROR: No proxy: fd = %d, pport = %d\n", - fd, pport)); - if (proxysock_err_cnt > 0) { - proxysock_err_cnt--; - reply(ESOCK_PROXY_JOIN_ERR, "4s", fd, - esock_posix_str(proxysock_last_err)); - } else { - reply(ESOCK_PROXY_JOIN_ERR, "4s", fd, - "enoproxysocket"); - } - cp->state = ESOCK_DEFUNCT; - } - break; - - case ESOCK_DUMP_STATE_CMD: - dump_connections(); - break; - - case ESOCK_SET_DEBUG_CMD: - /* - * ebuf = {cmd(1), debug(1)} - */ - input("1", &debug); - break; - - case ESOCK_SET_DEBUGMSG_CMD: - /* - * ebuf = {cmd(1), debugmsg(1)} - */ - input("1", &debugmsg); - break; - - default: - fprintf(stderr, "esock: default value in loop %c\n", - *ebuf); - exit(EXIT_FAILURE); - break; - } - } - } - - /* Go through all connections that have their file descriptors - set. */ - - /* Note: We may remove the current connection (cp). Thus we - * must be careful not to read cp->next after cp has been - * removed. */ - for (cp = next_polled_conn(connections, &cpnext, &pollfd, set_wq_fds); - cp != NULL; - cp = next_polled_conn(cpnext, &cpnext, &pollfd, set_wq_fds) - ) { - - switch(cp->state) { - - case ESOCK_PASSIVE_LISTENING: - DEBUGF(("-----------------------------------\n")); - fprintf(stderr, "esock: Got connect request while PASSIVE\n"); - exit(EXIT_FAILURE); - break; - - case ESOCK_ACTIVE_LISTENING: - /* new connect from network */ - DEBUGF(("-----------------------------------\n")); - DEBUGF(("ACTIVE_LISTENING - trying to accept on %d\n", - cp->fd)); - length = sizeof(iserv_addr); - msgsock = do_accept(cp->fd, (struct sockaddr*)&iserv_addr, - (int*)&length); - if(msgsock == INVALID_FD) { - DEBUGF(("accept error: %s\n", psx_errstr())); - reply(ESOCK_TRANSPORT_ACCEPT_ERR, "4s", cp->fd, psx_errstr()); - break; - } - SET_NONBLOCKING(msgsock); - if (--cp->acceptors <= 0) { - cp->acceptors = 0; - cp->state = ESOCK_PASSIVE_LISTENING; - DEBUGF(("-> PASSIVE_LISTENING\n")); - } - DEBUGF(("server accepted connection on fd %d\n", msgsock)); - newcp = new_connection(ESOCK_TRANSPORT_ACCEPT, msgsock); - newcp->origin = ORIG_ACCEPT; - reply(ESOCK_TRANSPORT_ACCEPT_REP, "44", cp->fd, msgsock); - newcp->listen_fd = cp->fd; /* Needed for ESOCK_ACCEPT_ERR */ - length = strlen(cp->flags); - /* XXX new flags are not needed */ - newcp->flags = esock_malloc(length + 1); - strcpy(newcp->flags, cp->flags); /* XXX Why? */ - if (esock_ssl_accept_init(newcp, cp->opaque) < 0) { - cp->errstr = ssl_errstr(); - break; - } - newcp->ssl_want = ESOCK_SSL_WANT_READ; - break; - - case ESOCK_SSL_ACCEPT: - /* SSL accept handshake. msgsock is *not* published yet. */ - msgsock = cp->fd; - DEBUGF(("-----------------------------------\n")); - DEBUGF(("SSL_ACCEPT fd = %d\n", msgsock)); - if (cp->errstr != NULL) { /* this means we got an error in ssl_accept_init */ - /* N.B.: The *listen fd* is reported. */ - reply(ESOCK_SSL_ACCEPT_ERR, "4s", msgsock, cp->errstr); - close_and_remove_connection(cp); - break; - } - if (esock_ssl_accept(cp) < 0) { - if (sock_errno() != ERRNO_BLOCK) { - /* Handshake failed. */ - reply(ESOCK_SSL_ACCEPT_ERR, "4s", msgsock, - ssl_errstr()); - DEBUGF(("ERROR: handshake: %s\n", ssl_errstr())); - close_and_remove_connection(cp); - } - } else { - /* SSL handshake successful: publish */ - reply(ESOCK_SSL_ACCEPT_REP, "4", msgsock); - DEBUGF(("-> CONNECTED\n")); - DEBUGF((" Session was %sreused.\n", - (esock_ssl_session_reused(cp)) ? "" : "NOT ")); - cp->state = ESOCK_CONNECTED; - } - break; - - case ESOCK_CONNECTED: - /* Should not happen. We do not read or write until - the connection is in state JOINED. */ - DEBUGF(("-----------------------------------\n")); - DEBUGF(("CONNECTED: Error: should not happen. fd = %d\n", - cp->fd)); - break; - - case ESOCK_JOINED: - /* - * Reading from Proxy, writing to SSL - */ - if (esock_poll_fd_isset_write(&pollfd, cp->fd)) { - /* If there is a write queue, write to ssl only */ - if (cp->wq.len > 0) { - /* The write retry semantics of SSL_write in - * the OpenSSL package is strange. Partial - * writes never occur, only complete writes or - * failures. A failure, however, still - * consumes all data written, although not all - * encrypted data could be written to the - * underlying socket. To retry a write we have - * to provide the same buf and length as in - * the original call, in our case rwbuf and - * the original buffer length. Hence the - * strange memcpy(). Note that wq.offset will - * always be zero when we use OpenSSL. - */ - DEBUGF(("-----------------------------------\n")); - DEBUGF(("JOINED: writing to ssl " - "fd = %d, from write queue only, wc = %d\n", - cp->fd, cp->wq.len - cp->wq.offset)); - memcpy(rwbuf, cp->wq.buf, cp->wq.len - cp->wq.offset); - - /* esock_ssl_write sets cp->eof, cp->bp when return - * value is zero */ - wc = esock_ssl_write(cp, rwbuf, - cp->wq.len - cp->wq.offset); - if (wc < 0) { - if (sock_errno() != ERRNO_BLOCK) { - /* Assume broken SSL pipe */ - DEBUGF(("broken SSL pipe\n")); - cp->bp = 1; - shutdown(cp->proxy->fd, SHUTDOWN_READ); - cp->proxy->eof = 1; - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } - } else if (wc == 0) { - /* SSL broken pipe */ - DEBUGF(("broken SSL pipe\n")); - cp->bp = 1; - shutdown(cp->proxy->fd, SHUTDOWN_READ); - cp->proxy->eof = 1; - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } else { - cp->wq.offset += wc; - if (cp->wq.offset == cp->wq.len) - cp->wq.len = 0; - } - } - } else if (esock_poll_fd_isset_read(&pollfd, cp->proxy->fd)) { - /* Read from proxy and write to SSL */ - DEBUGF(("-----------------------------------\n")); - DEBUGF(("JOINED: reading from proxy, " - "proxyfd = %d\n", cp->proxy->fd)); - cc = sock_read(cp->proxy->fd, rwbuf, RWBUFLEN); - DEBUGF(("read from proxyfd = %d, cc = %d\n", - cp->proxy->fd, cc)); - if (cc > 0) { - /* esock_ssl_write sets cp->eof, cp->bp when return - * value is zero */ - wc = esock_ssl_write(cp, rwbuf, cc); - if (wc < 0) { - if (sock_errno() != ERRNO_BLOCK) { - /* Assume broken pipe */ - DEBUGF(("broken SSL pipe\n")); - cp->bp = 1; - shutdown(cp->proxy->fd, SHUTDOWN_READ); - cp->proxy->eof = 1; - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } else { - /* add to write queue */ - DEBUGF(("adding all to write queue " - "%d bytes\n", cc)); - ensure_write_queue(&cp->wq, cc); - memcpy(cp->wq.buf, rwbuf, cc); - cp->wq.len = cc; - cp->wq.offset = 0; - } - } else if (wc == 0) { - /* Broken SSL pipe */ - DEBUGF(("broken SSL pipe\n")); - cp->bp = 1; - shutdown(cp->proxy->fd, SHUTDOWN_READ); - cp->proxy->eof = 1; - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } else if (wc < cc) { - /* add remainder to write queue */ - DEBUGF(("adding remainder to write queue " - "%d bytes\n", cc - wc)); - ensure_write_queue(&cp->wq, cc - wc); - memcpy(cp->wq.buf, rwbuf + wc, cc - wc); - cp->wq.len = cc - wc; - cp->wq.offset = 0; - } - } else { - /* EOF proxy or error */ - DEBUGF(("proxy eof or error %d\n", errno)); - cp->proxy->eof = 1; - if (cp->wq.len == 0) { - esock_ssl_shutdown(cp); - cp->bp = 1; - } - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } - } - /* - * Reading from SSL, writing to proxy - */ - if (esock_poll_fd_isset_write(&pollfd, cp->proxy->fd)) { - /* If there is a write queue, write to proxy only */ - if (cp->proxy->wq.len > 0) { - DEBUGF(("-----------------------------------\n")); - DEBUGF(("JOINED: writing to proxyfd = %d, " - "from write queue only, wc = %d\n", - cp->proxy->fd, cp->proxy->wq.len - - cp->proxy->wq.offset)); - wc = sock_write(cp->proxy->fd, cp->proxy->wq.buf + - cp->proxy->wq.offset, - cp->proxy->wq.len - - cp->proxy->wq.offset); - if (wc < 0) { - if (sock_errno() != ERRNO_BLOCK) { - /* Assume broken pipe */ - DEBUGF(("broken proxy pipe\n")); - cp->proxy->bp = 1; - /* There is no SSL shutdown for read */ - cp->eof = 1; - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } - } else { - cp->proxy->wq.offset += wc; - if (cp->proxy->wq.offset == cp->proxy->wq.len) - cp->proxy->wq.len = 0; - } - } - } else if (esock_poll_fd_isset_read(&pollfd, cp->fd)) { - /* Read from SSL and write to proxy */ - DEBUGF(("-----------------------------------\n")); - DEBUGF(("JOINED: read from ssl fd = %d\n", - cp->fd)); - cc = esock_ssl_read(cp, rwbuf, RWBUFLEN); - DEBUGF(("read from fd = %d, cc = %d\n", cp->fd, cc)); - if (cc > 0) { - wc = sock_write(cp->proxy->fd, rwbuf, cc); - if (wc < 0) { - if (sock_errno() != ERRNO_BLOCK) { - DEBUGF(("broken proxy pipe\n")); - /* Assume broken pipe */ - cp->proxy->bp = 1; - /* There is no SSL shutdown for read */ - cp->eof = 1; - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } else { - /* add all to write queue */ - DEBUGF(("adding to write queue %d bytes\n", - cc)); - ensure_write_queue(&cp->proxy->wq, cc); - memcpy(cp->proxy->wq.buf, rwbuf, cc); - cp->proxy->wq.len = cc; - cp->proxy->wq.offset = 0; - } - } else if (wc < cc) { - /* add to write queue */ - DEBUGF(("adding to write queue %d bytes\n", - cc - wc)); - ensure_write_queue(&cp->proxy->wq, cc - wc); - memcpy(cp->proxy->wq.buf, rwbuf + wc, cc - wc); - cp->proxy->wq.len = cc - wc; - cp->proxy->wq.offset = 0; - } - } else if (cc == 0) { - /* SSL eof */ - DEBUGF(("SSL eof\n")); - cp->eof = 1; - if (cp->proxy->wq.len == 0) { - shutdown(cp->proxy->fd, SHUTDOWN_WRITE); - cp->proxy->bp = 1; - } - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } else { - /* This may very well happen when reading from SSL. */ - DEBUGF(("NOTE: readmask set, cc < 0, fd = %d, " - "is ok\n", cp->fd)); - } - } - break; - - case ESOCK_SSL_SHUTDOWN: - DEBUGF(("-----------------------------------\n")); - DEBUGF(("SSL_SHUTDOWN: fd = %d\n", cp->fd)); - do_shutdown(cp); - break; - - case ESOCK_DEFUNCT: - DEBUGF(("-----------------------------------\n")); - DEBUGF(("DEFUNCT: ERROR: should not happen. fd = %d\n", - cp->fd)); - break; - - case ESOCK_WAIT_CONNECT: - /* New connection shows up */ - connectsock = cp->fd;/* Is published */ - DEBUGF(("-----------------------------------\n")); - DEBUGF(("WAIT_CONNECT fd = %d\n", connectsock)); - - /* If the connection did succeed it's possible to - * fetch the peer name (UNIX); or failure shows in - * exceptmask (WIN32). Sorry for the mess below, but - * we have to have balanced paren's in #ifdefs in - * order not to confuse Emacs' indentation. */ - length = sizeof(iserv_addr); - if ( -#ifdef __WIN32__ - esock_poll_fd_isset_exception(&pollfd, connectsock) -#else - getpeername(connectsock, (struct sockaddr *)&iserv_addr, - &length) < 0 -#endif - ) { - sock_set_errno(ERRNO_CONNREFUSED); - DEBUGF(("connect error: %s\n", psx_errstr())); - reply(ESOCK_CONNECT_ERR, "4s", connectsock, psx_errstr()); - cp->state = ESOCK_DEFUNCT; - break; - } - if (esock_ssl_connect_init(cp) < 0) { - DEBUGF(("esock_ssl_connect_init() failed\n")); - reply(ESOCK_CONNECT_ERR, "4s", connectsock, ssl_errstr()); - cp->state = ESOCK_DEFUNCT; - break; - } - DEBUGF(("-> SSL_CONNECT\n")); - cp->state = ESOCK_SSL_CONNECT; - cp->ssl_want = ESOCK_SSL_WANT_WRITE; - break; - - case ESOCK_SSL_CONNECT: - /* SSL connect handshake. connectsock is published. */ - connectsock = cp->fd; - DEBUGF(("-----------------------------------\n")); - DEBUGF(("SSL_CONNECT fd = %d\n", connectsock)); - if (esock_ssl_connect(cp) < 0) { - if (sock_errno() != ERRNO_BLOCK) { - /* Handshake failed */ - DEBUGF(("ERROR: handshake: %s\n", ssl_errstr())); - reply(ESOCK_CONNECT_ERR, "4s", connectsock, - ssl_errstr()); - cp->state = ESOCK_DEFUNCT; - } - } else { - /* SSL connect handshake successful */ - DEBUGF(("-> CONNECTED\n")); - reply(ESOCK_CONNECT_REP, "4", connectsock); - cp->state = ESOCK_CONNECTED; - } - break; - - default: - DEBUGF(("ERROR: Connection in unknown state.\n")); - } - } - } -} - -static int set_poll_conns(Connection *cp, EsockPoll *ep, int verbose) -{ - int i = 0; - - if (verbose) - DEBUGF(("MASKS SET FOR FD: ")); - while (cp) { - switch (cp->state) { - case ESOCK_ACTIVE_LISTENING: - if (verbose) - DEBUGF(("%d (read) ", cp->fd)); - esock_poll_fd_set_read(ep, cp->fd); - break; - case ESOCK_WAIT_CONNECT: - if (verbose) - DEBUGF(("%d (write) ", cp->fd)); - esock_poll_fd_set_write(ep, cp->fd); -#ifdef __WIN32__ - esock_poll_fd_set_exception(ep, cp->fd); /* Failure shows in exceptions */ -#endif - break; - case ESOCK_SSL_CONNECT: - case ESOCK_SSL_ACCEPT: - if (cp->ssl_want == ESOCK_SSL_WANT_READ) { - if (verbose) - DEBUGF(("%d (read) ", cp->fd)); - esock_poll_fd_set_read(ep, cp->fd); - } else if (cp->ssl_want == ESOCK_SSL_WANT_WRITE) { - if (verbose) - DEBUGF(("%d (write) ", cp->fd)); - esock_poll_fd_set_write(ep, cp->fd); - } - break; - case ESOCK_JOINED: - if (!cp->bp) { - if (cp->wq.len) { - if (verbose) - DEBUGF(("%d (write) ", cp->fd)); - esock_poll_fd_set_write(ep, cp->fd); - } else if (!cp->proxy->eof) { - if (verbose) - DEBUGF(("%d (read) ", cp->proxy->fd)); - esock_poll_fd_set_read(ep, cp->proxy->fd); - } - } - if (!cp->proxy->bp) { - if (cp->proxy->wq.len) { - if (verbose) - DEBUGF(("%d (write) ", cp->proxy->fd)); - esock_poll_fd_set_write(ep, cp->proxy->fd); - } else if (!cp->eof) { - if (verbose) - DEBUGF(("%d (read) ", cp->fd)); - esock_poll_fd_set_read(ep, cp->fd); - } - } - break; - case ESOCK_SSL_SHUTDOWN: - if (cp->ssl_want == ESOCK_SSL_WANT_READ) { - if (verbose) - DEBUGF(("%d (read) ", cp->fd)); - esock_poll_fd_set_read(ep, cp->fd); - } else if (cp->ssl_want == ESOCK_SSL_WANT_WRITE) { - if (verbose) - DEBUGF(("%d (write) ", cp->fd)); - esock_poll_fd_set_write(ep, cp->fd); - } - break; - default: - break; - } - i++; - cp = cp->next; - } - if (verbose) - DEBUGF(("\n")); - return i; -} - - -static Connection *next_polled_conn(Connection *cp, Connection **cpnext, - EsockPoll *ep, int set_wq_fds) -{ - while(cp) { - if (esock_poll_fd_isset_read(ep, cp->fd) || - (cp->proxy && esock_poll_fd_isset_read(ep, cp->proxy->fd)) || - (esock_poll_fd_isset_write(ep, cp->fd)) || - (cp->proxy && esock_poll_fd_isset_write(ep, cp->proxy->fd)) -#ifdef __WIN32__ - || esock_poll_fd_isset_exception(ep, cp->fd) /* Connect failure in WIN32 */ -#endif - || (set_wq_fds && (cp->wq.len || - (cp->proxy && cp->proxy->wq.len))) - || cp->errstr != NULL) { - *cpnext = cp->next; - return cp; - } - cp = cp->next; - } - *cpnext = NULL; - return NULL; -} - -static void leave_joined_state(Connection *cp) -{ - shutdown(cp->proxy->fd, SHUTDOWN_ALL); - if (((cp->bp || cp->eof) && cp->clean) || - (!cp->bp && !cp->eof)) { - DEBUGF(("-> SSL_SHUTDOWN\n")); - cp->state = ESOCK_SSL_SHUTDOWN; - cp->ssl_want = ESOCK_SSL_WANT_WRITE; - do_shutdown(cp); - } else if (cp->close) { - DEBUGF(("-> (removal)\n")); - close_and_remove_connection(cp); - } else { - DEBUGF(("-> DEFUNCT\n")); - cp->state = ESOCK_DEFUNCT; - } -} - -/* We are always in state SHUTDOWN here */ -static void do_shutdown(Connection *cp) -{ - int ret; - - ret = esock_ssl_shutdown(cp); - if (ret < 0) { - if (sock_errno() == ERRNO_BLOCK) { - return; - } else { - /* Something is wrong -- close and remove or move to DEFUNCT */ - DEBUGF(("Error in SSL shutdown\n")); - if (cp->close) { - DEBUGF(("-> (removal)\n")); - close_and_remove_connection(cp); - } else { - DEBUGF(("-> DEFUNCT\n")); - cp->state = ESOCK_DEFUNCT; - } - } - } else if (ret == 0) { - /* `close_notify' has been sent. Wait for reception of - same. */ - return; - } else if (ret == 1) { - /* `close_notify' has been sent, and received. */ - if (cp->close) { - DEBUGF(("-> (removal)\n")); - close_and_remove_connection(cp); - } else { - DEBUGF(("-> DEFUNCT\n")); - cp->state = ESOCK_DEFUNCT; - } - } -} - -static void close_and_remove_connection(Connection *cp) -{ - safe_close(cp->fd); - remove_connection(cp); -} - -static int reply(int cmd, char *fmt, ...) -{ - static unsigned char replybuf[MAXREPLYBUF]; - unsigned char *buf = replybuf; - va_list args; - int len; - - va_start(args, fmt); - len = put_pars(NULL, fmt, args); - va_end(args); - len++; - if (len > sizeof(replybuf)) - buf = esock_malloc(len); - - PUT_INT8(cmd, buf); - va_start(args, fmt); - (void) put_pars(buf + 1, fmt, args); - va_end(args); - write_ctrl(buf, len); - if (buf != replybuf) - esock_free(buf); - return len; -} - -static int input(char *fmt, ...) -{ - va_list args; - int len; - - va_start(args, fmt); - len = get_pars(ebuf + 1, fmt, args); - va_end(args); - return len + 1; -} - -static int put_pars(unsigned char *buf, char *fmt, va_list args) -{ - char *s, *str, *bin; - int val, len, pos = 0; - - s = fmt; - while (*s) { - switch (*s) { - case '1': - val = va_arg(args, int); - if (buf) - PUT_INT8(val, buf + pos); - pos++; - break; - case '2': - val = va_arg(args, int); - if (buf) - PUT_INT16(val, buf + pos); - pos += 2; - break; - case '4': - val = va_arg(args, int); - if (buf) - PUT_INT32(val, buf + pos); - pos += 4; - break; - case 's': /* string */ - str = va_arg(args, char *); - if (buf) - strcpy((char *)(buf + pos), str); - pos += strlen(str) + 1; - break; - case 'b': /* binary */ - len = va_arg(args, int); - if (buf) - PUT_INT32(len, buf + pos); - pos += 4; - bin = va_arg(args, char *); - if (buf) - memcpy(buf + pos, bin, len); - pos += len; - break; - default: - fprintf(stderr, "esock: Invalid format character: %c\n", *s); - exit(EXIT_FAILURE); - break; - } - s++; - } - return pos; -} - - -static int get_pars(unsigned char *buf, char *fmt, va_list args) -{ - int *ip; - char *s, **strp, **bin; - int pos = 0; - - s = fmt; - while (*s) { - switch (*s) { - case '1': - ip = va_arg(args, int *); - *ip = GET_INT8(buf + pos); - pos++; - break; - case '2': - ip = va_arg(args, int *); - *ip = GET_INT16(buf + pos); - pos += 2; - break; - case '4': - ip = va_arg(args, int *); - *ip = GET_INT32(buf + pos); - pos += 4; - break; - case 's': - strp = va_arg(args, char **); - *strp = (char *)(buf + pos); - pos += strlen(*strp) + 1; - break; - case 'b': - ip = va_arg(args, int *); - *ip = GET_INT32(buf + pos); - pos += 4; - bin = va_arg(args, char **); - *bin = (char *)(buf + pos); - pos += *ip; - break; - default: - fprintf(stderr, "esock: Invalid format character: %c\n", *s); - exit(EXIT_FAILURE); - break; - } - s++; - } - return pos; -} - -static FD do_connect(char *lipstring, int lport, char *fipstring, int fport) -{ - struct sockaddr_in sock_addr; - long inaddr; - FD fd; - - if ((fd = socket(AF_INET, SOCK_STREAM, 0)) == INVALID_FD) { - DEBUGF(("Error calling socket()\n")); - return fd; - } - if (check_num_sock_fds(fd) < 0) - return INVALID_FD; - DEBUGF((" fd = %d\n", fd)); - - /* local */ - if ((inaddr = inet_addr(lipstring)) == INADDR_NONE) { - DEBUGF(("Error in inet_addr(): lipstring = %s\n", lipstring)); - safe_close(fd); - sock_set_errno(ERRNO_ADDRNOTAVAIL); - return INVALID_FD; - } - memset(&sock_addr, 0, sizeof(sock_addr)); - sock_addr.sin_family = AF_INET; - sock_addr.sin_addr.s_addr = inaddr; - sock_addr.sin_port = htons(lport); - if(bind(fd, (struct sockaddr*) &sock_addr, sizeof(sock_addr)) < 0) { - DEBUGF(("Error in bind()\n")); - safe_close(fd); - /* XXX Set error code for bind error */ - return INVALID_FD; - } - - /* foreign */ - if ((inaddr = inet_addr(fipstring)) == INADDR_NONE) { - DEBUGF(("Error in inet_addr(): fipstring = %s\n", fipstring)); - safe_close(fd); - sock_set_errno(ERRNO_ADDRNOTAVAIL); - return INVALID_FD; - } - memset(&sock_addr, 0, sizeof(sock_addr)); - sock_addr.sin_family = AF_INET; - sock_addr.sin_addr.s_addr = inaddr; - sock_addr.sin_port = htons(fport); - - SET_NONBLOCKING(fd); - - if(connect(fd, (struct sockaddr*)&sock_addr, sizeof(sock_addr)) < 0) { - if (sock_errno() != ERRNO_PROGRESS && /* UNIX */ - sock_errno() != ERRNO_BLOCK) { /* WIN32 */ - DEBUGF(("Error in connect()\n")); - safe_close(fd); - return INVALID_FD; - } - } - return fd; -} - -static FD do_listen(char *ipstring, int lport, int backlog, int *aport) -{ - static int one = 1; /* Type must be int, not long */ - struct sockaddr_in sock_addr; - long inaddr; - int length; - FD fd; - - if ((fd = socket(AF_INET, SOCK_STREAM, 0)) == INVALID_FD) { - DEBUGF(("Error calling socket()\n")); - return fd; - } - if (check_num_sock_fds(fd) < 0) - return INVALID_FD; - DEBUGF((" fd = %d\n", fd)); - if ((inaddr = inet_addr(ipstring)) == INADDR_NONE) { - DEBUGF(("Error in inet_addr(): ipstring = %s\n", ipstring)); - safe_close(fd); - sock_set_errno(ERRNO_ADDRNOTAVAIL); - return INVALID_FD; - } - memset(&sock_addr, 0, sizeof(sock_addr)); - sock_addr.sin_family = AF_INET; - sock_addr.sin_addr.s_addr = inaddr; - sock_addr.sin_port = htons(lport); - - setsockopt(fd, SOL_SOCKET, SO_REUSEADDR, (void *)&one, sizeof(one)); - - if(bind(fd, (struct sockaddr*) &sock_addr, sizeof(sock_addr)) < 0) { - DEBUGF(("Error in bind()\n")); - safe_close(fd); - return INVALID_FD; - } - if (listen(fd, backlog) < 0) { - DEBUGF(("Error in listen()\n")); - safe_close(fd); - return INVALID_FD; - } - /* find out assigned local port number */ - length = sizeof(sock_addr); - if (getsockname(fd, (struct sockaddr *)&sock_addr, &length) < 0) { - DEBUGF(("Error in getsockname()\n")); - safe_close(fd); - return INVALID_FD; - } - if (aport) - *aport = ntohs(sock_addr.sin_port); - return fd; -} - -static FD do_accept(FD listensock, struct sockaddr *saddr, int *len) -{ - FD fd; - - if ((fd = accept(listensock, saddr, len)) == INVALID_FD) { - DEBUGF(("Error calling accept()\n")); - return fd; - } - if (check_num_sock_fds(fd) < 0) - return INVALID_FD; - return fd; -} - -static Connection *new_connection(int state, FD fd) -{ - Connection *cp; - - if (!(cp = esock_malloc(sizeof(Connection)))) - return NULL; - cp->state = state; - cp->acceptors = 0; - cp->fd = fd; - cp->listen_fd = INVALID_FD; - cp->proxy = NULL; - cp->opaque = NULL; - cp->ssl_want = 0; - cp->eof = 0; - cp->bp = 0; - cp->clean = 0; /* XXX Used? */ - cp->close = 0; - cp->origin = -1; - cp->flags = NULL; - cp->logfp = NULL; - cp->wq.size = 0; - cp->wq.buf = NULL; - cp->wq.len = 0; - cp->wq.offset = 0; - cp->next = connections; - cp->errstr = NULL; - connections = cp; - return cp; -} - - -static void print_connections(void) -{ - if (debug) { - Connection *cp = connections; - DEBUGF(("CONNECTIONS:\n")); - while (cp) { - if (cp->state == ESOCK_JOINED) { - DEBUGF((" - %s [%8p] (origin = %s)\n" - " (fd = %d, eof = %d, wq = %d, bp = %d)\n" - " (proxyfd = %d, eof = %d, wq = %d, bp = %d)\n", - connstr[cp->state], cp, originstr[cp->origin], - cp->fd, cp->eof, cp->wq.len, cp->bp, - cp->proxy->fd, cp->proxy->eof, cp->proxy->wq.len, - cp->proxy->bp)); - } else if (cp->state == ESOCK_ACTIVE_LISTENING) { - DEBUGF((" - %s [%8p] (fd = %d, acceptors = %d)\n", - connstr[cp->state], cp, cp->fd, cp->acceptors)); - } else { - DEBUGF((" - %s [%8p] (fd = %d)\n", connstr[cp->state], cp, - cp->fd)); - } - cp= cp->next; - } - } -} - -static void dump_connections(void) -{ - Connection *cp = connections; - Proxy *pp = proxies; - time_t t = time(NULL); - int length = 0; - struct sockaddr_in iserv_addr; - - __debugprintf("CONNECTIONS %s", ctime(&t)); - while (cp) { - if (cp->state == ESOCK_JOINED) { - __debugprintf(" - %s [%8p] (origin = %s)\n" - " (fd = %d, eof = %d, wq = %d, bp = %d), close = %d\n" - " (proxyfd = %d, eof = %d, wq = %d, bp = %d)\n", - connstr[cp->state], cp, originstr[cp->origin], - cp->fd, cp->eof, cp->wq.len, cp->bp, cp->close, - cp->proxy->fd, cp->proxy->eof, cp->proxy->wq.len, - cp->proxy->bp); - } else if (cp->state == ESOCK_ACTIVE_LISTENING) { - __debugprintf(" - %s [%8p] (fd = %d, acceptors = %d)\n", - connstr[cp->state], cp, cp->fd, cp->acceptors); - } else { - __debugprintf(" - %s [%8p] (fd = %d)\n", connstr[cp->state], cp, - cp->fd); - } - length = sizeof(iserv_addr); - if ((cp->state == ESOCK_ACTIVE_LISTENING) || - (cp->state == ESOCK_PASSIVE_LISTENING)) { - getsockname(cp->fd, (struct sockaddr *) &iserv_addr, &length); - __debugprintf(" (ip = %s, port = %d)\n", - inet_ntoa(iserv_addr.sin_addr), - ntohs(iserv_addr.sin_port)); - } - else { - getsockname(cp->fd, (struct sockaddr *) &iserv_addr, &length); - __debugprintf(" (local_ip = %s, local_port = %d)\n", - inet_ntoa(iserv_addr.sin_addr), - ntohs(iserv_addr.sin_port)); - length = sizeof(iserv_addr); - getpeername(cp->fd, (struct sockaddr *) &iserv_addr, &length); - __debugprintf(" (remote_ip = %s, remote_port = %d)\n", - inet_ntoa(iserv_addr.sin_addr), - ntohs(iserv_addr.sin_port)); - } - cp=cp->next; - } - - __debugprintf("PROXIES\n"); - while (pp) { - __debugprintf(" - fd = %d [%8p] (external_fd = %d, peer_port = %d," - " eof = %d)\n", pp->fd, pp, pp->conn->fd, pp->peer_port, - pp->eof); - - pp= pp->next; - } -} - -static Connection *get_connection(FD fd) -{ - Connection *cp = connections; - - while(cp) { - if(cp->fd == fd) - return cp; - cp = cp->next; - } - return NULL; -} - -/* - * Remove a connection from the list of connection, close the proxy - * socket and free all resources. The main socket (fd) is *not* - * closed here, because the closing of that socket has to be synchronized - * with the Erlang process controlling this port program. - */ -static void remove_connection(Connection *conn) -{ - Connection **prev = &connections; - Connection *cp = connections; - - while (cp) { - if(cp == conn) { - DEBUGF(("remove_connection: fd = %d\n", cp->fd)); - esock_ssl_free(cp); /* frees cp->opaque only */ - esock_free(cp->flags); - closelog(cp->logfp); /* XXX num_sock_fds */ - esock_free(cp->wq.buf); - if (cp->proxy) { - safe_close(cp->proxy->fd); - remove_proxy(cp->proxy); - } - *prev = cp->next; - esock_free(cp); - return; - } - prev = &cp->next; - cp = cp->next; - } -} - -static Proxy *get_proxy_by_peerport(int port) -{ - Proxy *p = proxies; - - while(p) { - if (p->peer_port == port) - return p; - p = p->next; - } - return NULL; -} - -static Proxy *new_proxy(FD fd) -{ - Proxy *p; - - if (!(p = esock_malloc(sizeof(Proxy)))) - return NULL; - - p->fd = fd; - p->peer_port = -1; - p->eof = 0; - p->bp = 0; - p->conn = NULL; - p->wq.size = 0; - p->wq.buf = NULL; - p->wq.len = 0; - p->wq.offset = 0; - p->next = proxies; - proxies = p; - return p; -} - -static void remove_proxy(Proxy *proxy) -{ - Proxy *p = proxies, **pp = &proxies; - - while(p) { - if (p == proxy) { - DEBUGF(("remove_proxyfd = %d\n", p->fd)); - esock_free(p->wq.buf); - *pp = p->next; - esock_free(p); - return; - } - pp = &p->next; - p = p->next; - } -} - -static int check_num_sock_fds(FD fd) -{ - num_sock_fds++; /* fd is valid */ -#ifdef USE_SELECT - if (num_sock_fds > FD_SETSIZE) { - num_sock_fds--; - sock_set_errno(ERRNO_MFILE); - safe_close(fd); - return -1; - } -#endif - return 0; -} - -static void safe_close(FD fd) -{ - int err; - - err = sock_errno(); - DEBUGF(("safe_close fd = %d\n", fd)); - if (sock_close(fd) < 0) { - DEBUGF(("safe_close failed\n")); - } else { - num_sock_fds--; - } - sock_set_errno(err); -} - -static void clean_up(void) -{ - Connection *cp, *cpnext; - Proxy *pp, *ppnext; - - cp = connections; - while (cp) { - safe_close(cp->fd); - cpnext = cp->next; - remove_connection(cp); - cp = cpnext; - } - - pp = proxies; - while (pp) { - safe_close(pp->fd); - ppnext = pp->next; - remove_proxy(pp); - pp = ppnext; - } -} - -static void ensure_write_queue(WriteQueue *wq, int size) -{ - if (wq->size < size) { - wq->buf = esock_realloc(wq->buf, size); - wq->size = size; - } -} - - - - - - - diff --git a/lib/ssl/c_src/esock.h b/lib/ssl/c_src/esock.h deleted file mode 100644 index 16c9faa530..0000000000 --- a/lib/ssl/c_src/esock.h +++ /dev/null @@ -1,273 +0,0 @@ -/*<copyright> - * <year>1999-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * 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. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -/* - * Purpose: Implementation of Secure Socket Layer (SSL). - * - */ - -#ifndef ESOCK_H -#define ESOCK_H - -#ifdef __WIN32__ -#include "esock_winsock.h" -#endif -#include <stdio.h> - -#ifdef __WIN32__ -#define INVALID_FD INVALID_SOCKET - -#define sock_read(fd, buf, len) recv((fd), (buf), (len), 0) -#define sock_write(fd, buf, len) send((fd), (buf), (len), 0) -#define sock_close(fd) closesocket(fd) -#define sock_errno() WSAGetLastError() -#define sock_set_errno(err) WSASetLastError(err) - -#define ERRNO_NONE 0 -#define ERRNO_BLOCK WSAEWOULDBLOCK -#define ERRNO_CONNREFUSED WSAECONNREFUSED -#define ERRNO_PROGRESS WSAEINPROGRESS -#define ERRNO_PROTONOSUPPORT WSAEPROTONOSUPPORT -#define ERRNO_INVAL WSAEINVAL -#define ERRNO_ADDRNOTAVAIL WSAEADDRNOTAVAIL -#define ERRNO_NOTSOCK WSAENOTSOCK -#define ERRNO_OPNOTSUPP WSAEOPNOTSUPP -#define ERRNO_MFILE WSAEMFILE -#define SET_BLOCKING(fd) do { \ - unsigned long zeroval = 0; \ - ioctlsocket((fd), FIONBIO, &zeroval); \ - } while (0) -#define SET_NONBLOCKING(fd) do { \ - unsigned long oneval = 1; \ - ioctlsocket((fd), FIONBIO, &oneval); \ - } while (0) -#else -#define INVALID_FD (-1) - -#define sock_read(fd, buf, len) read((fd), (buf), (len)) -#define sock_write(fd, buf, len) write((fd), (buf), (len)) -#define sock_close(fd) close(fd) -#define sock_errno() errno -#define sock_set_errno(err) do {errno = (err);} while(0) - -#define ERRNO_NONE 0 -#define ERRNO_BLOCK EAGAIN -#define ERRNO_CONNREFUSED ECONNREFUSED -#define ERRNO_PROGRESS EINPROGRESS -#define ERRNO_PROTONOSUPPORT EPROTONOSUPPORT -#define ERRNO_INVAL EINVAL -#define ERRNO_ADDRNOTAVAIL EADDRNOTAVAIL -#define ERRNO_NOTSOCK ENOTSOCK -#define ERRNO_OPNOTSUPP EOPNOTSUPP -#define ERRNO_MFILE EMFILE -#define SET_BLOCKING(fd) fcntl((fd), F_SETFL, \ - fcntl((fd), F_GETFL, 0) & ~O_NONBLOCK) -#define SET_NONBLOCKING(fd) fcntl((fd), F_SETFL, \ - fcntl((fd), F_GETFL, 0) | O_NONBLOCK) -#endif - -#define GET_INT8(s) ((s)[0]) -#define GET_INT16(s) (((s)[0] << 8) | (s)[1]) -#define GET_INT32(s) (((s)[0] << 24) | ((s)[1] << 16) | \ - ((s)[2] << 8) | (s)[3]) - -#define PUT_INT8(x, s) do { (s)[0] = x; } while(0) -#define PUT_INT16(x, s) do { (s)[0] = ((x) >> 8) & 0xff; \ - (s)[1] = ((x) & 0xff); } while(0) -#define PUT_INT32(x, s) do { (s)[0] = ((x) >> 24) & 0xff; \ - (s)[1] = ((x) >> 16) & 0xff; \ - (s)[2] = ((x) >> 8) & 0xff; \ - (s)[3] = (x) & 0xff; } while(0) - -/* type for Connections */ -#define ESOCK_STATE_NONE 0 -#define ESOCK_ACTIVE_LISTENING 1 -#define ESOCK_PASSIVE_LISTENING 2 -#define ESOCK_CONNECTED 3 -#define ESOCK_WAIT_CONNECT 4 -#define ESOCK_SSL_CONNECT 5 -#define ESOCK_SSL_ACCEPT 6 -#define ESOCK_TRANSPORT_ACCEPT 7 -#define ESOCK_JOINED 8 -#define ESOCK_SSL_SHUTDOWN 9 -#define ESOCK_DEFUNCT 10 - -#ifdef __WIN32__ - typedef SOCKET FD; -#else - typedef int FD; -#endif - -/* For the shutdown(fd, how) call */ -#ifdef __WIN32__ -#define SHUTDOWN_READ SD_RECEIVE -#define SHUTDOWN_WRITE SD_SEND -#define SHUTDOWN_ALL SD_BOTH -#else -#define SHUTDOWN_READ 0 -#define SHUTDOWN_WRITE 1 -#define SHUTDOWN_ALL 2 -#endif - -#define ORIG_LISTEN 0 -#define ORIG_ACCEPT 1 -#define ORIG_CONNECT 2 - -typedef struct { - int size; /* Total size of buf */ - unsigned char *buf; - int len; /* Current number of bytes in buf */ - int offset; /* Bytes already written */ -} WriteQueue; - -typedef struct _proxy Proxy; - -typedef struct Connection { - FD fd; - FD listen_fd; /* Needed for async listen error */ - unsigned char state; - int acceptors; /* Count acceptors for listen socket */ - Proxy *proxy; - void *opaque; /* Any suitable ssl structure */ - int ssl_want; /* read/write flags */ - int eof; /* end of file (read) */ - int bp; /* broken pipe (write) */ - int clean; /* Clean SSL shutdown initiated */ - int close; /* Close if set */ - int origin; /* listen, accept or connect */ - int encrypted; /* 1 = SSL encrypted, 0 = normal, unencrypted tcp */ - char *flags; /* ssl parameters */ - FILE *logfp; /* connection log file (not used) */ - WriteQueue wq; - struct Connection* next; - const char* errstr; /* only used to report errors from ssl_accept_init in SSL_ACCEPT */ -} Connection; - -struct _proxy { - FD fd; - int peer_port; - int eof; /* end of file (read) */ - int bp; /* broken pipe (write) */ - Connection *conn; - WriteQueue wq; - Proxy *next; -}; - -/* Commands, replies, and error responses */ - -#define ESOCK_CONNECT_CMD 1 -#define ESOCK_CONNECT_WAIT_REP 2 -#define ESOCK_CONNECT_REP 3 -#define ESOCK_CONNECT_ERR 4 - -#define ESOCK_TERMINATE_CMD 5 -#define ESOCK_CLOSE_CMD 6 - -#define ESOCK_LISTEN_CMD 7 -#define ESOCK_LISTEN_REP 8 -#define ESOCK_LISTEN_ERR 9 - -#define ESOCK_TRANSPORT_ACCEPT_CMD 10 -#define ESOCK_NOACCEPT_CMD 11 -#define ESOCK_TRANSPORT_ACCEPT_REP 12 -#define ESOCK_TRANSPORT_ACCEPT_ERR 13 - -#define ESOCK_FROMNET_CLOSE_REP 14 - -#define ESOCK_CONNECT_SYNC_ERR 15 -#define ESOCK_LISTEN_SYNC_ERR 16 - -#define ESOCK_PROXY_PORT_REP 23 -#define ESOCK_PROXY_JOIN_CMD 24 -#define ESOCK_PROXY_JOIN_REP 25 -#define ESOCK_PROXY_JOIN_ERR 26 - -#define ESOCK_SET_SOCKOPT_CMD 27 -#define ESOCK_IOCTL_OK 28 -#define ESOCK_IOCTL_ERR 29 - -#define ESOCK_GETPEERNAME_CMD 30 -#define ESOCK_GETPEERNAME_REP 31 -#define ESOCK_GETPEERNAME_ERR 32 - -#define ESOCK_GETSOCKNAME_CMD 33 -#define ESOCK_GETSOCKNAME_REP 34 -#define ESOCK_GETSOCKNAME_ERR 35 - -#define ESOCK_GETPEERCERT_CMD 36 -#define ESOCK_GETPEERCERT_REP 37 -#define ESOCK_GETPEERCERT_ERR 38 - -#define ESOCK_GETVERSION_CMD 39 -#define ESOCK_GETVERSION_REP 40 - -#define ESOCK_SET_SEED_CMD 41 - -#define ESOCK_GETCONNINFO_CMD 42 -#define ESOCK_GETCONNINFO_REP 43 -#define ESOCK_GETCONNINFO_ERR 44 - -#define ESOCK_SSL_ACCEPT_CMD 45 -#define ESOCK_SSL_ACCEPT_REP 46 -#define ESOCK_SSL_ACCEPT_ERR 47 - -#define ESOCK_DUMP_STATE_CMD 48 -#define ESOCK_SET_DEBUG_CMD 49 -#define ESOCK_SET_DEBUGMSG_CMD 50 - - -/* Option codes for ESOCK_SET_SOCKOPT_CMD */ -#define ESOCK_SET_TCP_NODELAY 1 - -/* SSL want to read or write */ -#define ESOCK_SSL_WANT_READ 1 -#define ESOCK_SSL_WANT_WRITE 2 - -/* Protocol version according to ssl_server */ -#define ESOCK_SSLv2 1 -#define ESOCK_SSLv3 2 -#define ESOCK_TLSv1 4 - - -#endif - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/lib/ssl/c_src/esock_openssl.c b/lib/ssl/c_src/esock_openssl.c deleted file mode 100644 index 0bc42958f0..0000000000 --- a/lib/ssl/c_src/esock_openssl.c +++ /dev/null @@ -1,1213 +0,0 @@ -/*<copyright> - * <year>1999-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * 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. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -/* - * Purpose: Adaptions for the OpenSSL package. - * - * This file implements the functions defined in esock_ssl.h for - * the OpenSSL package. - * - * The following holds true for non-blockling I/O: - * - * Function Return values - * -------- ------------- - * SSL_accept() success: 1, failure: =<0 - * SSL_connect() success: 1, failure: =<0 - * SSL_read() success: >0, eof: 0, failure: <0 - * SSL_write() success: > 0, failure: =<0 - * SSL_shutdown() success: 1, not finished: 0 - * - * If the return value of any of the above functions is `ret' and the - * ssl connection is `ssl', the call - * - * ssl_error = SSL_get_error(ssl, ret); - * - * returns one of the following eight values: - * - * SSL_ERROR_NONE ret > 0 - * SSL_ERROR_ZERO_RETURN ret = 0 - * SSL_ERROR_WANT_READ ret < 0 and ssl wants to read - * SSL_ERROR_WANT_WRITE ret < 0 and ssl wants to write - * SSL_ERROR_SYSCALL ret < 0 or ret = 0 - * SSL_ERROR_SSL if there was an ssl internal error - * SSL_ERROR_WANT_X509_LOOKUP ret < 0 and ssl wants x509 lookup - * SSL_ERROR_WANT_CONNECT ret < 0 and ssl wants connect - * - * It is the case that SSL_read() sometimes returns -1, even when the - * underlying file descriptor is ready for reading. - * - * Also, sometimes we may have SSL_ERROR_SSL in SSL_accept() and SSL_connect() - * when a retry should be done. - * - */ - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <errno.h> -#ifndef __WIN32__ -# include <fcntl.h> -# include <unistd.h> -#endif - -#include "esock.h" -#include "esock_ssl.h" -#include "debuglog.h" -#include "esock_utils.h" -#include "esock_posix_str.h" - -#include <openssl/crypto.h> -#include <openssl/ssl.h> -#include <openssl/err.h> -#include <openssl/rand.h> - -int ephemeral_rsa = 0; -int ephemeral_dh = 0; /* XXX Not used yet */ -int protocol_version = 0; - -char *esock_ssl_errstr = ""; - -#define FLAGSBUFSIZE 512 -#define X509BUFSIZE 256 -#define DEFAULT_VERIFY_DEPTH 1 - -#define SET_WANT(cp, ssl_error) \ - switch((ssl_error)) { \ - case SSL_ERROR_WANT_READ: \ - (cp)->ssl_want = ESOCK_SSL_WANT_READ; \ - break; \ - case SSL_ERROR_WANT_WRITE: \ - (cp)->ssl_want = ESOCK_SSL_WANT_WRITE; \ - break; \ - default: \ - (cp)->ssl_want = 0; \ - break; \ - } - -#define RESET_ERRSTR() \ - esock_ssl_errstr = ""; - -#define MAYBE_SET_ERRSTR(s) \ - if (!esock_ssl_errstr[0]) \ - esock_ssl_errstr = (s); - -typedef struct { - int code; - char *text; -} err_entry; - -typedef struct { - SSL_CTX *ctx; - char *passwd; - int verify_depth; -} callback_data; - -static char *ssl_error_str(int error); -static void end_ssl_call(int ret, Connection *cp, int ssl_error); -static void check_shutdown(Connection *cp); -static int set_ssl_parameters(Connection *cp, SSL_CTX *ctx); -static int verify_callback(int ok, X509_STORE_CTX *ctx); -static int passwd_callback(char *buf, int num, int rwflag, void *userdata); -static void info_callback(const SSL *ssl, int where, int ret); -static void callback_data_free(void *parent, void *ptr, - CRYPTO_EX_DATA *ad, - int idx, long arg1, void *argp); -static RSA *tmp_rsa_callback(SSL *ssl, int is_export, int keylen); -static void restrict_protocols(SSL_CTX *ctx); - -static err_entry errs[] = { - {SSL_ERROR_NONE, "SSL_ERROR_NONE"}, - {SSL_ERROR_ZERO_RETURN, "SSL_ERROR_ZERO_RETURN"}, - {SSL_ERROR_WANT_READ, "SSL_ERROR_WANT_READ"}, - {SSL_ERROR_WANT_WRITE, "SSL_ERROR_WANT_WRITE"}, - {SSL_ERROR_SYSCALL, "SSL_ERROR_SYSCALL"}, - {SSL_ERROR_SSL, "SSL_ERROR_SSL"}, - {SSL_ERROR_WANT_X509_LOOKUP, "SSL_ERROR_WANT_X509_LOOKUP"}, - {SSL_ERROR_WANT_CONNECT, "SSL_ERROR_WANT_CONNECT"} -}; - -static SSL_METHOD *method; /* for listen and connect init */ -static char x509_buf[X509BUFSIZE]; /* for verify_callback */ -static int callback_data_index = -1; /* for ctx ex_data */ -static unsigned char randvec[1024]; /* XXX */ - -#if defined(__WIN32__) || OPEN_MAX > 256 -# define FOPEN_WORKAROUND(var, expr) var = (expr) -# define VOID_FOPEN_WORKAROUND(expr) expr -#else -/* - * This is an ugly workaround. On Solaris, fopen() will return NULL if - * it gets a file descriptor > 255. To avoid that, we'll make sure that - * there is always one low-numbered file descriptor available when - * fopen() is called. - */ -static int reserved_fd; /* Reserve a low-numbered file descriptor */ -# define USE_FOPEN_WORKAROUND 1 - -# define FOPEN_WORKAROUND(var, expr) \ -do { \ - close(reserved_fd); \ - var = (expr); \ - reserved_fd = open("/dev/null", O_RDONLY); \ -} while (0) - -# define VOID_FOPEN_WORKAROUND(expr) \ -do { \ - close(reserved_fd); \ - expr; \ - reserved_fd = open("/dev/null", O_RDONLY); \ -} while (0) -#endif - -esock_version *esock_ssl_version(void) -{ - static esock_version vsn; - - vsn.compile_version = OPENSSL_VERSION_TEXT; - vsn.lib_version = SSLeay_version(SSLEAY_VERSION); - return &vsn; -} - -char *esock_ssl_ciphers(void) -{ - SSL_CTX *ctx; - SSL *ssl; - char *ciphers; - const char *cp; - int i = 0, used = 0, len, incr = 1024; - - if (!(ctx = SSL_CTX_new(method))) - return NULL; - restrict_protocols(ctx); - if (!(ssl = SSL_new(ctx))) { - SSL_CTX_free(ctx); - return NULL; - } - - ciphers = esock_malloc(incr); - len = incr; - *ciphers = '\0'; - - while (1) { - if (!(cp = SSL_get_cipher_list(ssl, i))) - break; - if (i > 0) { - if (used == len) { - len += incr; - ciphers = esock_realloc(ciphers, len); - } - strcat(ciphers, ":"); - used++; - } - if (strlen(cp) + used >= len) { - len += incr; - ciphers = esock_realloc(ciphers, len); - } - strcat(ciphers, cp); - used += strlen(cp); - i++; - } - SSL_free(ssl); - SSL_CTX_free(ctx); - return ciphers; -} - -void esock_ssl_seed(void *buf, int len) -{ - RAND_seed(buf, len); - - /* XXX Maybe we should call RAND_status() and check if we have got - * enough randomness. - */ -} - -int esock_ssl_init(void) -{ - method = SSLv23_method(); /* SSLv2, SSLv3 and TLSv1, may be restricted - in listen and connect */ - SSL_load_error_strings(); - SSL_library_init(); - esock_ssl_seed(randvec, sizeof(randvec)); - callback_data_index = SSL_CTX_get_ex_new_index(0, "callback_data", - NULL, NULL, - callback_data_free); -#ifdef USE_FOPEN_WORKAROUND - reserved_fd = open("/dev/null", O_RDONLY); - DEBUGF(("init: reserved_fd=%d\r\n", reserved_fd)); -#endif - return 0; -} - - -void esock_ssl_finish(void) -{ - /* Nothing */ -} - - -void esock_ssl_free(Connection *cp) -{ - SSL *ssl = cp->opaque; - SSL_CTX *ctx; - - if (ssl) { - ctx = SSL_get_SSL_CTX(ssl); - SSL_free(ssl); - if (cp->origin != ORIG_ACCEPT) - SSL_CTX_free(ctx); - cp->opaque = NULL; - } -} - - -/* - * Print SSL specific errors. - */ -void esock_ssl_print_errors_fp(FILE *fp) -{ - ERR_print_errors_fp(fp); -} - - -int esock_ssl_accept_init(Connection *cp, void *listenssl) -{ - SSL_CTX *listenctx; - SSL *ssl; - - RESET_ERRSTR(); - MAYBE_SET_ERRSTR("esslacceptinit"); - - if(!listenssl) { - DEBUGF(("esock_ssl_accept_init: listenssl null\n")); - return -1; - } - if (!(listenctx = SSL_get_SSL_CTX(listenssl))) { - DEBUGF(("esock_ssl_accept_init: SSL_get_SSL_CTX\n")); - return -1; - } - if (!(ssl = cp->opaque = SSL_new(listenctx))) { - DEBUGF(("esock_ssl_accept_init: SSL_new(listenctx)\n")); - return -1; - } - SSL_set_fd(ssl, cp->fd); - return 0; - -} - - -int esock_ssl_connect_init(Connection *cp) -{ - SSL_CTX *ctx; - SSL *ssl; - - RESET_ERRSTR(); - MAYBE_SET_ERRSTR("esslconnectinit"); - - if (!(ctx = SSL_CTX_new(method))) - return -1; - if (set_ssl_parameters(cp, ctx) < 0) { - SSL_CTX_free(ctx); - return -1; - } - restrict_protocols(ctx); - if (!(ssl = cp->opaque = SSL_new(ctx))) { - SSL_CTX_free(ctx); - return -1; - } - SSL_set_fd(ssl, cp->fd); - return 0; -} - - -int esock_ssl_listen_init(Connection *cp) -{ - SSL_CTX *ctx; - SSL *ssl; - - RESET_ERRSTR(); - MAYBE_SET_ERRSTR("essllisteninit"); - - if (!(ctx = SSL_CTX_new(method))) - return -1; - if (set_ssl_parameters(cp, ctx) < 0) { - SSL_CTX_free(ctx); - return -1; - } - restrict_protocols(ctx); - - /* The allocation of ctx is for setting ssl parameters, so that - * accepts can inherit them. We allocate ssl to be able to - * refer to it via cp->opaque, but will not be used otherwise. - */ - if (!(ssl = cp->opaque = SSL_new(ctx))) { - SSL_CTX_free(ctx); - return -1; - } - /* Set callback for temporary ephemeral RSA key generation. - * Note: for servers only. */ - SSL_CTX_set_tmp_rsa_callback(ctx, tmp_rsa_callback); - return 0; -} - -/* - * esock_ssl_accept(Connection *cp) - * - */ -int esock_ssl_accept(Connection *cp) -{ - int ret, ssl_error; - SSL *ssl = cp->opaque; - - RESET_ERRSTR(); - - DEBUGF(("esock_ssl_accept: calling SSL_accept fd = %d\n" - " state before: %s\n", cp->fd, SSL_state_string(ssl))); - ret = SSL_accept(ssl); - DEBUGF((" sock_errno %d errno %d \n", sock_errno(), errno)); - ssl_error = SSL_get_error(ssl, ret); - DEBUGF((" SSL_accept = %d\n" - " ssl_error: %s\n" - " state after: %s\n", - ret, ssl_error_str(ssl_error), SSL_state_string(ssl))); - DEBUGF((" ret %d os error %s\n", ret, strerror(errno))); - if (ret > 0) - return ret; - else if (ret == 0) { - const char* f; int l; unsigned int e; - while ((e = ERR_get_error_line(&f, &l))) { - DEBUGF((" error %s:%d %s\n", f, l, ssl_error_str(e))); - } - /* permanent accept error */ - sock_set_errno(ERRNO_NONE); - MAYBE_SET_ERRSTR("esslaccept"); - return -1; - } - end_ssl_call(ret, cp, ssl_error); - return ret; -} - -/* - * esock_ssl_connect(Connection *cp) - * - */ -int esock_ssl_connect(Connection *cp) -{ - int ret, ssl_error; - SSL *ssl = cp->opaque; - - RESET_ERRSTR(); - - DEBUGF(("esock_ssl_connect: calling SSL_connect fd = %d\n" - " state before: %s\n", cp->fd, SSL_state_string(ssl))); - ret = SSL_connect(ssl); - ssl_error = SSL_get_error(ssl, ret); - DEBUGF((" SSL_connect() = %d\n" - " ssl_error: %s\n" - " state after: %s\n", - ret, ssl_error_str(ssl_error), SSL_state_string(ssl))); - if (ret > 0) - return ret; - else if (ret == 0) { - /* permanent connect error */ - sock_set_errno(ERRNO_NONE); - MAYBE_SET_ERRSTR("esslconnect"); - return -1; - } - end_ssl_call(ret, cp, ssl_error); - return ret; -} - - -int esock_ssl_session_reused(Connection *cp) -{ - SSL *ssl = cp->opaque; - - return SSL_session_reused(ssl); -} - - -/* esock_ssl_read(Connection *cp, char *buf, int len) - * - * Read at most `len' chars into `buf'. Returns number of chars - * read ( > 0), or 0 at EOF, or -1 on error. Sets cp->eof, cp->bp if - * appropriate. - */ - -int esock_ssl_read(Connection *cp, char *buf, int len) -{ - int ret, ssl_error; - SSL *ssl = cp->opaque; - - RESET_ERRSTR(); - DEBUGF(("esock_ssl_read: calling SSL_read fd = %d\n" - " state before: %s\n", cp->fd, SSL_state_string(ssl))); - - ret = SSL_read(ssl, buf, len); - ssl_error = SSL_get_error(ssl, ret); - - DEBUGF((" SSL_read = %d\n" - " ssl_error: %s\n" - " state after: %s\n", - ret, ssl_error_str(ssl_error), SSL_state_string(ssl))); - - if (ssl_error == SSL_ERROR_NONE) { - DEBUGMSGF(("message (hex) : [%3.*a]\n", ret, buf)); - DEBUGMSGF(("message (char): [%3.*b]\n", ret, buf)); - } - if (ret > 0) - return ret; - if (ret == 0) { - check_shutdown(cp); - return ret; - } - end_ssl_call(ret, cp, ssl_error); - return ret; -} - -/* - * esock_ssl_write(Connection *cp, char *buf, int len) - * - * Writes at most `len' chars from `buf'. Returns number of chars - * written, or -1 on error. - */ -int esock_ssl_write(Connection *cp, char *buf, int len) -{ - int ret, ssl_error; - SSL *ssl = cp->opaque; - - RESET_ERRSTR(); - DEBUGF(("esock_ssl_write: calling SSL_write fd = %d\n" - " state before: %s\n", cp->fd, SSL_state_string(ssl))); - ret = SSL_write(ssl, buf, len); - ssl_error = SSL_get_error(ssl, ret); - DEBUGF((" SSL_write = %d\n" - " ssl_error: %s\n" - " state after: %s\n", - ret, ssl_error_str(ssl_error), SSL_state_string(ssl))); - if (ssl_error == SSL_ERROR_NONE) { - DEBUGMSGF(("message (hex) : [%3.*a]\n", ret, buf)); - DEBUGMSGF(("message (char): [%3.*b]\n", ret, buf)); - } - if (ret > 0) - return ret; - if (ret == 0) { - check_shutdown(cp); - return ret; - } - end_ssl_call(ret, cp, ssl_error); - return ret; -} - - -int esock_ssl_shutdown(Connection *cp) -{ - int ret, ssl_error; - SSL *ssl = cp->opaque; - - RESET_ERRSTR(); - DEBUGF(("esock_ssl_shutdown: calling SSL_shutdown fd = %d\n" - " state before: %s\n", cp->fd, SSL_state_string(ssl))); - ret = SSL_shutdown(ssl); - ssl_error = SSL_get_error(ssl, ret); - DEBUGF((" SSL_shutdown = %d\n" - " ssl_error: %s\n" - " state after: %s\n", - ret, ssl_error_str(ssl_error), SSL_state_string(ssl))); - if (ret >= 0) { - check_shutdown(cp); - return ret; - } - end_ssl_call(ret, cp, ssl_error); - return ret; -} - - -/* Returns total number of bytes in DER encoded cert pointed to by - * *buf, which is allocated by this function, unless return < 0. - * XXX X509_free ?? - */ -int esock_ssl_getpeercert(Connection *cp, unsigned char **buf) -{ - int len; - SSL *ssl = cp->opaque; - X509 *x509; - unsigned char *tmp; - - RESET_ERRSTR(); - if((x509 = SSL_get_peer_certificate(ssl)) == NULL) { - MAYBE_SET_ERRSTR("enopeercert"); /* XXX doc */ - return -1; - } - - if ((len = i2d_X509(x509, NULL)) <= 0) { - MAYBE_SET_ERRSTR("epeercert"); - return -1; - } - - tmp = *buf = esock_malloc(len); - - /* We must use a temporary value here, since i2d_X509(X509 *x, - * unsigned char **out) increments *out. - */ - if (i2d_X509(x509, &tmp) < 0) { - esock_free(tmp); - MAYBE_SET_ERRSTR("epeercert"); - return -1; - } - return len; -} - -/* Returns total number of bytes in chain of certs. Each cert begins - * with a 4-bytes length. The last cert is ended with 4-bytes of - * zeros. The result is returned in *buf, which is allocated unless - * the return value is < 0. - * XXX X509_free ? sk_X509_free ? - * XXX X509_free is reference counting. - */ -int esock_ssl_getpeercertchain(Connection *cp, unsigned char **buf) -{ - SSL *ssl = cp->opaque; - STACK_OF(X509) *x509_stack; - X509 *x509; - int num, i, totlen, pos, *der_len; - unsigned char *vbuf; - - RESET_ERRSTR(); - if((x509_stack = SSL_get_peer_cert_chain(ssl)) == NULL) { - MAYBE_SET_ERRSTR("enopeercertchain"); /* XXX doc */ - return -1; - } - - num = sk_X509_num(x509_stack); - der_len = esock_malloc(num * sizeof(int)); - totlen = 0; - - for (i = 0; i < num; i++) { - x509 = sk_X509_value(x509_stack, i); - totlen += 4; - if ((der_len[i] = i2d_X509(x509, NULL)) < 0) { - MAYBE_SET_ERRSTR("epeercertchain"); - esock_free(der_len); - return -1; - } - totlen += der_len[i]; - } - totlen += 4; - - vbuf = *buf = esock_malloc(totlen); - pos = 0; - - for (i = 0; i < num; i++) { - x509 = sk_X509_value(x509_stack, i); - PUT_INT32(der_len[i], vbuf); - vbuf += 4; - /* Note: i2d_X509 increments vbuf */ - if (i2d_X509(x509, &vbuf) < 0) { - MAYBE_SET_ERRSTR("epeercertchain"); - esock_free(*buf); - esock_free(der_len); - return -1; - } - } - esock_free(der_len); - return totlen; -} - - -int esock_ssl_getprotocol_version(Connection *cp, char **buf) -{ - SSL *ssl = cp->opaque; - - RESET_ERRSTR(); - if (!ssl) { - MAYBE_SET_ERRSTR("enoent"); - return -1; - } - *buf = (char *) SSL_get_version(ssl); - - return 0; -} - - -int esock_ssl_getcipher(Connection *cp, char **buf) -{ - SSL *ssl = cp->opaque; - - RESET_ERRSTR(); - if (!ssl) { - MAYBE_SET_ERRSTR("enoent"); - return -1; - } - *buf = (char *) SSL_get_cipher(ssl); - - return 0; -} - -/* Local functions */ - -static char *ssl_error_str(int ssl_error) -{ - int i; - static char buf[128]; - - for (i = 0; i < sizeof(errs)/sizeof(err_entry); i ++) { - if (ssl_error == errs[i].code) - return errs[i].text; - } - sprintf(buf, "esock_openssl: SSL_error unknown: %d", ssl_error); - return buf; -} - -void end_ssl_call(int ret, Connection *cp, int ssl_error) -{ - SET_WANT(cp, ssl_error); - switch (ssl_error) { - case SSL_ERROR_SYSCALL: - /* Typically sock_errno() is equal to ERRNO_BLOCK */ - MAYBE_SET_ERRSTR(esock_posix_str(sock_errno())); - break; - case SSL_ERROR_SSL: - sock_set_errno(ERRNO_NONE); - MAYBE_SET_ERRSTR("esslerrssl"); - break; - case SSL_ERROR_WANT_X509_LOOKUP: - SSLDEBUGF(); - sock_set_errno(ERRNO_NONE); - MAYBE_SET_ERRSTR("ex509lookup"); - break; - case SSL_ERROR_WANT_CONNECT: - SSLDEBUGF(); - sock_set_errno(ERRNO_NONE); - MAYBE_SET_ERRSTR("ewantconnect"); - break; - default: - break; - } -} - -void check_shutdown(Connection *cp) -{ - int sd_mode; - SSL *ssl = cp->opaque; - - sd_mode = SSL_get_shutdown(ssl); - if (sd_mode & SSL_RECEIVED_SHUTDOWN) - cp->eof = 1; - if (sd_mode & SSL_SENT_SHUTDOWN) { - DEBUGF(("check_shutdown SSL_SENT_SHUTDOWN\n")); - cp->bp = 1; - } -} - -/* - * set_ssl_parameters - * - * Set ssl parameters from connection structure. Only called for - * listen and connect. - * - * Note: The -cacertdir option is not documented. - */ -static int set_ssl_parameters(Connection *cp, SSL_CTX *ctx) -{ - char *cacertfile = NULL, *cacertdir = NULL, *certfile = NULL; - char *keyfile = NULL, *ciphers = NULL, *password = NULL; - int verify = 0, verify_depth = DEFAULT_VERIFY_DEPTH, verify_mode; - int i, argc; - char **argv; - callback_data *cb_data; - - RESET_ERRSTR(); - - argc = esock_build_argv(cp->flags, &argv); - - DEBUGF(("Argv:\n")); - for (i = 0; i < argc; i++) { - DEBUGF(("%d: %s\n", i, argv[i])); - } - - for (i = 0; i < argc; i++) { - if (strcmp(argv[i], "-verify") == 0) { - verify = atoi(argv[++i]); - } else if (strcmp(argv[i], "-depth") == 0) { - verify_depth = atoi(argv[++i]); - } else if (strcmp(argv[i], "-log") == 0) { - /* XXX ignored: logging per connection not supported */ - i++; - } else if (strcmp(argv[i], "-certfile") == 0) { - certfile = argv[++i]; - } else if (strcmp(argv[i], "-keyfile") == 0) { - keyfile = argv[++i]; - } else if (strcmp(argv[i], "-password") == 0) { - password = argv[++i]; - } else if (strcmp(argv[i], "-cacertfile") == 0) { - cacertfile = argv[++i]; - } else if (strcmp(argv[i], "-cacertdir") == 0) { - cacertdir = argv[++i]; - } else if (strcmp(argv[i], "-d") == 0) { - /* XXX ignored: debug per connection not supported */ - i++; - } else if (strcmp(argv[i], "-ciphers") == 0) { - ciphers = argv[++i]; - } else { - /* XXX Error: now ignored */ - } - } - DEBUGF(("set_ssl_parameters: all arguments read\n")); - - if (cp->origin == ORIG_LISTEN && !certfile) { - DEBUGF(("ERROR: Server must have certificate\n")); - MAYBE_SET_ERRSTR("enoservercert"); - goto err_end; - } - - /* Define callback data */ - /* XXX Check for NULL */ - cb_data = esock_malloc(sizeof(callback_data)); - cb_data->ctx = ctx; - if (password) { - cb_data->passwd = esock_malloc(strlen(password) + 1); - strcpy(cb_data->passwd, password); - } else - cb_data->passwd = NULL; - cb_data->verify_depth = verify_depth; - SSL_CTX_set_ex_data(ctx, callback_data_index, cb_data); - - /* password callback */ - SSL_CTX_set_default_passwd_cb(ctx, passwd_callback); - SSL_CTX_set_default_passwd_cb_userdata(ctx, cb_data); - - /* Set location for "trusted" certificates */ - if (cacertfile || cacertdir) { - int res; - DEBUGF(("set_ssl_parameters: SSL_CTX_load_verify_locations\n")); - FOPEN_WORKAROUND(res, SSL_CTX_load_verify_locations(ctx, cacertfile, - cacertdir)); - if (!res) { - DEBUGF(("ERROR: Cannot load verify locations\n")); - MAYBE_SET_ERRSTR("ecacertfile"); - goto err_end; - } - } else { - int res; - DEBUGF(("set_ssl_parameters: SSL_CTX_set_default_verify_paths\n")); - FOPEN_WORKAROUND(res, SSL_CTX_set_default_verify_paths(ctx)); - if (!res) { - DEBUGF(("ERROR: Cannot set default verify paths\n")); - MAYBE_SET_ERRSTR("ecacertfile"); - goto err_end; - } - } - - /* For a server the following sets the list of CA distinguished - * names that it sends to its client when it requests the - * certificate from the client. - * XXX The names of certs in cacertdir ignored. - */ - if (cp->origin == ORIG_LISTEN && cacertfile) { - DEBUGF(("set_ssl_parameters: SSL_CTX_set_client_CA_list\n")); - VOID_FOPEN_WORKAROUND(SSL_CTX_set_client_CA_list(ctx, - SSL_load_client_CA_file(cacertfile))); - if (!SSL_CTX_get_client_CA_list(ctx)) { - DEBUGF(("ERROR: Cannot set client CA list\n")); - MAYBE_SET_ERRSTR("ecacertfile"); - goto err_end; - } - } - - /* Use certificate file if key file has not been set. */ - if (!keyfile) - keyfile = certfile; - - if (certfile) { - int res; - DEBUGF(("set_ssl_parameters: SSL_CTX_use_certificate_file\n")); - FOPEN_WORKAROUND(res, SSL_CTX_use_certificate_file(ctx, certfile, - SSL_FILETYPE_PEM)); - if (res <= 0) { - DEBUGF(("ERROR: Cannot set certificate file\n")); - MAYBE_SET_ERRSTR("ecertfile"); - goto err_end; - } - } - if (keyfile) { - int res; - DEBUGF(("set_ssl_parameters: SSL_CTX_use_PrivateKey_file\n")); - FOPEN_WORKAROUND(res, SSL_CTX_use_PrivateKey_file(ctx, keyfile, - SSL_FILETYPE_PEM)); - if (res <= 0) { - DEBUGF(("ERROR: Cannot set private key file\n")); - MAYBE_SET_ERRSTR("ekeyfile"); - goto err_end; - } - } - if(certfile && keyfile) { - DEBUGF(("set_ssl_parameters: SSL_CTX_check_private_key\n")); - if (!SSL_CTX_check_private_key(ctx)) { - DEBUGF(("ERROR: Private key does not match the certificate\n")); - MAYBE_SET_ERRSTR("ekeymismatch"); - goto err_end; - } - } - - /* Ciphers */ - if (ciphers) { - DEBUGF(("set_ssl_parameters: SSL_CTX_set_cipher_list\n")); - if (!SSL_CTX_set_cipher_list(ctx, ciphers)) { - DEBUGF(("ERROR: Cannot set cipher list\n")); - MAYBE_SET_ERRSTR("ecipher"); - goto err_end; - } - } - - /* Verify depth */ - DEBUGF(("set_ssl_parameters: SSL_CTX_set_verify_depth (depth = %d)\n", - verify_depth)); - SSL_CTX_set_verify_depth(ctx, verify_depth); - - /* Verify mode and callback */ - /* XXX Why precisely these modes? */ - switch (verify) { - case 0: - verify_mode = SSL_VERIFY_NONE; - break; - case 1: - verify_mode = SSL_VERIFY_PEER|SSL_VERIFY_CLIENT_ONCE; - break; - case 2: - verify_mode = SSL_VERIFY_PEER|SSL_VERIFY_CLIENT_ONCE| - SSL_VERIFY_FAIL_IF_NO_PEER_CERT; - break; - default: - verify_mode = SSL_VERIFY_NONE; - } - DEBUGF(("set_ssl_parameters: SSL_CTX_set_verify (verify = %d)\n", - verify)); - SSL_CTX_set_verify(ctx, verify_mode, verify_callback); - - /* Session id context. Should be an option really. */ - if (cp->origin == ORIG_LISTEN) { - unsigned char *sid = "Erlang/OTP/ssl"; - SSL_CTX_set_session_id_context(ctx, sid, strlen(sid)); - } - - /* info callback */ - if (debug) - SSL_CTX_set_info_callback(ctx, info_callback); - - DEBUGF(("set_ssl_parameters: done\n")); - /* Free arg list */ - for (i = 0; argv[i]; i++) - esock_free(argv[i]); - esock_free(argv); - return 0; - - err_end: - DEBUGF(("set_ssl_parameters: error\n")); - /* Free arg list */ - for (i = 0; argv[i]; i++) - esock_free(argv[i]); - esock_free(argv); - return -1; -} - -/* Call back functions */ - -static int verify_callback(int ok, X509_STORE_CTX *x509_ctx) -{ - X509 *cert; - int cert_err, depth; - SSL *ssl; - SSL_CTX *ctx; - callback_data *cb_data; - - cert = X509_STORE_CTX_get_current_cert(x509_ctx); - cert_err = X509_STORE_CTX_get_error(x509_ctx); - depth = X509_STORE_CTX_get_error_depth(x509_ctx); - - ssl = X509_STORE_CTX_get_ex_data(x509_ctx, - SSL_get_ex_data_X509_STORE_CTX_idx()); - ctx = SSL_get_SSL_CTX(ssl); - cb_data = SSL_CTX_get_ex_data(ctx, callback_data_index); - - X509_NAME_oneline(X509_get_subject_name(cert), x509_buf, sizeof(x509_buf)); - DEBUGF((" +vfy: depth = %d\n", depth)); - DEBUGF((" subject = %s\n", x509_buf)); - X509_NAME_oneline(X509_get_issuer_name(cert), x509_buf, sizeof(x509_buf)); - DEBUGF((" issuer = %s\n", x509_buf)); - - if (!ok) { - DEBUGF((" +vfy: error = %d [%s]\n", cert_err, - X509_verify_cert_error_string(cert_err))); - if (depth >= cb_data->verify_depth) - ok = 1; - } - - switch (cert_err) { - case X509_V_OK: - case X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT: - ok = 1; - break; - case X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT: - case X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY: - MAYBE_SET_ERRSTR("enoissuercert"); - break; - case X509_V_ERR_CERT_HAS_EXPIRED: - MAYBE_SET_ERRSTR("epeercertexpired"); - break; - case X509_V_ERR_CERT_NOT_YET_VALID: - case X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD: - case X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD: - MAYBE_SET_ERRSTR("epeercertinvalid"); - break; - case X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN: - MAYBE_SET_ERRSTR("eselfsignedcert"); - break; - case X509_V_ERR_CERT_CHAIN_TOO_LONG: - MAYBE_SET_ERRSTR("echaintoolong"); - break; - default: - MAYBE_SET_ERRSTR("epeercert"); - break; - } - DEBUGF((" +vfy: return = %d\n",ok)); - return ok; -} - -static int passwd_callback(char *buf, int num, int rwflag, void *userdata) -{ - callback_data *cb_data = userdata; - int len; - - if (cb_data && cb_data->passwd) { - DEBUGF((" +passwd: %s\n", cb_data->passwd)); - strncpy(buf, cb_data->passwd, num); - len = strlen(cb_data->passwd); - return len; - } - DEBUGF((" +passwd: ERROR: No password set.\n")); - return 0; -} - -static void info_callback(const SSL *ssl, int where, int ret) -{ - char *str; - - if (where & SSL_CB_LOOP) { - DEBUGF((" info: %s\n",SSL_state_string_long(ssl))); - } else if (where & SSL_CB_ALERT) { - str = (where & SSL_CB_READ) ? "read" : "write"; - DEBUGF((" info: SSL3 alert %s:%s:%s\n", str, - SSL_alert_type_string_long(ret), - SSL_alert_desc_string_long(ret))); - } else if (where & SSL_CB_EXIT) { - if (ret == 0) { - DEBUGF((" info: failed in %s\n", SSL_state_string_long(ssl))); - } else if (ret < 0) { - DEBUGF((" info: error in %s\n", SSL_state_string_long(ssl))); - } - } -} - -/* This function is called whenever an SSL_CTX *ctx structure is - * freed. -*/ -static void callback_data_free(void *parent, void *ptr, CRYPTO_EX_DATA *ad, - int idx, long arg1, void *argp) -{ - callback_data *cb_data = ptr; - - if (cb_data) { - if (cb_data->passwd) - esock_free(cb_data->passwd); - esock_free(cb_data); - } -} - -static RSA *tmp_rsa_callback(SSL *ssl, int is_export, int keylen) -{ - static RSA *rsa512 = NULL; - static RSA *rsa1024 = NULL; - - switch (keylen) { - case 512: - if (!rsa512) - rsa512 = RSA_generate_key(keylen, RSA_F4, NULL, NULL); - return rsa512; - break; - case 1024: - if (!rsa1024) - rsa1024 = RSA_generate_key(keylen, RSA_F4, NULL, NULL); - return rsa1024; - break; - default: - if (rsa1024) - return rsa1024; - if (rsa512) - return rsa512; - rsa512 = RSA_generate_key(keylen, RSA_F4, NULL, NULL); - return rsa512; - } -} - -/* Restrict protocols (SSLv2, SSLv3, TLSv1) */ -static void restrict_protocols(SSL_CTX *ctx) -{ - long options = 0; - - if (protocol_version) { - if ((protocol_version & ESOCK_SSLv2) == 0) - options |= SSL_OP_NO_SSLv2; - if ((protocol_version & ESOCK_SSLv3) == 0) - options |= SSL_OP_NO_SSLv3; - if ((protocol_version & ESOCK_TLSv1) == 0) - options |= SSL_OP_NO_TLSv1; - SSL_CTX_set_options(ctx, options); - } -} - - -static unsigned char randvec [] = { - 181, 177, 237, 240, 107, 24, 43, 148, - 105, 4, 248, 13, 199, 255, 23, 58, - 71, 181, 57, 151, 156, 25, 165, 7, - 73, 80, 80, 231, 70, 110, 96, 162, - 24, 205, 178, 178, 67, 122, 210, 180, - 92, 6, 156, 182, 84, 159, 85, 6, - 175, 66, 165, 167, 137, 34, 179, 237, - 77, 90, 87, 185, 21, 106, 92, 115, - 137, 65, 233, 42, 164, 153, 208, 133, - 160, 172, 129, 202, 46, 220, 98, 66, - 115, 66, 46, 28, 226, 200, 140, 145, - 207, 194, 58, 71, 56, 203, 113, 34, - 221, 116, 63, 114, 188, 210, 45, 238, - 200, 123, 35, 150, 2, 78, 160, 22, - 226, 167, 162, 10, 182, 75, 109, 97, - 86, 252, 93, 125, 117, 214, 220, 37, - 105, 160, 56, 158, 97, 57, 22, 14, - 73, 169, 111, 190, 222, 176, 14, 82, - 111, 42, 87, 90, 136, 236, 22, 209, - 156, 207, 40, 251, 88, 141, 51, 211, - 31, 158, 153, 91, 119, 83, 255, 60, - 55, 94, 5, 115, 119, 210, 224, 185, - 163, 163, 5, 3, 197, 106, 110, 206, - 109, 132, 50, 190, 177, 133, 175, 129, - 225, 161, 156, 244, 77, 150, 99, 38, - 17, 111, 46, 230, 152, 64, 50, 164, - 19, 78, 3, 164, 169, 175, 104, 97, - 103, 158, 91, 168, 186, 191, 73, 88, - 118, 112, 41, 188, 219, 0, 198, 209, - 206, 7, 5, 169, 127, 180, 80, 74, - 124, 4, 4, 108, 197, 67, 204, 29, - 101, 95, 174, 147, 64, 163, 89, 160, - 10, 5, 56, 134, 209, 69, 209, 55, - 214, 136, 45, 212, 113, 85, 159, 133, - 141, 249, 75, 40, 175, 91, 142, 13, - 179, 179, 51, 0, 136, 63, 148, 175, - 103, 162, 8, 214, 4, 24, 59, 71, - 9, 185, 48, 127, 159, 165, 8, 8, - 135, 151, 92, 214, 132, 151, 204, 169, - 24, 112, 229, 59, 236, 81, 238, 64, - 150, 196, 97, 213, 140, 159, 20, 24, - 79, 210, 191, 53, 130, 33, 157, 87, - 16, 180, 175, 217, 56, 123, 115, 196, - 130, 6, 155, 37, 220, 80, 232, 129, - 240, 57, 199, 249, 196, 152, 28, 111, - 124, 192, 59, 46, 29, 21, 178, 51, - 156, 17, 248, 61, 254, 80, 201, 131, - 203, 59, 227, 191, 71, 121, 134, 181, - 55, 79, 130, 225, 246, 36, 179, 224, - 189, 243, 200, 75, 73, 41, 251, 41, - 71, 251, 78, 146, 99, 101, 104, 69, - 18, 122, 65, 24, 232, 84, 246, 242, - 209, 18, 241, 114, 3, 65, 177, 99, - 49, 99, 215, 59, 9, 175, 195, 11, - 25, 46, 43, 120, 109, 179, 159, 250, - 239, 246, 135, 78, 2, 238, 214, 237, - 64, 170, 50, 44, 68, 67, 111, 232, - 225, 230, 224, 124, 76, 32, 52, 158, - 151, 54, 184, 135, 122, 66, 211, 215, - 121, 90, 124, 158, 55, 73, 116, 137, - 240, 15, 38, 31, 183, 86, 93, 49, - 148, 184, 125, 250, 155, 216, 84, 246, - 27, 172, 141, 54, 80, 158, 227, 254, - 189, 164, 238, 229, 68, 26, 231, 11, - 198, 222, 15, 141, 98, 8, 124, 219, - 60, 125, 170, 213, 114, 24, 189, 65, - 80, 186, 71, 126, 223, 153, 20, 141, - 110, 73, 173, 218, 214, 63, 205, 177, - 132, 115, 184, 28, 122, 232, 210, 72, - 237, 41, 93, 17, 152, 95, 242, 138, - 79, 98, 47, 197, 36, 17, 137, 230, - 15, 73, 193, 1, 181, 123, 0, 186, - 185, 135, 142, 200, 139, 78, 57, 145, - 191, 32, 98, 250, 113, 188, 71, 32, - 205, 81, 219, 99, 60, 87, 42, 95, - 249, 252, 121, 125, 246, 230, 74, 162, - 73, 59, 179, 142, 178, 47, 163, 161, - 236, 14, 123, 219, 18, 6, 102, 140, - 215, 210, 76, 9, 119, 147, 252, 63, - 13, 51, 161, 172, 180, 116, 212, 129, - 116, 237, 38, 64, 213, 222, 35, 14, - 183, 237, 78, 204, 250, 250, 5, 41, - 142, 5, 207, 154, 65, 183, 108, 82, - 1, 43, 149, 233, 89, 195, 25, 233, - 4, 34, 19, 122, 16, 58, 121, 5, - 118, 168, 22, 213, 49, 226, 163, 169, - 21, 78, 179, 232, 125, 216, 198, 147, - 245, 196, 199, 138, 185, 167, 179, 82, - 175, 53, 6, 162, 5, 141, 180, 212, - 95, 201, 234, 169, 111, 175, 138, 197, - 177, 246, 154, 41, 185, 201, 134, 187, - 88, 99, 231, 23, 190, 36, 72, 174, - 244, 185, 205, 50, 230, 226, 210, 119, - 175, 107, 109, 244, 12, 122, 84, 51, - 146, 95, 68, 74, 76, 212, 221, 103, - 244, 71, 63, 133, 149, 233, 48, 3, - 176, 168, 6, 98, 88, 226, 120, 190, - 205, 249, 38, 157, 205, 148, 250, 203, - 147, 62, 195, 229, 219, 109, 177, 119, - 120, 43, 165, 99, 253, 210, 180, 32, - 227, 180, 174, 64, 156, 139, 251, 53, - 205, 132, 210, 208, 3, 199, 115, 64, - 59, 27, 249, 164, 224, 191, 124, 241, - 142, 10, 19, 120, 227, 46, 174, 231, - 48, 65, 41, 56, 51, 38, 185, 95, - 250, 182, 100, 40, 196, 124, 173, 119, - 162, 148, 170, 34, 51, 68, 175, 60, - 242, 201, 225, 34, 146, 157, 159, 0, - 144, 148, 82, 72, 149, 53, 201, 10, - 248, 206, 154, 126, 33, 153, 56, 48, - 5, 90, 194, 22, 251, 173, 211, 202, - 203, 253, 112, 147, 188, 200, 142, 206, - 206, 175, 233, 76, 93, 104, 125, 41, - 64, 145, 202, 53, 130, 251, 23, 90, - 28, 199, 13, 128, 185, 154, 53, 194, - 195, 55, 80, 56, 151, 216, 195, 138, - 7, 170, 143, 236, 74, 141, 229, 174, - 32, 165, 131, 68, 174, 104, 35, 143, - 183, 41, 80, 191, 120, 79, 166, 240, - 123, 55, 60, 2, 128, 56, 4, 199, - 122, 85, 90, 76, 246, 29, 13, 6, - 126, 229, 14, 203, 244, 73, 121, 42, - 169, 35, 44, 202, 18, 69, 153, 120, - 141, 77, 124, 191, 215, 18, 115, 187, - 108, 246, 135, 151, 225, 192, 50, 89, - 128, 45, 39, 253, 149, 234, 203, 84, - 51, 174, 15, 237, 17, 57, 76, 81, - 39, 107, 40, 36, 22, 52, 92, 39}; diff --git a/lib/ssl/c_src/esock_osio.c b/lib/ssl/c_src/esock_osio.c deleted file mode 100644 index 41c5271c16..0000000000 --- a/lib/ssl/c_src/esock_osio.c +++ /dev/null @@ -1,328 +0,0 @@ -/*<copyright> - * <year>1999-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * 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. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -/* - * Purpose: Std filedescriptors, break handler - * - */ - -#include <stdio.h> -#include <stdlib.h> -#ifdef __WIN32__ -#include "esock_winsock.h" -#include <process.h> -#include <io.h> -#include <fcntl.h> -#else -#include <unistd.h> -#include <signal.h> -#endif - -#include "esock.h" -#include "debuglog.h" -#include "esock_utils.h" -#include "esock_osio.h" - -#ifdef __WIN32__ -#define write _write -#define read _read -#define LOCALHOSTADDR "127.0.0.1" -#define LOCBUFSIZE 1024 -#endif - -#define PACKET_SIZE 4 -#define EBUFSIZE 256 - -FD local_read_fd = 0; - -static int inc_rbuf(int size); -static void free_rbuf(void); -static int read_fill(unsigned char *buf, int len); -#ifdef __WIN32__ -static int create_local_thread(void); -static DWORD WINAPI local_thread(LPVOID lpvParam); -static BOOL WINAPI signal_handler(DWORD ctrl); -#endif - -static unsigned char *rbuf = NULL; -static int rbuf_malloced = 0; -#ifdef __WIN32__ -static unsigned long one = 1, zero = 0; -static int local_portno; -static char *local_buf; -#endif - -int set_break_handler(void) -{ -#ifndef __WIN32__ - struct sigaction act; - - /* Ignore SIGPIPE signal */ - sigemptyset(&act.sa_mask); - act.sa_flags = 0; - act.sa_handler = SIG_IGN; - sigaction(SIGPIPE, &act, NULL); - return 0; -#else - SetConsoleCtrlHandler(signal_handler, TRUE); - return 0; -#endif -} - - -#ifdef __WIN32__ - -int set_binary_mode(void) -{ - _setmode(0, _O_BINARY); - _setmode(1, _O_BINARY); - return 0; -} - -int esock_osio_init(void) -{ - return create_local_thread(); -} - -void esock_osio_finish(void) -{ - sock_close(local_read_fd); -} - -#endif - -int read_ctrl(unsigned char **ebufp) -{ - int tbh, cc; - unsigned char *mbuf; - - if (inc_rbuf(EBUFSIZE) < 0) { - fprintf(stderr, "read_ctrl: cannot alloc rbuf\n"); - return -1; - } - cc = read_fill(rbuf, PACKET_SIZE); - if (cc < 0) { - free_rbuf(); - return -1; - } - if (cc == 0) { - free_rbuf(); - return -1; /* XXX 0 ?? */ - } - tbh = GET_INT32(rbuf); - - if (tbh > rbuf_malloced - 4) { - if (inc_rbuf(tbh + 4) < 0) - return -1; - } - - mbuf = rbuf + PACKET_SIZE; - cc = read_fill(mbuf, tbh); - DEBUGF(("-----------------------------------\n")); - DEBUGF(("read_ctrl: cc = %d\n", cc)); - if(cc > 0) { - DEBUGMSGF(("message (hex) : [%3.*a]\n", cc, mbuf)); - DEBUGMSGF(("message (char): [%3.*b]\n", cc, mbuf)); - } - *ebufp = mbuf; - return cc; -} - -int write_ctrl(unsigned char *buf, int len) -{ - unsigned char lb[4]; - - PUT_INT32(len, lb); - DEBUGF(("write_ctrl: len = %d\n", len)); - DEBUGMSGF(("message (hex) : [%3.*a] [%3.*a]\n", PACKET_SIZE, lb, - len, buf)); - DEBUGMSGF(("message (char): [%3.*b] [%3.*b]\n", PACKET_SIZE, lb, - len, buf)); - - if (write(1, lb, PACKET_SIZE) != PACKET_SIZE) { /* XXX */ - fprintf(stderr, "write_ctrl: Bad write \n"); - return -1; - } - if (write(1, buf, len) != len) { /* XXX */ - fprintf(stderr, "write_ctrl: Bad write \n"); - return -1; - } - return len; -} - - -/* - * Local functions - * - */ - -static int inc_rbuf(int size) -{ - unsigned char *nbuf; - - if (rbuf_malloced >= size) - return 0; - if (rbuf != NULL) - nbuf = esock_realloc(rbuf, size); - else - nbuf = esock_malloc(size); - if(nbuf != NULL) { - rbuf = nbuf; - rbuf_malloced = size; - return 0; - } - return -1; -} - -static void free_rbuf(void) -{ - if (rbuf != NULL) { - esock_free(rbuf); - rbuf = NULL; - rbuf_malloced = 0; - } -} - -/* Fill buffer, return buffer length, 0 for EOF, < 0 for error. */ - -static int read_fill(unsigned char *buf, int len) -{ - int i, got = 0; - - do { - if ((i = sock_read(local_read_fd, buf+got, len-got)) <= 0) - return i; - got += i; - } while (got < len); - return len; -} - - -#ifdef __WIN32__ - -/* - * This routine creates a local thread, which reads from standard input - * and writes to a socket. - */ - -static int create_local_thread(void) -{ - struct sockaddr_in iserv_addr; - SOCKET tmpsock; - int length; - unsigned threadaddr; - - local_buf = esock_malloc(LOCBUFSIZE); - if ((tmpsock = socket(AF_INET, SOCK_STREAM, 0)) == INVALID_SOCKET) { - fprintf(stderr, "create_local_thread could not create socket.\n"); - return -1; - } - memset(&iserv_addr, 0, sizeof(iserv_addr)); - iserv_addr.sin_family = AF_INET; - iserv_addr.sin_addr.s_addr = inet_addr(LOCALHOSTADDR); - iserv_addr.sin_port = htons(0); /* Have any port */ - - if (bind(tmpsock, (struct sockaddr *) &iserv_addr, - sizeof(iserv_addr)) < 0) { - fprintf(stderr, "create_local_thread could not bind.\n"); - closesocket(tmpsock); - return -1; - } - listen(tmpsock, 1); - length = sizeof(iserv_addr); - if (getsockname(tmpsock, (struct sockaddr *) &iserv_addr, &length) < 0) { - fprintf(stderr, "create_local_thread could not getsockname.\n"); - closesocket(tmpsock); - return -1; - } - local_portno = ntohs(iserv_addr.sin_port); - - if (_beginthreadex(NULL, 0, local_thread, NULL, 0, &threadaddr) == 0) { - fprintf(stderr, "create_local_thread could not _beginthreadex().\n"); - closesocket(tmpsock); - return -1; - } - local_read_fd = accept(tmpsock, (struct sockaddr *) NULL, (int *) NULL); - if (local_read_fd == INVALID_FD) { - fprintf(stderr, "create_local_thread could not accept.\n"); - closesocket(tmpsock); - return -1; - } - closesocket(tmpsock); - return 0; -} - -static DWORD WINAPI local_thread(LPVOID lpvParam) -{ - SOCKET sock; - struct hostent *host; - char hostname[64]; - struct sockaddr_in iserv_addr; - unsigned long addr; - int len; - HANDLE thread; - - sock = socket(AF_INET, SOCK_STREAM, 0); - memset(&iserv_addr, 0, sizeof(struct sockaddr_in)); - iserv_addr.sin_family = AF_INET; - iserv_addr.sin_addr.s_addr = inet_addr(LOCALHOSTADDR); - iserv_addr.sin_port = htons(local_portno); - if(connect(sock, (struct sockaddr*)&iserv_addr, sizeof iserv_addr) == - SOCKET_ERROR) { - fprintf(stderr, "local_thread thread could not connect\n"); - closesocket(sock); - return 0; - } - setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, &one, sizeof(one)); - - /* read from 0 and write to sock */ - while (1) { - if ((len = read(0, local_buf, LOCBUFSIZE)) <= 0) { - closesocket(sock); - close(0); - return 0; - } - if (send(sock, local_buf, len, 0) != len ) { - closesocket(sock); - close(0); - return 0; - } - } - return 0; -} - -/* Signal handler */ - -static BOOL WINAPI signal_handler(DWORD ctrl) -{ - switch (ctrl) { - case CTRL_C_EVENT: - case CTRL_BREAK_EVENT: - break; - case CTRL_LOGOFF_EVENT: - if (!getenv("ERLSRV_SERVICE_NAME")) - return FALSE; - break; - default: - exit(1); - } - return TRUE; -} - -#endif diff --git a/lib/ssl/c_src/esock_osio.h b/lib/ssl/c_src/esock_osio.h deleted file mode 100644 index 8742c3b05b..0000000000 --- a/lib/ssl/c_src/esock_osio.h +++ /dev/null @@ -1,34 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-2009. All Rights Reserved. - * - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * %CopyrightEnd% - */ - -#ifndef ESOCK_OSIO_H -#define ESOCK_OSIO_H - -extern FD local_read_fd; - -#ifdef __WIN32__ -int set_binary_mode(void); -int esock_osio_init(void); -void esock_osio_finish(void); -#endif -int set_break_handler(void); -int read_ctrl(unsigned char **ebufp); -int write_ctrl(unsigned char *buf, int len); - -#endif diff --git a/lib/ssl/c_src/esock_poll.c b/lib/ssl/c_src/esock_poll.c deleted file mode 100644 index e982eba881..0000000000 --- a/lib/ssl/c_src/esock_poll.c +++ /dev/null @@ -1,222 +0,0 @@ -/*<copyright> - * <year>2005-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * 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. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ - -/* - * Purpose: Hide poll() and select() behind an API so that we - * can use either one. - */ - -#ifdef HAVE_CONFIG_H -#include "config.h" -#endif -#ifdef __WIN32__ -#include "esock_winsock.h" -#endif - -#include <stdio.h> -#include <stdlib.h> -#include <stdarg.h> -#include <string.h> -#include <time.h> -#include <ctype.h> -#include <sys/types.h> -#include <errno.h> - -#ifdef __WIN32__ -#include <process.h> -#else -#include <unistd.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <netinet/tcp.h> -#include <sys/time.h> -#include <netdb.h> -#include <arpa/inet.h> -#include <fcntl.h> -#endif - -#include "esock.h" -#include "esock_ssl.h" -#include "esock_utils.h" -#include "esock_poll.h" -#include "debuglog.h" - -#if !defined(USE_SELECT) - -/* At least on FreeBSD, we need POLLRDNORM for normal files, not POLLIN. */ -/* Whether this is a bug in FreeBSD, I don't know. */ -#ifdef POLLRDNORM -#define POLL_INPUT (POLLIN | POLLRDNORM) -#else -#define POLL_INPUT POLLIN -#endif - -static void poll_fd_set(EsockPoll *ep, FD fd, short events) -{ - int i, j; - int prev_num_fds = ep->num_fds; - - if (ep->num_fds <= fd) { - ep->num_fds = fd + 64; - ep->fd_to_poll = (int *) esock_realloc(ep->fd_to_poll, - ep->num_fds*sizeof(int)); - for (j = prev_num_fds; j < ep->num_fds; j++) - ep->fd_to_poll[j] = -1; - } - i = ep->fd_to_poll[fd]; - if (i > 0 && i < ep->active && ep->fds[i].fd == fd) { - /* Already present in poll array */ - ep->fds[i].events |= events; - } else { - /* Append to poll array */ - if (ep->active >= ep->allocated) { - ep->allocated *= 2; - ep->fds = (struct pollfd *) - esock_realloc(ep->fds, ep->allocated*sizeof(struct pollfd)); - } - ep->fd_to_poll[fd] = ep->active; - ep->fds[ep->active].fd = fd; - ep->fds[ep->active].events = events; - ep->fds[ep->active].revents = 0; - ep->active++; - } -} - -static int poll_is_set(EsockPoll *ep, FD fd, short mask) -{ - if (fd >= ep->num_fds) { - return 0; - } else { - int i = ep->fd_to_poll[fd]; - return 0 <= i && i < ep->active && ep->fds[i].fd == fd && - (ep->fds[i].revents & mask) != 0; - } -} - -#endif - -void esock_poll_init(EsockPoll *ep) -{ -#ifdef USE_SELECT - /* Nothing to do here */ -#else - ep->allocated = 2; - ep->fds = (struct pollfd *) esock_malloc(ep->allocated*sizeof(struct pollfd)); - ep->num_fds = 1; - ep->fd_to_poll = esock_malloc(ep->num_fds*sizeof(int)); -#endif -} - -void esock_poll_zero(EsockPoll *ep) -{ -#ifdef USE_SELECT - FD_ZERO(&ep->readmask); - FD_ZERO(&ep->writemask); - FD_ZERO(&ep->exceptmask); -#else - int i; - - for (i = 0; i < ep->num_fds; i++) - ep->fd_to_poll[i] = -1; - ep->active = 0; -#endif -} - -void esock_poll_fd_set_read(EsockPoll *ep, FD fd) -{ -#ifdef USE_SELECT - FD_SET(fd, &ep->readmask); -#else - poll_fd_set(ep, fd, POLL_INPUT); -#endif -} - -void esock_poll_fd_set_write(EsockPoll *ep, FD fd) -{ -#ifdef USE_SELECT - FD_SET(fd, &ep->writemask); -#else - poll_fd_set(ep, fd, POLLOUT); -#endif -} - -int esock_poll_fd_isset_read(EsockPoll *ep, FD fd) -{ -#ifdef USE_SELECT - return FD_ISSET(fd, &ep->readmask); -#else - return poll_is_set(ep, fd, (POLL_INPUT|POLLHUP|POLLERR|POLLNVAL)); -#endif -} - -int esock_poll_fd_isset_write(EsockPoll *ep, FD fd) -{ -#ifdef USE_SELECT - return FD_ISSET(fd, &ep->writemask); -#else - return poll_is_set(ep, fd, (POLLOUT|POLLHUP|POLLERR|POLLNVAL)); -#endif -} - -#ifdef __WIN32__ -void esock_poll_fd_set_exception(EsockPoll *ep, FD fd) -{ - FD_SET(fd, &ep->exceptmask); -} - -int esock_poll_fd_isset_exception(EsockPoll *ep, FD fd) -{ - return FD_ISSET(fd, &ep->exceptmask); -} -#endif - -int esock_poll(EsockPoll *ep, int seconds) -{ - int sret; - -#ifdef USE_SELECT - struct timeval tv; - - tv.tv_sec = seconds; - tv.tv_usec = 0; - sret = select(FD_SETSIZE, &ep->readmask, &ep->writemask, &ep->exceptmask, &tv); - if (sret == 0) { - FD_ZERO(&ep->readmask); - FD_ZERO(&ep->writemask); - FD_ZERO(&ep->exceptmask); - } -#else - sret = poll(ep->fds, ep->active, 1000*seconds); -#endif - return sret; -} - -void esock_poll_clear_event(EsockPoll* ep, FD fd) -{ -#ifdef USE_SELECT - FD_CLR(fd, &ep->readmask); - FD_CLR(fd, &ep->writemask); - FD_CLR(fd, &ep->exceptmask); -#else - int i = ep->fd_to_poll[fd]; - if (i > 0 && ep->fds[i].fd == fd) - ep->fds[i].revents = 0; -#endif -} diff --git a/lib/ssl/c_src/esock_poll.h b/lib/ssl/c_src/esock_poll.h deleted file mode 100644 index 639976dfa9..0000000000 --- a/lib/ssl/c_src/esock_poll.h +++ /dev/null @@ -1,60 +0,0 @@ -/*<copyright> - * <year>2005-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * 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. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -#ifndef ESOCK_POLL_SELECT_H -#define ESOCK_POLL_SELECT_H - -#if !defined(USE_SELECT) -#include <poll.h> -#endif - -typedef struct esock_poll { -#ifdef USE_SELECT - fd_set readmask; - fd_set writemask; - fd_set exceptmask; -#else - int* fd_to_poll; /* Map from fd to index into poll - * descriptor array. - */ - int num_fds; /* Number of entries in fd_to_poll. */ - struct pollfd* fds; /* Array of poll descriptors. */ - int allocated; /* Allocated number of fds. */ - int active; /* Active number of fds */ -#endif -} EsockPoll; - -void esock_poll_init(EsockPoll *ep); -void esock_poll_zero(EsockPoll *ep); - -void esock_poll_fd_set_read(EsockPoll *ep, FD fd); -void esock_poll_fd_set_write(EsockPoll *ep, FD fd); - -void esock_poll_clear_event(EsockPoll *ep, FD fd); - -int esock_poll_fd_isset_read(EsockPoll *ep, FD fd); -int esock_poll_fd_isset_write(EsockPoll *ep, FD fd); - -#ifdef __WIN32__ -void esock_poll_fd_set_exception(EsockPoll *ep, FD fd); -int esock_poll_fd_isset_exception(EsockPoll *ep, FD fd); -#endif - -int esock_poll(EsockPoll *ep, int seconds); -#endif diff --git a/lib/ssl/c_src/esock_posix_str.c b/lib/ssl/c_src/esock_posix_str.c deleted file mode 100644 index 31062baaaf..0000000000 --- a/lib/ssl/c_src/esock_posix_str.c +++ /dev/null @@ -1,642 +0,0 @@ -/* - * %ExternalCopyright% - */ - -/* - * Original: tclPosixStr.c -- - * - * This file contains procedures that generate strings - * corresponding to various POSIX-related codes, such - * as errno and signals. - * - * Copyright (c) 1991-1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * SCCS: @(#) tclPosixStr.c 1.32 96/10/10 10:09:42 - */ - -/* Copy of erl_posix_str.c */ - -#ifdef __WIN32__ -#include "esock_winsock.h" -#endif - -#include <stdio.h> -#include <errno.h> -#include "esock_posix_str.h" - -/* - *---------------------------------------------------------------------- - * - * esock_posix_str -- - * - * Return a textual identifier for the given errno value. - * - * Results: - * This procedure returns a machine-readable textual identifier - * that corresponds to the current errno value (e.g. "eperm"). - * The identifier is the same as the #define name in errno.h, - * except that it is in lowercase. - * - *---------------------------------------------------------------------- - */ - -static char errstrbuf[32]; - -char *esock_posix_str(int error) -{ - switch (error) { -#ifdef E2BIG - case E2BIG: return "e2big"; -#endif -#ifdef EACCES - case EACCES: return "eacces"; -#endif -#ifdef EADDRINUSE - case EADDRINUSE: return "eaddrinuse"; -#endif -#ifdef EADDRNOTAVAIL - case EADDRNOTAVAIL: return "eaddrnotavail"; -#endif -#ifdef EADV - case EADV: return "eadv"; -#endif -#ifdef EAFNOSUPPORT - case EAFNOSUPPORT: return "eafnosupport"; -#endif -#ifdef EAGAIN - case EAGAIN: return "eagain"; -#endif -#ifdef EALIGN - case EALIGN: return "ealign"; -#endif -#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY )) - case EALREADY: return "ealready"; -#endif -#ifdef EBADE - case EBADE: return "ebade"; -#endif -#ifdef EBADF - case EBADF: return "ebadf"; -#endif -#ifdef EBADFD - case EBADFD: return "ebadfd"; -#endif -#ifdef EBADMSG - case EBADMSG: return "ebadmsg"; -#endif -#ifdef EBADR - case EBADR: return "ebadr"; -#endif -#ifdef EBADRPC - case EBADRPC: return "ebadrpc"; -#endif -#ifdef EBADRQC - case EBADRQC: return "ebadrqc"; -#endif -#ifdef EBADSLT - case EBADSLT: return "ebadslt"; -#endif -#ifdef EBFONT - case EBFONT: return "ebfont"; -#endif -#ifdef EBUSY - case EBUSY: return "ebusy"; -#endif -#ifdef ECHILD - case ECHILD: return "echild"; -#endif -#ifdef ECHRNG - case ECHRNG: return "echrng"; -#endif -#ifdef ECOMM - case ECOMM: return "ecomm"; -#endif -#ifdef ECONNABORTED - case ECONNABORTED: return "econnaborted"; -#endif -#ifdef ECONNREFUSED - case ECONNREFUSED: return "econnrefused"; -#endif -#ifdef ECONNRESET - case ECONNRESET: return "econnreset"; -#endif -#if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK)) - case EDEADLK: return "edeadlk"; -#endif -#if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK)) - case EDEADLOCK: return "edeadlock"; -#endif -#ifdef EDESTADDRREQ - case EDESTADDRREQ: return "edestaddrreq"; -#endif -#ifdef EDIRTY - case EDIRTY: return "edirty"; -#endif -#ifdef EDOM - case EDOM: return "edom"; -#endif -#ifdef EDOTDOT - case EDOTDOT: return "edotdot"; -#endif -#ifdef EDQUOT - case EDQUOT: return "edquot"; -#endif -#ifdef EDUPPKG - case EDUPPKG: return "eduppkg"; -#endif -#ifdef EEXIST - case EEXIST: return "eexist"; -#endif -#ifdef EFAULT - case EFAULT: return "efault"; -#endif -#ifdef EFBIG - case EFBIG: return "efbig"; -#endif -#ifdef EHOSTDOWN - case EHOSTDOWN: return "ehostdown"; -#endif -#ifdef EHOSTUNREACH - case EHOSTUNREACH: return "ehostunreach"; -#endif -#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS)) - case EIDRM: return "eidrm"; -#endif -#ifdef EINIT - case EINIT: return "einit"; -#endif -#ifdef EINPROGRESS - case EINPROGRESS: return "einprogress"; -#endif -#ifdef EINTR - case EINTR: return "eintr"; -#endif -#ifdef EINVAL - case EINVAL: return "einval"; -#endif -#ifdef EIO - case EIO: return "eio"; -#endif -#ifdef EISCONN - case EISCONN: return "eisconn"; -#endif -#ifdef EISDIR - case EISDIR: return "eisdir"; -#endif -#ifdef EISNAME - case EISNAM: return "eisnam"; -#endif -#ifdef ELBIN - case ELBIN: return "elbin"; -#endif -#ifdef EL2HLT - case EL2HLT: return "el2hlt"; -#endif -#ifdef EL2NSYNC - case EL2NSYNC: return "el2nsync"; -#endif -#ifdef EL3HLT - case EL3HLT: return "el3hlt"; -#endif -#ifdef EL3RST - case EL3RST: return "el3rst"; -#endif -#ifdef ELIBACC - case ELIBACC: return "elibacc"; -#endif -#ifdef ELIBBAD - case ELIBBAD: return "elibbad"; -#endif -#ifdef ELIBEXEC - case ELIBEXEC: return "elibexec"; -#endif -#ifdef ELIBMAX - case ELIBMAX: return "elibmax"; -#endif -#ifdef ELIBSCN - case ELIBSCN: return "elibscn"; -#endif -#ifdef ELNRNG - case ELNRNG: return "elnrng"; -#endif -#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT)) - case ELOOP: return "eloop"; -#endif -#ifdef EMFILE - case EMFILE: return "emfile"; -#endif -#ifdef EMLINK - case EMLINK: return "emlink"; -#endif -#ifdef EMSGSIZE - case EMSGSIZE: return "emsgsize"; -#endif -#ifdef EMULTIHOP - case EMULTIHOP: return "emultihop"; -#endif -#ifdef ENAMETOOLONG - case ENAMETOOLONG: return "enametoolong"; -#endif -#ifdef ENAVAIL - case ENAVAIL: return "enavail"; -#endif -#ifdef ENET - case ENET: return "enet"; -#endif -#ifdef ENETDOWN - case ENETDOWN: return "enetdown"; -#endif -#ifdef ENETRESET - case ENETRESET: return "enetreset"; -#endif -#ifdef ENETUNREACH - case ENETUNREACH: return "enetunreach"; -#endif -#ifdef ENFILE - case ENFILE: return "enfile"; -#endif -#ifdef ENOANO - case ENOANO: return "enoano"; -#endif -#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR)) - case ENOBUFS: return "enobufs"; -#endif -#ifdef ENOCSI - case ENOCSI: return "enocsi"; -#endif -#if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED)) - case ENODATA: return "enodata"; -#endif -#ifdef ENODEV - case ENODEV: return "enodev"; -#endif -#ifdef ENOENT - case ENOENT: return "enoent"; -#endif -#ifdef ENOEXEC - case ENOEXEC: return "enoexec"; -#endif -#ifdef ENOLCK - case ENOLCK: return "enolck"; -#endif -#ifdef ENOLINK - case ENOLINK: return "enolink"; -#endif -#ifdef ENOMEM - case ENOMEM: return "enomem"; -#endif -#ifdef ENOMSG - case ENOMSG: return "enomsg"; -#endif -#ifdef ENONET - case ENONET: return "enonet"; -#endif -#ifdef ENOPKG - case ENOPKG: return "enopkg"; -#endif -#ifdef ENOPROTOOPT - case ENOPROTOOPT: return "enoprotoopt"; -#endif -#ifdef ENOSPC - case ENOSPC: return "enospc"; -#endif -#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR)) - case ENOSR: return "enosr"; -#endif -#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR)) - case ENOSTR: return "enostr"; -#endif -#ifdef ENOSYM - case ENOSYM: return "enosym"; -#endif -#ifdef ENOSYS - case ENOSYS: return "enosys"; -#endif -#ifdef ENOTBLK - case ENOTBLK: return "enotblk"; -#endif -#ifdef ENOTCONN - case ENOTCONN: return "enotconn"; -#endif -#ifdef ENOTDIR - case ENOTDIR: return "enotdir"; -#endif -#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST)) - case ENOTEMPTY: return "enotempty"; -#endif -#ifdef ENOTNAM - case ENOTNAM: return "enotnam"; -#endif -#ifdef ENOTSOCK - case ENOTSOCK: return "enotsock"; -#endif -#ifdef ENOTSUP - case ENOTSUP: return "enotsup"; -#endif -#ifdef ENOTTY - case ENOTTY: return "enotty"; -#endif -#ifdef ENOTUNIQ - case ENOTUNIQ: return "enotuniq"; -#endif -#ifdef ENXIO - case ENXIO: return "enxio"; -#endif -#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || EOPNOTSUPP != ENOTSUP) - case EOPNOTSUPP: return "eopnotsupp"; -#endif -#ifdef EPERM - case EPERM: return "eperm"; -#endif -#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT)) - case EPFNOSUPPORT: return "epfnosupport"; -#endif -#ifdef EPIPE - case EPIPE: return "epipe"; -#endif -#ifdef EPROCLIM - case EPROCLIM: return "eproclim"; -#endif -#ifdef EPROCUNAVAIL - case EPROCUNAVAIL: return "eprocunavail"; -#endif -#ifdef EPROGMISMATCH - case EPROGMISMATCH: return "eprogmismatch"; -#endif -#ifdef EPROGUNAVAIL - case EPROGUNAVAIL: return "eprogunavail"; -#endif -#ifdef EPROTO - case EPROTO: return "eproto"; -#endif -#ifdef EPROTONOSUPPORT - case EPROTONOSUPPORT: return "eprotonosupport"; -#endif -#ifdef EPROTOTYPE - case EPROTOTYPE: return "eprototype"; -#endif -#ifdef ERANGE - case ERANGE: return "erange"; -#endif -#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED)) - case EREFUSED: return "erefused"; -#endif -#ifdef EREMCHG - case EREMCHG: return "eremchg"; -#endif -#ifdef EREMDEV - case EREMDEV: return "eremdev"; -#endif -#ifdef EREMOTE - case EREMOTE: return "eremote"; -#endif -#ifdef EREMOTEIO - case EREMOTEIO: return "eremoteio"; -#endif -#ifdef EREMOTERELEASE - case EREMOTERELEASE: return "eremoterelease"; -#endif -#ifdef EROFS - case EROFS: return "erofs"; -#endif -#ifdef ERPCMISMATCH - case ERPCMISMATCH: return "erpcmismatch"; -#endif -#ifdef ERREMOTE - case ERREMOTE: return "erremote"; -#endif -#ifdef ESHUTDOWN - case ESHUTDOWN: return "eshutdown"; -#endif -#ifdef ESOCKTNOSUPPORT - case ESOCKTNOSUPPORT: return "esocktnosupport"; -#endif -#ifdef ESPIPE - case ESPIPE: return "espipe"; -#endif -#ifdef ESRCH - case ESRCH: return "esrch"; -#endif -#ifdef ESRMNT - case ESRMNT: return "esrmnt"; -#endif -#ifdef ESTALE - case ESTALE: return "estale"; -#endif -#ifdef ESUCCESS - case ESUCCESS: return "esuccess"; -#endif -#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP)) - case ETIME: return "etime"; -#endif -#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR)) - case ETIMEDOUT: return "etimedout"; -#endif -#ifdef ETOOMANYREFS - case ETOOMANYREFS: return "etoomanyrefs"; -#endif -#ifdef ETXTBSY - case ETXTBSY: return "etxtbsy"; -#endif -#ifdef EUCLEAN - case EUCLEAN: return "euclean"; -#endif -#ifdef EUNATCH - case EUNATCH: return "eunatch"; -#endif -#ifdef EUSERS - case EUSERS: return "eusers"; -#endif -#ifdef EVERSION - case EVERSION: return "eversion"; -#endif -#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN)) - case EWOULDBLOCK: return "ewouldblock"; -#endif -#ifdef EXDEV - case EXDEV: return "exdev"; -#endif -#ifdef EXFULL - case EXFULL: return "exfull"; -#endif -#ifdef WSAEINTR - case WSAEINTR: return "eintr"; -#endif -#ifdef WSAEBADF - case WSAEBADF: return "ebadf"; -#endif -#ifdef WSAEACCES - case WSAEACCES: return "eacces"; -#endif -#ifdef WSAEFAULT - case WSAEFAULT: return "efault"; -#endif -#ifdef WSAEINVAL - case WSAEINVAL: return "einval"; -#endif -#ifdef WSAEMFILE - case WSAEMFILE: return "emfile"; -#endif -#ifdef WSAEWOULDBLOCK - case WSAEWOULDBLOCK: return "ewouldblock"; -#endif -#ifdef WSAEINPROGRESS - case WSAEINPROGRESS: return "einprogress"; -#endif -#ifdef WSAEALREADY - case WSAEALREADY: return "ealready"; -#endif -#ifdef WSAENOTSOCK - case WSAENOTSOCK: return "enotsock"; -#endif -#ifdef WSAEDESTADDRREQ - case WSAEDESTADDRREQ: return "edestaddrreq"; -#endif -#ifdef WSAEMSGSIZE - case WSAEMSGSIZE: return "emsgsize"; -#endif -#ifdef WSAEPROTOTYPE - case WSAEPROTOTYPE: return "eprototype"; -#endif -#ifdef WSAENOPROTOOPT - case WSAENOPROTOOPT: return "enoprotoopt"; -#endif -#ifdef WSAEPROTONOSUPPORT - case WSAEPROTONOSUPPORT: return "eprotonosupport"; -#endif -#ifdef WSAESOCKTNOSUPPORT - case WSAESOCKTNOSUPPORT: return "esocktnosupport"; -#endif -#ifdef WSAEOPNOTSUPP - case WSAEOPNOTSUPP: return "eopnotsupp"; -#endif -#ifdef WSAEPFNOSUPPORT - case WSAEPFNOSUPPORT: return "epfnosupport"; -#endif -#ifdef WSAEAFNOSUPPORT - case WSAEAFNOSUPPORT: return "eafnosupport"; -#endif -#ifdef WSAEADDRINUSE - case WSAEADDRINUSE: return "eaddrinuse"; -#endif -#ifdef WSAEADDRNOTAVAIL - case WSAEADDRNOTAVAIL: return "eaddrnotavail"; -#endif -#ifdef WSAENETDOWN - case WSAENETDOWN: return "enetdown"; -#endif -#ifdef WSAENETUNREACH - case WSAENETUNREACH: return "enetunreach"; -#endif -#ifdef WSAENETRESET - case WSAENETRESET: return "enetreset"; -#endif -#ifdef WSAECONNABORTED - case WSAECONNABORTED: return "econnaborted"; -#endif -#ifdef WSAECONNRESET - case WSAECONNRESET: return "econnreset"; -#endif -#ifdef WSAENOBUFS - case WSAENOBUFS: return "enobufs"; -#endif -#ifdef WSAEISCONN - case WSAEISCONN: return "eisconn"; -#endif -#ifdef WSAENOTCONN - case WSAENOTCONN: return "enotconn"; -#endif -#ifdef WSAESHUTDOWN - case WSAESHUTDOWN: return "eshutdown"; -#endif -#ifdef WSAETOOMANYREFS - case WSAETOOMANYREFS: return "etoomanyrefs"; -#endif -#ifdef WSAETIMEDOUT - case WSAETIMEDOUT: return "etimedout"; -#endif -#ifdef WSAECONNREFUSED - case WSAECONNREFUSED: return "econnrefused"; -#endif -#ifdef WSAELOOP - case WSAELOOP: return "eloop"; -#endif -#ifdef WSAENAMETOOLONG - case WSAENAMETOOLONG: return "enametoolong"; -#endif -#ifdef WSAEHOSTDOWN - case WSAEHOSTDOWN: return "ehostdown"; -#endif -#ifdef WSAEHOSTUNREACH - case WSAEHOSTUNREACH: return "ehostunreach"; -#endif -#ifdef WSAENOTEMPTY - case WSAENOTEMPTY: return "enotempty"; -#endif -#ifdef WSAEPROCLIM - case WSAEPROCLIM: return "eproclim"; -#endif -#ifdef WSAEUSERS - case WSAEUSERS: return "eusers"; -#endif -#ifdef WSAEDQUOT - case WSAEDQUOT: return "edquot"; -#endif -#ifdef WSAESTALE - case WSAESTALE: return "estale"; -#endif -#ifdef WSAEREMOTE - case WSAEREMOTE: return "eremote"; -#endif -#ifdef WSASYSNOTREADY - case WSASYSNOTREADY: return "sysnotready"; -#endif -#ifdef WSAVERNOTSUPPORTED - case WSAVERNOTSUPPORTED: return "vernotsupported"; -#endif -#ifdef WSANOTINITIALISED - case WSANOTINITIALISED: return "notinitialised"; -#endif -#ifdef WSAEDISCON - case WSAEDISCON: return "ediscon"; -#endif -#ifdef WSAENOMORE - case WSAENOMORE: return "enomore"; -#endif -#ifdef WSAECANCELLED - case WSAECANCELLED: return "ecancelled"; -#endif -#ifdef WSAEINVALIDPROCTABLE - case WSAEINVALIDPROCTABLE: return "einvalidproctable"; -#endif -#ifdef WSAEINVALIDPROVIDER - case WSAEINVALIDPROVIDER: return "einvalidprovider"; -#endif -#ifdef WSAEPROVIDERFAILEDINIT - case WSAEPROVIDERFAILEDINIT: return "eproviderfailedinit"; -#endif -#ifdef WSASYSCALLFAILURE - case WSASYSCALLFAILURE: return "syscallfailure"; -#endif -#ifdef WSASERVICE_NOT_FOUND - case WSASERVICE_NOT_FOUND: return "service_not_found"; -#endif -#ifdef WSATYPE_NOT_FOUND - case WSATYPE_NOT_FOUND: return "type_not_found"; -#endif -#ifdef WSA_E_NO_MORE - case WSA_E_NO_MORE: return "e_no_more"; -#endif -#ifdef WSA_E_CANCELLED - case WSA_E_CANCELLED: return "e_cancelled"; -#endif - default: - sprintf(errstrbuf, "unknown:%d", error); - return errstrbuf; - } -} - diff --git a/lib/ssl/c_src/esock_posix_str.h b/lib/ssl/c_src/esock_posix_str.h deleted file mode 100644 index 53916c888a..0000000000 --- a/lib/ssl/c_src/esock_posix_str.h +++ /dev/null @@ -1,28 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-2009. All Rights Reserved. - * - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * %CopyrightEnd% - */ - -/* esock_posix_str.h */ - -#ifndef ESOCK_POSIX_STR_H -#define ESOCK_POSIX_STR_H - -char *esock_posix_str(int error); - -#endif - diff --git a/lib/ssl/c_src/esock_ssl.h b/lib/ssl/c_src/esock_ssl.h deleted file mode 100644 index 535e9a6491..0000000000 --- a/lib/ssl/c_src/esock_ssl.h +++ /dev/null @@ -1,110 +0,0 @@ -/*<copyright> - * <year>1999-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * 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. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -/* - * Purpose: Header file for adaptions to various SSL packages. - */ - -#ifndef ESOCK_SSL_H -#define ESOCK_SSL_H - -#include <sys/types.h> -#include <stdio.h> -#include "esock.h" - -typedef struct { - const char *compile_version;/* version of OpenSSL when compiling esock */ - const char *lib_version; /* version of OpenSSL in library */ -} esock_version; - -/* Variables to be set by certain functions (see below) */ -char *esock_ssl_errstr; - -/* Ephemeral RSA and DH */ -int ephemeral_rsa, ephemeral_dh; - -/* Protocol version (sslv2, sslv3, tlsv1) */ -int protocol_version; - -/* version info */ -esock_version *esock_ssl_version(void); - -/* ciphers info */ -char *esock_ssl_ciphers(void); - -/* seeding */ -void esock_ssl_seed(void *buf, int len); - -/* Initialization and finalization of SSL */ - -int esock_ssl_init(void); -void esock_ssl_finish(void); - -/* Freeing of SSL resources for a connection */ - -void esock_ssl_free(Connection *cp); - -/* Print error diagnostics to a file pointer */ - -void esock_ssl_print_errors_fp(FILE *fp); - -/* All functions below have to return >= 0 on success, and < 0 on - * failure. - * - * If the return indicates a failure (return value < 0) and the failure - * is temporary the error context (sock_errno()/sock_set_errno()) must - * be set to ERRNO_BLOCK. - * - * If the failure is permanent, the error context must be set to something - * else than ERRNO_BLOCK, and `esock_ssl_errstr' must be set to point to - * short diagnostic string describing the error. - */ - -int esock_ssl_accept_init(Connection *cp, void *listenssl); -int esock_ssl_connect_init(Connection *cp); -int esock_ssl_listen_init(Connection *cp); - -/* All functions below may involve non-blocking I/O with a temporary - * failure. Hence they have to have the error context set to - * ERRNO_BLOCK, or else have esock_ssl_errstr set to point to a - * diagnostic string, in case the return value is < 0. If the return - * value is 0, cp->eof and cp->bp are set, if appropritate. - */ - -int esock_ssl_accept(Connection *cp); -int esock_ssl_connect(Connection *cp); - -int esock_ssl_read(Connection *cp, char *buf, int len); -int esock_ssl_write(Connection *cp, char *buf, int len); - -int esock_ssl_shutdown(Connection *cp); - -/* Peer certificate */ - -int esock_ssl_getpeercert(Connection *cp, unsigned char **buf); -int esock_ssl_getpeercertchain(Connection *cp, unsigned char **buf); - -/* Sessions */ -int esock_ssl_session_reused(Connection *cp); - -/* Protocol version and cipher of established connection */ -int esock_ssl_getprotocol_version(Connection *cp, char **buf); -int esock_ssl_getcipher(Connection *cp, char **buf); - -#endif diff --git a/lib/ssl/c_src/esock_utils.c b/lib/ssl/c_src/esock_utils.c deleted file mode 100644 index 0098a4f5f6..0000000000 --- a/lib/ssl/c_src/esock_utils.c +++ /dev/null @@ -1,150 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-2009. All Rights Reserved. - * - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * %CopyrightEnd% - */ - -/* - * Purpose: Safe memory allocation and other utilities. - * - */ -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include "esock_utils.h" - -static char *strtok_quote(char *s1, const char *s2); - - -void *esock_malloc(size_t size) -{ - void *p; - - p = malloc(size); - if (!p) { - fprintf(stderr, "esock_malloc: cannot alloc %d bytes\n", size); - exit(EXIT_FAILURE); - } - return p; -} - -void *esock_realloc(void *p, size_t size) -{ - void *np; - - np = realloc(p, size); - if (!np) { - fprintf(stderr, "esock_realloc: cannot realloc %d bytes\n", size); - exit(EXIT_FAILURE); - } - return np; -} - -void esock_free(void *p) -{ - free(p); -} - -/* Builds an argv array from cmd. Spaces and tabs within double quotes - * are not considered delimiters. Double quotes are removed. - * - * The return value is argc, and the pointer to char ** is set. argc - * is non-negative, argv[0], ..., argv[argc - 1] are pointers to - * strings, and argv[argc] == NULL. All argv[0], ..., argv[argc - 1] - * must be freed by the user, and also the argv pointer itself. - * - * Example: cmd = abc"/program files/"olle nisse, results in - * argv[0] = abc/program files/olle, argv[1] = nisse, argc = 2. - * - */ -int esock_build_argv(char *cmd, char ***argvp) -{ - int argvsize = 10, argc = 0; - char *args, *tokp, *argp; - char **argv; - - argv = esock_malloc(argvsize * sizeof(char *)); - args = esock_malloc(strlen(cmd) + 1); - strcpy(args, cmd); - tokp = strtok_quote(args, " \t"); - while (tokp != NULL) { - if (argc + 1 >= argvsize) { - argvsize += 10; - argv = esock_realloc(argv, argvsize * sizeof(char *)); - } - argp = esock_malloc(strlen(tokp) + 1); - strcpy(argp, tokp); - argv[argc++] = argp; - tokp = strtok_quote(NULL, " \t"); - } - esock_free(args); - argv[argc] = NULL; - *argvp = argv; - return argc; -} - -/* strtok_quote - * Works as strtok, but characters within pairs of double quotes are not - * considered as delimiters. Quotes are removed. - */ -static char *strtok_quote(char *s1, const char *s2) -{ - static char *last; - char *s, *t, *u; - - s = (s1) ? s1 : last; - if (!s) - return last = NULL; - - while (*s != '"' && *s != '\0' && strchr(s2, *s)) - s++; - t = s; - - while (1) { - if (*t == '"') { - t++; - while (*t != '"' && *t != '\0') - t++; - if (*t == '\0') { - last = NULL; - goto end; - } - t++; - } - while(*t != '"' && *t != '\0' && !strchr(s2, *t)) - t++; - if (*t == '\0') { - last = NULL; - goto end; - } else if (*t != '"') { - *t = '\0'; - last = t + 1; - goto end; - } - } -end: - /* Remove quotes */ - u = t = s; - while (*u) { - if (*u == '"') - u++; - else - *t++ = *u++; - } - *t = '\0'; - return s; -} - diff --git a/lib/ssl/c_src/esock_utils.h b/lib/ssl/c_src/esock_utils.h deleted file mode 100644 index 99ed6c23e3..0000000000 --- a/lib/ssl/c_src/esock_utils.h +++ /dev/null @@ -1,32 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-2009. All Rights Reserved. - * - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * %CopyrightEnd% - */ - -#ifndef ESOCK_UTILS_H -#define ESOCK_UTILS_H - -#include <stdlib.h> - -void *esock_malloc(size_t size); -void *esock_realloc(void *p, size_t size); -void esock_free(void *p); -int esock_build_argv(char *cmd, char ***argvp); - -#endif - - diff --git a/lib/ssl/c_src/esock_winsock.h b/lib/ssl/c_src/esock_winsock.h deleted file mode 100644 index 069782a18d..0000000000 --- a/lib/ssl/c_src/esock_winsock.h +++ /dev/null @@ -1,36 +0,0 @@ -/*<copyright> - * <year>2003-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * 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. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -/* - * Purpose: Control winsock version and setting of FD_SETSIZE. - * - */ - -/* Maybe set FD_SETSIZE */ - -#ifdef ESOCK_WINSOCK2 -#include <winsock2.h> -#else -#include <winsock.h> -/* These are defined in winsock2.h but not in winsock.h */ -#define SD_RECEIVE 0x00 -#define SD_SEND 0x01 -#define SD_BOTH 0x02 -#endif - diff --git a/lib/ssl/doc/src/Makefile b/lib/ssl/doc/src/Makefile index 3119d37af0..5d808d6727 100644 --- a/lib/ssl/doc/src/Makefile +++ b/lib/ssl/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2010. All Rights Reserved. +# Copyright Ericsson AB 1999-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 @@ -37,7 +37,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = refman.xml -XML_REF3_FILES = ssl.xml old_ssl.xml ssl_session_cache_api.xml +XML_REF3_FILES = ssl.xml ssl_session_cache_api.xml XML_REF6_FILES = ssl_app.xml XML_PART_FILES = release_notes.xml usersguide.xml diff --git a/lib/ssl/doc/src/old_ssl.xml b/lib/ssl/doc/src/old_ssl.xml deleted file mode 100644 index 0d2e1afdbd..0000000000 --- a/lib/ssl/doc/src/old_ssl.xml +++ /dev/null @@ -1,709 +0,0 @@ -<?xml version="1.0" encoding="latin1" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>1999</year><year>2010</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>ssl</title> - <prepared>Peter Högfeldt</prepared> - <responsible>Peter Högfeldt</responsible> - <docno></docno> - <approved>Peter Högfeldt</approved> - <checked></checked> - <date>2003-03-25</date> - <rev>D</rev> - <file>old_ssl.xml</file> - </header> - <module>old_ssl</module> - <modulesummary>Interface Functions for Secure Socket Layer</modulesummary> - <description> - <p>This module contains interface functions to the Secure Socket Layer.</p> - </description> - - <section> - <title>General</title> - - <p>This manual page describes functions that are defined - in the ssl module and represents the old ssl implementation - that coexists with the new one until it has been - totally phased out. </p> - - <p>The old implementation can be - accessed by providing the option {ssl_imp, old} to the - ssl:connect and ssl:listen functions.</p> - - <p>The reader is advised to also read the <c>ssl(6)</c> manual page - describing the SSL application. - </p> - <warning> - <p>It is strongly advised to seed the random generator after - the ssl application has been started (see <c>seed/1</c> - below), and before any connections are established. Although - the port program interfacing to the ssl libraries does a - "random" seeding of its own in order to make everything work - properly, that seeding is by no means random for the world - since it has a constant value which is known to everyone - reading the source code of the port program.</p> - </warning> - </section> - - <section> - <title>Common data types</title> - <p>The following datatypes are used in the functions below: - </p> - <list type="bulleted"> - <item> - <p><c>options() = [option()]</c></p> - </item> - <item> - <p><c>option() = socketoption() | ssloption()</c></p> - </item> - <item> - <p><c>socketoption() = {mode, list} | {mode, binary} | binary | {packet, packettype()} | {header, integer()} | {nodelay, boolean()} | {active, activetype()} | {backlog, integer()} | {ip, ipaddress()} | {port, integer()}</c></p> - </item> - <item> - <p><c>ssloption() = {verify, code()} | {depth, depth()} | {certfile, path()} | {keyfile, path()} | {password, string()} | {cacertfile, path()} | {ciphers, string()}</c></p> - </item> - <item> - <p><c>packettype()</c> (see inet(3))</p> - </item> - <item> - <p><c>activetype()</c> (see inet(3))</p> - </item> - <item> - <p><c>reason() = atom() | {atom(), string()}</c></p> - </item> - <item> - <p><c>bytes() = [byte()]</c></p> - </item> - <item> - <p><c>string() = [byte()]</c></p> - </item> - <item> - <p><c>byte() = 0 | 1 | 2 | ... | 255</c></p> - </item> - <item> - <p><c>code() = 0 | 1 | 2</c></p> - </item> - <item> - <p><c>depth() = byte()</c></p> - </item> - <item> - <p><c>address() = hostname() | ipstring() | ipaddress()</c></p> - </item> - <item> - <p><c>ipaddress() = ipstring() | iptuple()</c></p> - </item> - <item> - <p><c>hostname() = string()</c></p> - </item> - <item> - <p><c>ipstring() = string()</c></p> - </item> - <item> - <p><c>iptuple() = {byte(), byte(), byte(), byte()}</c></p> - </item> - <item> - <p><c>sslsocket()</c></p> - </item> - <item> - <p><c>protocol() = sslv2 | sslv3 | tlsv1</c></p> - </item> - <item> - <p><c></c></p> - </item> - </list> - <p>The socket option <c>{backlog, integer()}</c> is for - <c>listen/2</c> only, and the option <c>{port, integer()}</c> - is for <c>connect/3/4</c> only. - </p> - <p>The following socket options are set by default: <c>{mode, list}</c>, <c>{packet, 0}</c>, <c>{header, 0}</c>, <c>{nodelay, false}</c>, <c>{active, true}</c>, <c>{backlog, 5}</c>, - <c>{ip, {0,0,0,0}}</c>, and <c>{port, 0}</c>. - </p> - <p>Note that the options <c>{mode, binary}</c> and <c>binary</c> - are equivalent. Similarly <c>{mode, list}</c> and the absence of - option <c>binary</c> are equivalent. - </p> - <p>The ssl options are for setting specific SSL parameters as follows: - </p> - <list type="bulleted"> - <item> - <p><c>{verify, code()}</c> Specifies type of verification: - 0 = do not verify peer; 1 = verify peer, 2 = verify peer, - fail if no peer certificate. The default value is 0. - </p> - </item> - <item> - <p><c>{depth, depth()}</c> Specifies the maximum - verification depth, i.e. how far in a chain of certificates - the verification process can proceed before the verification - is considered to fail. - </p> - <p>Peer certificate = 0, CA certificate = 1, higher level CA - certificate = 2, etc. The value 2 thus means that a chain - can at most contain peer cert, CA cert, next CA cert, and an - additional CA cert. - </p> - <p>The default value is 1. - </p> - </item> - <item> - <p><c>{certfile, path()}</c> Path to a file containing the - user's certificate. - chain of PEM encoded certificates.</p> - </item> - <item> - <p><c>{keyfile, path()}</c> Path to file containing user's - private PEM encoded key.</p> - </item> - <item> - <p><c>{password, string()}</c> String containing the user's - password. Only used if the private keyfile is password protected.</p> - </item> - <item> - <p><c>{cacertfile, path()}</c> Path to file containing PEM encoded - CA certificates (trusted certificates used for verifying a peer - certificate).</p> - </item> - <item> - <p><c>{ciphers, string()}</c> String of ciphers as a colon - separated list of ciphers. The function <c>ciphers/0</c> can - be used to find all available ciphers.</p> - </item> - </list> - <p>The type <c>sslsocket()</c> is opaque to the user. - </p> - <p>The owner of a socket is the one that created it by a call to - <c>transport_accept/[1,2]</c>, <c>connect/[3,4]</c>, - or <c>listen/2</c>. - </p> - <p>When a socket is in active mode (the default), data from the - socket is delivered to the owner of the socket in the form of - messages: - </p> - <list type="bulleted"> - <item> - <p><c>{ssl, Socket, Data}</c></p> - </item> - <item> - <p><c>{ssl_closed, Socket}</c></p> - </item> - <item> - <p><c>{ssl_error, Socket, Reason}</c></p> - </item> - </list> - <p>A <c>Timeout</c> argument specifies a timeout in milliseconds. The - default value for a <c>Timeout</c> argument is <c>infinity</c>. - </p> - <p>Functions listed below may return the value <c>{error, closed}</c>, which only indicates that the SSL socket is - considered closed for the operation in question. It is for - instance possible to have <c>{error, closed}</c> returned from - an call to <c>send/2</c>, and a subsequent call to <c>recv/3</c> - returning <c>{ok, Data}</c>. - </p> - <p>Hence a return value of <c>{error, closed}</c> must not be - interpreted as if the socket was completely closed. On the - contrary, in order to free all resources occupied by an SSL - socket, <c>close/1</c> must be called, or else the process owning - the socket has to terminate. - </p> - <p>For each SSL socket there is an Erlang process representing the - socket. When a socket is opened, that process links to the - calling client process. Implementations that want to detect - abnormal exits from the socket process by receiving <c>{'EXIT', Pid, Reason}</c> messages, should use the function <c>pid/1</c> - to retrieve the process identifier from the socket, in order to - be able to match exit messages properly.</p> - </section> - <funcs> - <func> - <name>ciphers() -> {ok, string()} | {error, enotstarted}</name> - <fsummary>Get supported ciphers.</fsummary> - <desc> - <p>Returns a string consisting of colon separated cipher - designations that are supported by the current SSL library - implementation. - </p> - <p>The SSL application has to be started to return the string - of ciphers.</p> - </desc> - </func> - <func> - <name>close(Socket) -> ok | {error, Reason}</name> - <fsummary>Close a socket returned by <c>transport_accept/[1,2]</c>, <c>connect/3/4</c>, or <c>listen/2</c>.</fsummary> - <type> - <v>Socket = sslsocket()</v> - </type> - <desc> - <p>Closes a socket returned by <c>transport_accept/[1,2]</c>, - <c>connect/[3,4]</c>, or <c>listen/2</c></p> - </desc> - </func> - <func> - <name>connect(Address, Port, Options) -> {ok, Socket} | {error, Reason}</name> - <name>connect(Address, Port, Options, Timeout) -> {ok, Socket} | {error, Reason}</name> - <fsummary>Connect to <c>Port</c>at <c>Address</c>.</fsummary> - <type> - <v>Address = address()</v> - <v>Port = integer()</v> - <v>Options = [connect_option()]</v> - <v>connect_option() = {mode, list} | {mode, binary} | binary | {packet, packettype()} | {header, integer()} | {nodelay, boolean()} | {active, activetype()} | {ip, ipaddress()} | {port, integer()} | {verify, code()} | {depth, depth()} | {certfile, path()} | {keyfile, path()} | {password, string()} | {cacertfile, path()} | {ciphers, string()}</v> - <v>Timeout = integer()</v> - <v>Socket = sslsocket()</v> - </type> - <desc> - <p>Connects to <c>Port</c> at <c>Address</c>. If the optional - <c>Timeout</c> argument is specified, and a connection could not - be established within the given time, <c>{error, timeout}</c> is - returned. The default value for <c>Timeout</c> is <c>infinity</c>. - </p> - <p>The <c>ip</c> and <c>port</c> options are for binding to a - particular <em>local</em> address and port, respectively.</p> - </desc> - </func> - <func> - <name>connection_info(Socket) -> {ok, {Protocol, Cipher}} | {error, Reason}</name> - <fsummary>Get current protocol version and cipher.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Protocol = protocol()</v> - <v>Cipher = string()</v> - </type> - <desc> - <p>Gets the chosen protocol version and cipher for an established - connection (accepted och connected). </p> - </desc> - </func> - <func> - <name>controlling_process(Socket, NewOwner) -> ok | {error, Reason}</name> - <fsummary>Assign a new controlling process to the socket.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>NewOwner = pid()</v> - </type> - <desc> - <p>Assigns a new controlling process to <c>Socket</c>. A controlling - process is the owner of a socket, and receives all messages from - the socket.</p> - </desc> - </func> - <func> - <name>format_error(ErrorCode) -> string()</name> - <fsummary>Return an error string.</fsummary> - <type> - <v>ErrorCode = term()</v> - </type> - <desc> - <p>Returns a diagnostic string describing an error.</p> - </desc> - </func> - <func> - <name>getopts(Socket, OptionsTags) -> {ok, Options} | {error, Reason}</name> - <fsummary>Get options set for socket</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>OptionTags = [optiontag()]()</v> - </type> - <desc> - <p>Returns the options the tags of which are <c>OptionTags</c> for - for the socket <c>Socket</c>. </p> - </desc> - </func> - <func> - <name>listen(Port, Options) -> {ok, ListenSocket} | {error, Reason}</name> - <fsummary>Set up a socket to listen on a port on the local host.</fsummary> - <type> - <v>Port = integer()</v> - <v>Options = [listen_option()]</v> - <v>listen_option() = {mode, list} | {mode, binary} | binary | {packet, packettype()} | {header, integer()} | {active, activetype()} | {backlog, integer()} | {ip, ipaddress()} | {verify, code()} | {depth, depth()} | {certfile, path()} | {keyfile, path()} | {password, string()} | {cacertfile, path()} | {ciphers, string()}</v> - <v>ListenSocket = sslsocket()</v> - </type> - <desc> - <p>Sets up a socket to listen on port <c>Port</c> at the local host. - If <c>Port</c> is zero, <c>listen/2</c> picks an available port - number (use <c>port/1</c> to retrieve it). - </p> - <p>The listen queue size defaults to 5. If a different value is - wanted, the option <c>{backlog, Size}</c> should be added to the - list of options. - </p> - <p>An empty <c>Options</c> list is considered an error, and - <c>{error, enooptions}</c> is returned. - </p> - <p>The returned <c>ListenSocket</c> can only be used in calls to - <c>transport_accept/[1,2]</c>.</p> - </desc> - </func> - <func> - <name>peercert(Socket) -> {ok, Cert} | {error, Reason}</name> - <fsummary>Return the peer certificate.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Cert = binary()()</v> - <v>Subject = term()()</v> - </type> - <desc> - <p>Returns the DER encoded peer certificate, the certificate can be decoded with - <c>public_key:pkix_decode_cert/2</c>. - </p> - </desc> - </func> - <func> - <name>peername(Socket) -> {ok, {Address, Port}} | {error, Reason}</name> - <fsummary>Return peer address and port.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Address = ipaddress()</v> - <v>Port = integer()</v> - </type> - <desc> - <p>Returns the address and port number of the peer.</p> - </desc> - </func> - <func> - <name>pid(Socket) -> pid()</name> - <fsummary>Return the pid of the socket process.</fsummary> - <type> - <v>Socket = sslsocket()</v> - </type> - <desc> - <p>Returns the pid of the socket process. The returned pid should - only be used for receiving exit messages.</p> - </desc> - </func> - <func> - <name>recv(Socket, Length) -> {ok, Data} | {error, Reason}</name> - <name>recv(Socket, Length, Timeout) -> {ok, Data} | {error, Reason}</name> - <fsummary>Receive data on socket.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Length = integer() >= 0</v> - <v>Timeout = integer()</v> - <v>Data = bytes() | binary()</v> - </type> - <desc> - <p>Receives data on socket <c>Socket</c> when the socket is in - passive mode, i.e. when the option <c>{active, false}</c> - has been specified. - </p> - <p>A notable return value is <c>{error, closed}</c> which - indicates that the socket is closed. - </p> - <p>A positive value of the <c>Length</c> argument is only - valid when the socket is in raw mode (option <c>{packet, 0}</c> is set, and the option <c>binary</c> is <em>not</em> - set); otherwise it should be set to 0, whence all available - bytes are returned. - </p> - <p>If the optional <c>Timeout</c> parameter is specified, and - no data was available within the given time, <c>{error, timeout}</c> is returned. The default value for - <c>Timeout</c> is <c>infinity</c>.</p> - </desc> - </func> - <func> - <name>seed(Data) -> ok | {error, Reason}</name> - <fsummary>Seed the ssl random generator.</fsummary> - <type> - <v>Data = iolist() | binary()</v> - </type> - <desc> - <p>Seeds the ssl random generator. - </p> - <p>It is strongly advised to seed the random generator after - the ssl application has been started, and before any - connections are established. Although the port program - interfacing to the OpenSSL libraries does a "random" seeding - of its own in order to make everything work properly, that - seeding is by no means random for the world since it has a - constant value which is known to everyone reading the source - code of the seeding. - </p> - <p>A notable return value is <c>{error, edata}}</c> indicating that - <c>Data</c> was not a binary nor an iolist.</p> - </desc> - </func> - <func> - <name>send(Socket, Data) -> ok | {error, Reason}</name> - <fsummary>Write data to a socket.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Data = iolist() | binary()</v> - </type> - <desc> - <p>Writes <c>Data</c> to <c>Socket</c>. </p> - <p>A notable return value is <c>{error, closed}</c> indicating that - the socket is closed.</p> - </desc> - </func> - <func> - <name>setopts(Socket, Options) -> ok | {error, Reason}</name> - <fsummary>Set socket options.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Options = [socketoption]()</v> - </type> - <desc> - <p>Sets options according to <c>Options</c> for the socket - <c>Socket</c>. </p> - </desc> - </func> - <func> - <name>ssl_accept(Socket) -> ok | {error, Reason}</name> - <name>ssl_accept(Socket, Timeout) -> ok | {error, Reason}</name> - <fsummary>Perform server-side SSL handshake and key exchange</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Timeout = integer()</v> - <v>Reason = atom()</v> - </type> - <desc> - <p>The <c>ssl_accept</c> function establish the SSL connection - on the server side. It should be called directly after - <c>transport_accept</c>, in the spawned server-loop.</p> - <p>Note that the ssl connection is not complete until <c>ssl_accept</c> - has returned <c>true</c>, and if an error is returned, the socket - is unavailable and for instance <c>close/1</c> will crash.</p> - </desc> - </func> - <func> - <name>sockname(Socket) -> {ok, {Address, Port}} | {error, Reason}</name> - <fsummary>Return the local address and port.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Address = ipaddress()</v> - <v>Port = integer()</v> - </type> - <desc> - <p>Returns the local address and port number of the socket - <c>Socket</c>.</p> - </desc> - </func> - <func> - <name>transport_accept(Socket) -> {ok, NewSocket} | {error, Reason}</name> - <name>transport_accept(Socket, Timeout) -> {ok, NewSocket} | {error, Reason}</name> - <fsummary>Accept an incoming connection and prepare for <c>ssl_accept</c></fsummary> - <type> - <v>Socket = NewSocket = sslsocket()</v> - <v>Timeout = integer()</v> - <v>Reason = atom()</v> - </type> - <desc> - <p>Accepts an incoming connection request on a listen socket. - <c>ListenSocket</c> must be a socket returned from <c>listen/2</c>. - The socket returned should be passed to <c>ssl_accept</c> to - complete ssl handshaking and establishing the connection.</p> - <warning> - <p>The socket returned can only be used with <c>ssl_accept</c>, - no traffic can be sent or received before that call.</p> - </warning> - <p>The accepted socket inherits the options set for <c>ListenSocket</c> - in <c>listen/2</c>.</p> - <p>The default value for <c>Timeout</c> is <c>infinity</c>. If - <c>Timeout</c> is specified, and no connection is accepted within - the given time, <c>{error, timeout}</c> is returned.</p> - </desc> - </func> - <func> - <name>version() -> {ok, {SSLVsn, CompVsn, LibVsn}}</name> - <fsummary>Return the version of SSL.</fsummary> - <type> - <v>SSLVsn = CompVsn = LibVsn = string()()</v> - </type> - <desc> - <p>Returns the SSL application version (<c>SSLVsn</c>), the library - version used when compiling the SSL application port program - (<c>CompVsn</c>), and the actual library version used when - dynamically linking in runtime (<c>LibVsn</c>). - </p> - <p>If the SSL application has not been started, <c>CompVsn</c> and - <c>LibVsn</c> are empty strings. - </p> - </desc> - </func> - </funcs> - - <section> - <title>ERRORS</title> - <p>The possible error reasons and the corresponding diagnostic strings - returned by <c>format_error/1</c> are either the same as those defined - in the <c>inet(3)</c> reference manual, or as follows: - </p> - <taglist> - <tag><c>closed</c></tag> - <item> - <p>Connection closed for the operation in question. - </p> - </item> - <tag><c>ebadsocket</c></tag> - <item> - <p>Connection not found (internal error). - </p> - </item> - <tag><c>ebadstate</c></tag> - <item> - <p>Connection not in connect state (internal error). - </p> - </item> - <tag><c>ebrokertype</c></tag> - <item> - <p>Wrong broker type (internal error). - </p> - </item> - <tag><c>ecacertfile</c></tag> - <item> - <p>Own CA certificate file is invalid. - </p> - </item> - <tag><c>ecertfile</c></tag> - <item> - <p>Own certificate file is invalid. - </p> - </item> - <tag><c>echaintoolong</c></tag> - <item> - <p>The chain of certificates provided by peer is too long. - </p> - </item> - <tag><c>ecipher</c></tag> - <item> - <p>Own list of specified ciphers is invalid. - </p> - </item> - <tag><c>ekeyfile</c></tag> - <item> - <p>Own private key file is invalid. - </p> - </item> - <tag><c>ekeymismatch</c></tag> - <item> - <p>Own private key does not match own certificate. - </p> - </item> - <tag><c>enoissuercert</c></tag> - <item> - <p>Cannot find certificate of issuer of certificate provided - by peer. - </p> - </item> - <tag><c>enoservercert</c></tag> - <item> - <p>Attempt to do accept without having set own certificate. - </p> - </item> - <tag><c>enotlistener</c></tag> - <item> - <p>Attempt to accept on a non-listening socket. - </p> - </item> - <tag><c>enoproxysocket</c></tag> - <item> - <p>No proxy socket found (internal error). - </p> - </item> - <tag><c>enooptions</c></tag> - <item> - <p>The list of options is empty. - </p> - </item> - <tag><c>enotstarted</c></tag> - <item> - <p>The SSL application has not been started. - </p> - </item> - <tag><c>eoptions</c></tag> - <item> - <p>Invalid list of options. - </p> - </item> - <tag><c>epeercert</c></tag> - <item> - <p>Certificate provided by peer is in error. - </p> - </item> - <tag><c>epeercertexpired</c></tag> - <item> - <p>Certificate provided by peer has expired. - </p> - </item> - <tag><c>epeercertinvalid</c></tag> - <item> - <p>Certificate provided by peer is invalid. - </p> - </item> - <tag><c>eselfsignedcert</c></tag> - <item> - <p>Certificate provided by peer is self signed. - </p> - </item> - <tag><c>esslaccept</c></tag> - <item> - <p>Server SSL handshake procedure between client and server failed. - </p> - </item> - <tag><c>esslconnect</c></tag> - <item> - <p>Client SSL handshake procedure between client and server failed. - </p> - </item> - <tag><c>esslerrssl</c></tag> - <item> - <p>SSL protocol failure. Typically because of a fatal alert - from peer. - </p> - </item> - <tag><c>ewantconnect</c></tag> - <item> - <p>Protocol wants to connect, which is not supported in - this version of the SSL application. - </p> - </item> - <tag><c>ex509lookup</c></tag> - <item> - <p>Protocol wants X.509 lookup, which is not supported in - this version of the SSL application. - </p> - </item> - <tag><c>{badcall, Call}</c></tag> - <item> - <p>Call not recognized for current mode (active or passive) and - state of socket. - </p> - </item> - <tag><c>{badcast, Cast}</c></tag> - <item> - <p>Call not recognized for current mode (active or passive) and - state of socket. - </p> - </item> - <tag><c>{badinfo, Info}</c></tag> - <item> - <p>Call not recognized for current mode (active or passive) and - state of socket. - </p> - </item> - </taglist> - </section> - - <section> - <title>SEE ALSO</title> - <p>gen_tcp(3), inet(3) public_key(3) </p> - </section> - -</erlref> - - diff --git a/lib/ssl/doc/src/refman.xml b/lib/ssl/doc/src/refman.xml index 68f84660f3..011819e82b 100644 --- a/lib/ssl/doc/src/refman.xml +++ b/lib/ssl/doc/src/refman.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE application SYSTEM "application.dtd"> <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1999</year><year>2010</year> + <year>1999</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -45,7 +45,6 @@ </description> <xi:include href="ssl_app.xml"/> <xi:include href="ssl.xml"/> - <xi:include href="old_ssl.xml"/> <xi:include href="ssl_session_cache_api.xml"/> </application> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 47991ca477..50268ae206 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -71,7 +71,8 @@ {fail_if_no_peer_cert, boolean()} {depth, integer()} | {cert, der_encoded()}| {certfile, path()} | - {key, der_encoded()} | {keyfile, path()} | {password, string()} | + {key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'PrivateKeyInfo', der_encoded()}} | + {keyfile, path()} | {password, string()} | {cacerts, [der_encoded()]} | {cacertfile, path()} | |{dh, der_encoded()} | {dhfile, path()} | {ciphers, ciphers()} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | {reuse_session, fun()} @@ -121,8 +122,6 @@ <p> <c>hash() = md5 | sha </c></p> - <p><c>ssl_imp() = new | old - default is new.</c></p> - </section> <section> @@ -141,7 +140,7 @@ <tag>{certfile, path()}</tag> <item>Path to a file containing the user's certificate.</item> - <tag>{key, der_encoded()}</tag> + <tag>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'PrivateKeyInfo', der_encoded()}}</tag> <item> The DER encoded users private key. If this option is supplied it will override the keyfile option.</item> @@ -177,9 +176,9 @@ by the peer also. </item> - <tag>{ssl_imp, ssl_imp()}</tag> - <item>Specify which ssl implementation you want to use. Defaults to - new. + <tag>{ssl_imp, new | old}</tag> + <item>No longer has any meaning as the old implementation has + been removed, it will be ignored. </item> <tag>{secure_renegotiate, boolean()}</tag> diff --git a/lib/ssl/doc/src/ssl_distribution.xml b/lib/ssl/doc/src/ssl_distribution.xml index 7bcc12eb5f..4ae4ead3ee 100644 --- a/lib/ssl/doc/src/ssl_distribution.xml +++ b/lib/ssl/doc/src/ssl_distribution.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2000</year><year>2010</year> + <year>2000</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -33,36 +33,32 @@ </header> <p>This chapter describes how the Erlang distribution can use SSL to get additional verification and security. - - <note><p>Note this - documentation is written for the old ssl implementation and - will be updated for the new one once this functionality is - supported by the new implementation.</p></note> </p> <section> <title>Introduction</title> <p>The Erlang distribution can in theory use almost any connection based protocol as bearer. A module that implements the protocol - specific parts of connection setup is however needed. The + specific parts of the connection setup is however needed. The default distribution module is <c>inet_tcp_dist</c> which is included in the Kernel application. When starting an Erlang node distributed, <c>net_kernel</c> uses this module to setup listen ports and connections. </p> - <p>In the SSL application there is an additional distribution - module, <c>inet_ssl_dist</c> which can be used as an + + <p>In the SSL application there is an additional distribution + module, <c>inet_tls_dist</c> which can be used as an alternative. All distribution connections will be using SSL and all participating Erlang nodes in a distributed system must use this distribution module.</p> - <p>The security depends on how the connections are set up, one can - use key files or certificates to just get a encrypted - connection. One can also make the SSL package verify the - certificates of other nodes to get additional security. - Cookies are however always used as they can be used to - differentiate between two different Erlang networks.</p> + + <p>The security level depends on the parameters provided to the + SSL connection setup. Erlang node cookies are however always + used, as they can be used to differentiate between two different + Erlang networks.</p> <p>Setting up Erlang distribution over SSL involves some simple but necessary steps:</p> - <list type="bulleted"> + + <list type="bulleted"> <item>Building boot scripts including the SSL application</item> <item>Specifying the distribution module for net_kernel</item> <item>Specifying security options and other SSL options</item> @@ -77,122 +73,135 @@ SASL application. Refer to the SASL documentations for more information on systools. This is only an example of what can be done.</p> - <p>The simplest boot script possible includes only the Kernel + + <p>The simplest boot script possible includes only the Kernel and STDLIB applications. Such a script is located in the Erlang distributions bin directory. The source for the script can be found under the Erlang installation top directory under - <c><![CDATA[releases/<OTP version>start_clean.rel]]></c>. Copy that + <c><![CDATA[releases/<OTP version>/start_clean.rel]]></c>. Copy that script to another location (and preferably another name) - and add the SSL application with its current version number + and add the applications crypto, public_key and SSL with their current version numbers after the STDLIB application.</p> <p>An example .rel file with SSL added may look like this:</p> + <code type="none"> -{release, {"OTP APN 181 01","P7A"}, {erts, "5.0"}, - [{kernel,"2.5"}, - {stdlib,"1.8.1"}, - {ssl,"2.2.1"}]}. </code> - <p>Note that the version numbers surely will differ in your system. - Whenever one of the applications included in the script is - upgraded, the script has to be changed.</p> - <p>Assuming the above .rel file is stored in a file - <c>start_ssl.rel</c> in the current directory, a boot script - can be built like this:</p> - <code type="none"> -1> systools:make_script("start_ssl",[]). </code> - <p>There will now be a file <c>start_ssl.boot</c> in the current - directory. To test the boot script, start Erlang with the - <c>-boot</c> command line parameter specifying this boot script - (with its full path but without the <c>.boot</c> suffix), in - Unix it could look like this:</p> - <p></p> - <code type="none"><![CDATA[ + {release, {"OTP APN 181 01","R15A"}, {erts, "5.9"}, + [{kernel,"2.15"}, + {stdlib,"1.18"}, + {crypto, "2.0.3"}, + {public_key, "0.12"}, + {ssl, "5.0"} + ]}. + </code> + + <p>Note that the version numbers surely will differ in your system. + Whenever one of the applications included in the script is + upgraded, the script has to be changed.</p> + <p>Assuming the above .rel file is stored in a file + <c>start_ssl.rel</c> in the current directory, a boot script + can be built like this:</p> + + <code type="none"> + 1> systools:make_script("start_ssl",[]). </code> + + <p>There will now be a file <c>start_ssl.boot</c> in the current + directory. To test the boot script, start Erlang with the + <c>-boot</c> command line parameter specifying this boot script + (with its full path but without the <c>.boot</c> suffix), in + Unix it could look like this:</p> + <p></p> + + <code type="none"><![CDATA[ $ erl -boot /home/me/ssl/start_ssl Erlang (BEAM) emulator version 5.0 Eshell V5.0 (abort with ^G) -1> whereis(ssl_server). -<0.32.0> ]]></code> +1> whereis(ssl_manager). +<0.41.0> ]]></code> <p>The <c>whereis</c> function call verifies that the SSL application is really started.</p> - <p>As an alternative to building a bootscript, one can explicitly - add the path to the ssl <c>ebin</c> directory on the command + + <p>As an alternative to building a bootscript, one can explicitly + add the path to the SSL <c>ebin</c> directory on the command line. This is done with the command line option <c>-pa</c>. This - works as the ssl application really need not be started for the - distribution to come up, a primitive version of the ssl server - is started by the distribution module itself, so as long as the - primitive code server can reach the code, the distribution will + works as the SSL application does not need to be started for the + distribution to come up, as a clone of the SSL application is + hooked into the kernel application, so as long as the + SSL applications code can be reached, the distribution will start. The <c>-pa</c> method is only recommended for testing purposes.</p> + + <note><p>Note that the clone of the SSL application is necessary to + enable the use of the SSL code in such an early bootstage as + needed to setup the distribution, however this will make it + impossible to soft upgrade the SSL application.</p></note> </section> <section> <title>Specifying distribution module for net_kernel</title> - <p>The distribution module for SSL is named <c>inet_ssl_dist</c> - and is specified on the command line whit the <c>-proto_dist</c> + <p>The distribution module for SSL is named <c>inet_tls_dist</c> + and is specified on the command line with the <c>-proto_dist</c> option. The argument to <c>-proto_dist</c> should be the module name without the <c>_dist</c> suffix, so this distribution - module is specified with <c>-proto_dist inet_ssl</c> on the + module is specified with <c>-proto_dist inet_tls</c> on the command line.</p> <p></p> + <p>Extending the command line from above gives us the following:</p> <code type="none"> -$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_ssl </code> - <p>For the distribution to actually be started, we need to give - the emulator a name as well:</p> +$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls </code> + +<p>For the distribution to actually be started, we need to give +the emulator a name as well:</p> <code type="none"> -$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_ssl -sname ssl_test +$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls -sname ssl_test Erlang (BEAM) emulator version 5.0 [source] Eshell V5.0 (abort with ^G) (ssl_test@myhost)1> </code> <p>Note however that a node started in this way will refuse to talk - to other nodes, as no certificates or key files are supplied + to other nodes, as no ssl parameters are supplied (see below).</p> - <p>When the SSL distribution starts, the OTP system is in its - early boot stage, why neither <c>application</c> nor <c>code</c> - are usable. As SSL needs to start a port program in this early - stage, it tries to determine the path to that program from the - primitive code loaders code path. If this fails, one need to - specify the directory where the port program resides. This can - be done either with an environment variable - <c>ERL_SSL_PORTPROGRAM_DIR</c> or with the command line option - <c>-ssl_portprogram_dir</c>. The value should be the directory - where the <c>ssl_esock</c> port program is located. Note that - this option is never needed in a normal Erlang installation.</p> </section> <section> - <title>Specifying security options and other SSL options</title> - <p>For SSL to work, you either need certificate files or a - key file. Certificate files can be specified both when working as - client and as server (connecting or accepting). </p> - <p></p> + <title>Specifying SSL options</title> <p>For SSL to work, at least + a public key and certificate needs to be specified for the server + side. In the following example the PEM-files consists of two + entries the servers certificate and its private key.</p> + <p>On the <c>erl</c> command line one can specify options that the - ssl distribution will add when creation a socket. It is - mandatory to specify at least a key file or client and server - certificates. One can specify any <em>SSL option</em> on the - command line, but must not specify any socket options (like - packet size and such). The SSL options are listed in the - Reference Manual. The only difference between the - options in the reference manual and the ones that can be - specified to the distribution on the command line is that - <c>certfile</c> can (and usually needs to) be specified as - <c>client_certfile</c> and <c>server_certfile</c>. The - <c>client_certfile</c> is used when the distribution initiates a - connection to another node and the <c>server_certfile</c> is used - when accepting a connection from a remote node. </p> - <p>The command line argument for specifying the SSL options is named - <c>-ssl_dist_opt</c> and should be followed by an even number of - SSL options/option values. The <c>-ssl_dist_opt</c> argument can - be repeated any number of times.</p> - <p>An example command line would now look something like this + SSL distribution will add when creating a socket.</p> + + <p>One can specify the simpler SSL options certfile, keyfile, + password, cacertfile, verify, reuse_sessions, + secure_renegotiate, depth, hibernate_after and ciphers (use old + string format) by adding the prefix server_ or client_ to the + option name. The server can also take the options dhfile and + fail_if_no_peer_cert (also prefixed). + <c>client_</c>-prfixed options are used when the distribution initiates a + connection to another node and the <c>server_</c>-prefixed options are used + when accepting a connection from a remote node. </p> + + <p> More complex options such as verify_fun are not available at + the moment but a mechanism to handle such options may be added in + a future release. </p> + + <p> Raw socket options such as packet and size must not be specified on + the command line</p>. + + <p>The command line argument for specifying the SSL options is named + <c>-ssl_dist_opt</c> and should be followed by pairs of + SSL options and their values. The <c>-ssl_dist_opt</c> argument can + be repeated any number of times.</p> + + <p>An example command line would now look something like this (line breaks in the command are for readability, they should not be there when typed):</p> <code type="none"> -$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_ssl - -ssl_dist_opt client_certfile "/home/me/ssl/erlclient.pem" +$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls -ssl_dist_opt server_certfile "/home/me/ssl/erlserver.pem" - -ssl_dist_opt verify 1 depth 1 + -ssl_dist_opt server_secure_renegotiate true client_secure_renegotiate true -sname ssl_test Erlang (BEAM) emulator version 5.0 [source] @@ -211,12 +220,11 @@ Eshell V5.0 (abort with ^G) subsequent invocations of Erlang.</p> <p></p> <p>In a Unix (Bourne) shell it could look like this (line breaks for - readability):</p> + readability, they should not be there when typed):</p> <code type="none"> -$ ERL_FLAGS="-boot \\"/home/me/ssl/start_ssl\\" -proto_dist inet_ssl - -ssl_dist_opt client_certfile \\"/home/me/ssl/erlclient.pem\\" - -ssl_dist_opt server_certfile \\"/home/me/ssl/erlserver.pem\\" - -ssl_dist_opt verify 1 -ssl_dist_opt depth 1" +$ ERL_FLAGS="-boot /home/me/ssl/start_ssl -proto_dist inet_tls + -ssl_dist_opt server_certfile /home/me/ssl/erlserver.pem + -ssl_dist_opt server_secure_renegotiate true client_secure_renegotiate true" $ export ERL_FLAGS $ erl -sname ssl_test Erlang (BEAM) emulator version 5.0 [source] @@ -227,15 +235,12 @@ Eshell V5.0 (abort with ^G) {progname,["erl "]}, {sname,["ssl_test"]}, {boot,["/home/me/ssl/start_ssl"]}, - {proto_dist,["inet_ssl"]}, - {ssl_dist_opt,["client_certfile","/home/me/ssl/erlclient.pem"]}, + {proto_dist,["inet_tls"]}, {ssl_dist_opt,["server_certfile","/home/me/ssl/erlserver.pem"]}, - {ssl_dist_opt,["verify","1"]}, - {ssl_dist_opt,["depth","1"]}, + {ssl_dist_opt,["server_secure_renegotiate","true", + "client_secure_renegotiate","true"] {home,["/home/me"]}] </code> <p>The <c>init:get_arguments()</c> call verifies that the correct arguments are supplied to the emulator. </p> </section> </chapter> - - diff --git a/lib/ssl/doc/src/ssl_protocol.xml b/lib/ssl/doc/src/ssl_protocol.xml index ff6c769f6c..17268a634d 100644 --- a/lib/ssl/doc/src/ssl_protocol.xml +++ b/lib/ssl/doc/src/ssl_protocol.xml @@ -25,18 +25,18 @@ <file>ssl_protocol.xml</file> </header> - <p>The erlang ssl application currently supports SSL 3.0 and TLS 1.0 + <p>The erlang SSL application currently supports SSL 3.0 and TLS 1.0 RFC 2246, and will in the future also support later versions of TLS. SSL 2.0 is not supported. </p> - <p>By default erlang ssl is run over the TCP/IP protocol even + <p>By default erlang SSL is run over the TCP/IP protocol even though you could plug in any other reliable transport protocol with the same API as gen_tcp.</p> <p>If a client and server wants to use an upgrade mechanism, such as - defined by RFC2817, to upgrade a regular TCP/IP connection to an ssl - connection the erlang ssl API supports this. This can be useful for + defined by RFC2817, to upgrade a regular TCP/IP connection to an SSL + connection the erlang SSL API supports this. This can be useful for things such as supporting HTTP and HTTPS on the same port and implementing virtual hosting. </p> @@ -131,7 +131,7 @@ connections. Sessions are used to avoid the expensive negotiation of new security parameters for each connection."</p> - <p>Session data is by default kept by the ssl application in a + <p>Session data is by default kept by the SSL application in a memory storage hence session data will be lost at application restart or takeover. Users may define their own callback module to handle session data storage if persistent data storage is @@ -140,8 +140,8 @@ possible to configure the amount of time the session data should be saved.</p> - <p>Ssl clients will by default try to reuse an available session, - ssl servers will by default agree to reuse sessions when clients + <p>SSL clients will by default try to reuse an available session, + SSL servers will by default agree to reuse sessions when clients ask to do so.</p> </section> diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 7514ad2aa2..dc69b53b28 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2010. All Rights Reserved. +# Copyright Ericsson AB 1999-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 @@ -41,12 +41,9 @@ MODULES= \ ssl \ ssl_alert \ ssl_app \ - ssl_broker \ - ssl_broker_sup \ - ssl_server \ + ssl_dist_sup\ ssl_sup \ - ssl_prim \ - inet_ssl_dist \ + inet_tls_dist \ ssl_certificate\ ssl_certificate_db\ ssl_cipher \ @@ -62,9 +59,10 @@ MODULES= \ ssl_ssl2 \ ssl_ssl3 \ ssl_tls1 \ + ssl_tls_dist_proxy INTERNAL_HRL_FILES = \ - ssl_int.hrl ssl_broker_int.hrl ssl_debug.hrl \ + ssl_debug.hrl \ ssl_alert.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_internal.hrl \ ssl_record.hrl diff --git a/lib/ssl/src/inet_ssl_dist.erl b/lib/ssl/src/inet_ssl_dist.erl deleted file mode 100644 index 6c0fbc0618..0000000000 --- a/lib/ssl/src/inet_ssl_dist.erl +++ /dev/null @@ -1,456 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-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% -%% - -%% --module(inet_ssl_dist). - -%% Handles the connection setup phase with other Erlang nodes. - --export([childspecs/0, listen/1, accept/1, accept_connection/5, - setup/5, close/1, select/1, is_node_name/1]). - -%% internal exports - --export([accept_loop/2,do_accept/6,do_setup/6, getstat/1,tick/1]). - --import(error_logger,[error_msg/2]). - --include("net_address.hrl"). - - - --define(to_port(Socket, Data, Opts), - case ssl_prim:send(Socket, Data, Opts) of - {error, closed} -> - self() ! {ssl_closed, Socket}, - {error, closed}; - R -> - R - end). - - --include("dist.hrl"). --include("dist_util.hrl"). - -%% ------------------------------------------------------------- -%% This function should return a valid childspec, so that -%% the primitive ssl_server gets supervised -%% ------------------------------------------------------------- -childspecs() -> - {ok, [{ssl_server_prim,{ssl_server, start_link_prim, []}, - permanent, 2000, worker, [ssl_server]}]}. - - -%% ------------------------------------------------------------ -%% Select this protocol based on node name -%% select(Node) => Bool -%% ------------------------------------------------------------ - -select(Node) -> - case split_node(atom_to_list(Node), $@, []) of - [_,_Host] -> true; - _ -> false - end. - -%% ------------------------------------------------------------ -%% Create the listen socket, i.e. the port that this erlang -%% node is accessible through. -%% ------------------------------------------------------------ - -listen(Name) -> - case ssl_prim:listen(0, [{active, false}, {packet,4}] ++ - get_ssl_options(server)) of - {ok, Socket} -> - TcpAddress = get_tcp_address(Socket), - {_,Port} = TcpAddress#net_address.address, - {ok, Creation} = erl_epmd:register_node(Name, Port), - {ok, {Socket, TcpAddress, Creation}}; - Error -> - Error - end. - -%% ------------------------------------------------------------ -%% Accepts new connection attempts from other Erlang nodes. -%% ------------------------------------------------------------ - -accept(Listen) -> - spawn_link(?MODULE, accept_loop, [self(), Listen]). - -accept_loop(Kernel, Listen) -> - process_flag(priority, max), - case ssl_prim:accept(Listen) of - {ok, Socket} -> - Kernel ! {accept,self(),Socket,inet,ssl}, - controller(Kernel, Socket), - accept_loop(Kernel, Listen); - Error -> - exit(Error) - end. - -controller(Kernel, Socket) -> - receive - {Kernel, controller, Pid} -> - flush_controller(Pid, Socket), - ssl_prim:controlling_process(Socket, Pid), - flush_controller(Pid, Socket), - Pid ! {self(), controller}; - {Kernel, unsupported_protocol} -> - exit(unsupported_protocol) - end. - -flush_controller(Pid, Socket) -> - receive - {ssl, Socket, Data} -> - Pid ! {ssl, Socket, Data}, - flush_controller(Pid, Socket); - {ssl_closed, Socket} -> - Pid ! {ssl_closed, Socket}, - flush_controller(Pid, Socket) - after 0 -> - ok - end. - -%% ------------------------------------------------------------ -%% Accepts a new connection attempt from another Erlang node. -%% Performs the handshake with the other side. -%% ------------------------------------------------------------ - -accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) -> - spawn_link(?MODULE, do_accept, - [self(), AcceptPid, Socket, MyNode, - Allowed, SetupTime]). - -%% Suppress dialyzer warning, we do not really care about old ssl code -%% as we intend to remove it. --spec(do_accept(_,_,_,_,_,_) -> no_return()). -do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> - process_flag(priority, max), - receive - {AcceptPid, controller} -> - Timer = dist_util:start_timer(SetupTime), - case check_ip(Socket) of - true -> - HSData = #hs_data{ - kernel_pid = Kernel, - this_node = MyNode, - socket = Socket, - timer = Timer, - this_flags = 0, - allowed = Allowed, - f_send = fun(S,D) -> ssl_prim:send(S,D) end, - f_recv = fun(S,N,T) -> ssl_prim:recv(S,N,T) - end, - f_setopts_pre_nodeup = - fun(S) -> - ssl_prim:setopts(S, - [{active, false}]) - end, - f_setopts_post_nodeup = - fun(S) -> - ssl_prim:setopts(S, - [{deliver, port}, - {active, true}]) - end, - f_getll = fun(S) -> - ssl_prim:getll(S) - end, - f_address = fun get_remote_id/2, - mf_tick = fun ?MODULE:tick/1, - mf_getstat = fun ?MODULE:getstat/1 - }, - dist_util:handshake_other_started(HSData); - {false,IP} -> - error_msg("** Connection attempt from " - "disallowed IP ~w ** ~n", [IP]), - ?shutdown(no_node) - end - end. - -%% ------------------------------------------------------------ -%% Get remote information about a Socket. -%% ------------------------------------------------------------ - -get_remote_id(Socket, Node) -> - {ok, Address} = ssl_prim:peername(Socket), - [_, Host] = split_node(atom_to_list(Node), $@, []), - #net_address { - address = Address, - host = Host, - protocol = ssl, - family = inet }. - -%% ------------------------------------------------------------ -%% Setup a new connection to another Erlang node. -%% Performs the handshake with the other side. -%% ------------------------------------------------------------ - -setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> - spawn_link(?MODULE, do_setup, [self(), - Node, - Type, - MyNode, - LongOrShortNames, - SetupTime]). - -%% Suppress dialyzer warning, we do not really care about old ssl code -%% as we intend to remove it. --spec(do_setup(_,_,_,_,_,_) -> no_return()). -do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) -> - process_flag(priority, max), - ?trace("~p~n",[{inet_ssl_dist,self(),setup,Node}]), - [Name, Address] = splitnode(Node, LongOrShortNames), - case inet:getaddr(Address, inet) of - {ok, Ip} -> - Timer = dist_util:start_timer(SetupTime), - case erl_epmd:port_please(Name, Ip) of - {port, TcpPort, Version} -> - ?trace("port_please(~p) -> version ~p~n", - [Node,Version]), - dist_util:reset_timer(Timer), - case ssl_prim:connect(Ip, TcpPort, - [{active, false}, - {packet,4}] ++ - get_ssl_options(client)) of - {ok, Socket} -> - HSData = #hs_data{ - kernel_pid = Kernel, - other_node = Node, - this_node = MyNode, - socket = Socket, - timer = Timer, - this_flags = 0, - other_version = Version, - f_send = fun(S,D) -> - ssl_prim:send(S,D) - end, - f_recv = fun(S,N,T) -> - ssl_prim:recv(S,N,T) - end, - f_setopts_pre_nodeup = - fun(S) -> - ssl_prim:setopts - (S, - [{active, false}]) - end, - f_setopts_post_nodeup = - fun(S) -> - ssl_prim:setopts - (S, - [{deliver, port},{active, true}]) - end, - f_getll = fun(S) -> - ssl_prim:getll(S) - end, - f_address = - fun(_,_) -> - #net_address { - address = {Ip,TcpPort}, - host = Address, - protocol = ssl, - family = inet} - end, - mf_tick = fun ?MODULE:tick/1, - mf_getstat = fun ?MODULE:getstat/1, - request_type = Type - }, - dist_util:handshake_we_started(HSData); - _ -> - %% Other Node may have closed since - %% port_please ! - ?trace("other node (~p) " - "closed since port_please.~n", - [Node]), - ?shutdown(Node) - end; - _ -> - ?trace("port_please (~p) " - "failed.~n", [Node]), - ?shutdown(Node) - end; - _Other -> - ?trace("inet_getaddr(~p) " - "failed (~p).~n", [Node,Other]), - ?shutdown(Node) - end. - -%% -%% Close a socket. -%% -close(Socket) -> - ssl_prim:close(Socket). - - -%% If Node is illegal terminate the connection setup!! -splitnode(Node, LongOrShortNames) -> - case split_node(atom_to_list(Node), $@, []) of - [Name|Tail] when Tail =/= [] -> - Host = lists:append(Tail), - case split_node(Host, $., []) of - [_] when LongOrShortNames == longnames -> - error_msg("** System running to use " - "fully qualified " - "hostnames **~n" - "** Hostname ~s is illegal **~n", - [Host]), - ?shutdown(Node); - [_, _ | _] when LongOrShortNames == shortnames -> - error_msg("** System NOT running to use fully qualified " - "hostnames **~n" - "** Hostname ~s is illegal **~n", - [Host]), - ?shutdown(Node); - _ -> - [Name, Host] - end; - [_] -> - error_msg("** Nodename ~p illegal, no '@' character **~n", - [Node]), - ?shutdown(Node); - _ -> - error_msg("** Nodename ~p illegal **~n", [Node]), - ?shutdown(Node) - end. - -split_node([Chr|T], Chr, Ack) -> [lists:reverse(Ack)|split_node(T, Chr, [])]; -split_node([H|T], Chr, Ack) -> split_node(T, Chr, [H|Ack]); -split_node([], _, Ack) -> [lists:reverse(Ack)]. - -%% ------------------------------------------------------------ -%% Fetch local information about a Socket. -%% ------------------------------------------------------------ -get_tcp_address(Socket) -> - {ok, Address} = ssl_prim:sockname(Socket), - {ok, Host} = inet:gethostname(), - #net_address { - address = Address, - host = Host, - protocol = ssl, - family = inet - }. - -%% ------------------------------------------------------------ -%% Do only accept new connection attempts from nodes at our -%% own LAN, if the check_ip environment parameter is true. -%% ------------------------------------------------------------ -check_ip(Socket) -> - case application:get_env(check_ip) of - {ok, true} -> - case get_ifs(Socket) of - {ok, IFs, IP} -> - check_ip(IFs, IP); - _ -> - ?shutdown(no_node) - end; - _ -> - true - end. - -get_ifs(Socket) -> - case ssl_prim:peername(Socket) of - {ok, {IP, _}} -> - case ssl_prim:getif(Socket) of - {ok, IFs} -> {ok, IFs, IP}; - Error -> Error - end; - Error -> - Error - end. - -check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) -> - case {mask(Netmask, PeerIP), mask(Netmask, OwnIP)} of - {M, M} -> true; - _ -> check_ip(IFs, PeerIP) - end; -check_ip([], PeerIP) -> - {false, PeerIP}. - -mask({M1,M2,M3,M4}, {IP1,IP2,IP3,IP4}) -> - {M1 band IP1, - M2 band IP2, - M3 band IP3, - M4 band IP4}. - -is_node_name(Node) when is_atom(Node) -> - case split_node(atom_to_list(Node), $@, []) of - [_, _Host] -> true; - _ -> false - end; -is_node_name(_Node) -> - false. -tick(Sock) -> - ?to_port(Sock,[],[force]). -getstat(Socket) -> - case ssl_prim:getstat(Socket, [recv_cnt, send_cnt, send_pend]) of - {ok, Stat} -> - split_stat(Stat,0,0,0); - Error -> - Error - end. - -split_stat([{recv_cnt, R}|Stat], _, W, P) -> - split_stat(Stat, R, W, P); -split_stat([{send_cnt, W}|Stat], R, _, P) -> - split_stat(Stat, R, W, P); -split_stat([{send_pend, P}|Stat], R, W, _) -> - split_stat(Stat, R, W, P); -split_stat([], R, W, P) -> - {ok, R, W, P}. - - -get_ssl_options(Type) -> - case init:get_argument(ssl_dist_opt) of - {ok, Args} -> - ssl_options(Type, Args); - _ -> - [] - end. - -ssl_options(_,[]) -> - []; -ssl_options(server, [["server_certfile", Value]|T]) -> - [{certfile, Value} | ssl_options(server,T)]; -ssl_options(client, [["client_certfile", Value]|T]) -> - [{certfile, Value} | ssl_options(client,T)]; -ssl_options(server, [["server_cacertfile", Value]|T]) -> - [{cacertfile, Value} | ssl_options(server,T)]; -ssl_options(server, [["server_keyfile", Value]|T]) -> - [{keyfile, Value} | ssl_options(server,T)]; -ssl_options(Type, [["client_certfile", _Value]|T]) -> - ssl_options(Type,T); -ssl_options(Type, [["server_certfile", _Value]|T]) -> - ssl_options(Type,T); -ssl_options(Type, [[Item, Value]|T]) -> - [{atomize(Item),fixup(Value)} | ssl_options(Type,T)]; -ssl_options(Type, [[Item,Value |T1]|T2]) -> - ssl_options(atomize(Type),[[Item,Value],T1|T2]); -ssl_options(_,_) -> - exit(malformed_ssl_dist_opt). - -fixup(Value) -> - case catch list_to_integer(Value) of - {'EXIT',_} -> - Value; - Int -> - Int - end. - -atomize(List) when is_list(List) -> - list_to_atom(List); -atomize(Atom) when is_atom(Atom) -> - Atom. diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl new file mode 100644 index 0000000000..115527aae0 --- /dev/null +++ b/lib/ssl/src/inet_tls_dist.erl @@ -0,0 +1,275 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-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% +%% + +%% +-module(inet_tls_dist). + +-export([childspecs/0, listen/1, accept/1, accept_connection/5, + setup/5, close/1, select/1, is_node_name/1]). + +-include_lib("kernel/include/net_address.hrl"). +-include_lib("kernel/include/dist.hrl"). +-include_lib("kernel/include/dist_util.hrl"). + +childspecs() -> + {ok, [{ssl_dist_sup,{ssl_dist_sup, start_link, []}, + permanent, 2000, worker, [ssl_dist_sup]}]}. + +select(Node) -> + case split_node(atom_to_list(Node), $@, []) of + [_,_Host] -> + true; + _ -> + false + end. + +is_node_name(Node) when is_atom(Node) -> + select(Node); +is_node_name(_) -> + false. + +listen(Name) -> + ssl_tls_dist_proxy:listen(Name). + +accept(Listen) -> + ssl_tls_dist_proxy:accept(Listen). + +accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) -> + Kernel = self(), + spawn_link(fun() -> do_accept(Kernel, AcceptPid, Socket, + MyNode, Allowed, SetupTime) end). + +setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> + Kernel = self(), + spawn(fun() -> do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) end). + +do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> + [Name, Address] = splitnode(Node, LongOrShortNames), + case inet:getaddr(Address, inet) of + {ok, Ip} -> + Timer = dist_util:start_timer(SetupTime), + case erl_epmd:port_please(Name, Ip) of + {port, TcpPort, Version} -> + ?trace("port_please(~p) -> version ~p~n", + [Node,Version]), + dist_util:reset_timer(Timer), + case ssl_tls_dist_proxy:connect(Ip, TcpPort) of + {ok, Socket} -> + HSData = connect_hs_data(Kernel, Node, MyNode, Socket, + Timer, Version, Ip, TcpPort, Address, + Type), + dist_util:handshake_we_started(HSData); + _ -> + %% Other Node may have closed since + %% port_please ! + ?trace("other node (~p) " + "closed since port_please.~n", + [Node]), + ?shutdown(Node) + end; + _ -> + ?trace("port_please (~p) " + "failed.~n", [Node]), + ?shutdown(Node) + end; + _Other -> + ?trace("inet_getaddr(~p) " + "failed (~p).~n", [Node,Other]), + ?shutdown(Node) + end. + +close(Socket) -> + try + erlang:error(foo) + catch _:_ -> + io:format("close called ~p ~p~n",[Socket, erlang:get_stacktrace()]) + end, + gen_tcp:close(Socket), + ok. + +do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> + process_flag(priority, max), + receive + {AcceptPid, controller} -> + Timer = dist_util:start_timer(SetupTime), + case check_ip(Socket) of + true -> + HSData = accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed), + dist_util:handshake_other_started(HSData); + {false,IP} -> + error_logger:error_msg("** Connection attempt from " + "disallowed IP ~w ** ~n", [IP]), + ?shutdown(no_node) + end + end. +%% ------------------------------------------------------------ +%% Do only accept new connection attempts from nodes at our +%% own LAN, if the check_ip environment parameter is true. +%% ------------------------------------------------------------ +check_ip(Socket) -> + case application:get_env(check_ip) of + {ok, true} -> + case get_ifs(Socket) of + {ok, IFs, IP} -> + check_ip(IFs, IP); + _ -> + ?shutdown(no_node) + end; + _ -> + true + end. + +get_ifs(Socket) -> + case inet:peername(Socket) of + {ok, {IP, _}} -> + case inet:getif(Socket) of + {ok, IFs} -> {ok, IFs, IP}; + Error -> Error + end; + Error -> + Error + end. + +check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) -> + case {mask(Netmask, PeerIP), mask(Netmask, OwnIP)} of + {M, M} -> true; + _ -> check_ip(IFs, PeerIP) + end; +check_ip([], PeerIP) -> + {false, PeerIP}. + +mask({M1,M2,M3,M4}, {IP1,IP2,IP3,IP4}) -> + {M1 band IP1, + M2 band IP2, + M3 band IP3, + M4 band IP4}; + +mask({M1,M2,M3,M4, M5, M6, M7, M8}, {IP1,IP2,IP3,IP4, IP5, IP6, IP7, IP8}) -> + {M1 band IP1, + M2 band IP2, + M3 band IP3, + M4 band IP4, + M5 band IP5, + M6 band IP6, + M7 band IP7, + M8 band IP8}. + + +%% If Node is illegal terminate the connection setup!! +splitnode(Node, LongOrShortNames) -> + case split_node(atom_to_list(Node), $@, []) of + [Name|Tail] when Tail =/= [] -> + Host = lists:append(Tail), + check_node(Name, Node, Host, LongOrShortNames); + [_] -> + error_logger:error_msg("** Nodename ~p illegal, no '@' character **~n", + [Node]), + ?shutdown(Node); + _ -> + error_logger:error_msg("** Nodename ~p illegal **~n", [Node]), + ?shutdown(Node) + end. + +check_node(Name, Node, Host, LongOrShortNames) -> + case split_node(Host, $., []) of + [_] when LongOrShortNames == longnames -> + error_logger:error_msg("** System running to use " + "fully qualified " + "hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown(Node); + [_, _ | _] when LongOrShortNames == shortnames -> + error_logger:error_msg("** System NOT running to use fully qualified " + "hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown(Node); + _ -> + [Name, Host] + end. + +split_node([Chr|T], Chr, Ack) -> + [lists:reverse(Ack)|split_node(T, Chr, [])]; +split_node([H|T], Chr, Ack) -> + split_node(T, Chr, [H|Ack]); +split_node([], _, Ack) -> + [lists:reverse(Ack)]. + +connect_hs_data(Kernel, Node, MyNode, Socket, Timer, Version, Ip, TcpPort, Address, Type) -> + common_hs_data(Kernel, MyNode, Socket, Timer, + #hs_data{other_node = Node, + other_version = Version, + f_address = + fun(_,_) -> + #net_address{address = {Ip,TcpPort}, + host = Address, + protocol = proxy, + family = inet} + end, + request_type = Type + }). + +accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed) -> + common_hs_data(Kernel, MyNode, Socket, Timer, #hs_data{ + allowed = Allowed, + f_address = fun(S, N) -> + ssl_tls_dist_proxy:get_remote_id(S, N) + end + }). + +common_hs_data(Kernel, MyNode, Socket, Timer, HsData) -> + HsData#hs_data{ + kernel_pid = Kernel, + this_node = MyNode, + socket = Socket, + timer = Timer, + this_flags = 0, + f_send = + fun(S,D) -> + gen_tcp:send(S,D) + end, + f_recv = + fun(S,N,T) -> + gen_tcp:recv(S,N,T) + end, + f_setopts_pre_nodeup = + fun(S) -> + inet:setopts(S, [{active, false}, {packet, 4}]) + end, + f_setopts_post_nodeup = + fun(S) -> + inet:setopts(S, [{deliver, port},{active, true}]) + end, + f_getll = + fun(S) -> + inet:getll(S) + end, + mf_tick = + fun(S) -> + gen_tcp:send(S, <<>>) + end, + mf_getstat = + fun(S) -> + {ok, Stats} = inet:getstat(S, [recv_cnt, send_cnt, send_pend]), + R = proplists:get_value(recv_cnt, Stats, 0), + W = proplists:get_value(send_cnt, Stats, 0), + P = proplists:get_value(send_pend, Stats, 0), + {ok, R,W,P} + end}. diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index b9716786e6..13d5eaf4d7 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -4,11 +4,9 @@ {modules, [ssl, ssl_app, ssl_sup, - ssl_server, - ssl_broker, - ssl_broker_sup, - ssl_prim, - inet_ssl_dist, + inet_tls_dist, + ssl_tls_dist_proxy, + ssl_dist_sup, ssl_tls1, ssl_ssl3, ssl_ssl2, @@ -26,7 +24,7 @@ ssl_certificate, ssl_alert ]}, - {registered, [ssl_sup, ssl_server, ssl_broker_sup]}, + {registered, [ssl_sup, ssl_manager]}, {applications, [crypto, public_key, kernel, stdlib]}, {env, []}, {mod, {ssl_app, []}}]}. diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 29674f30da..1b07e76d6a 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,6 +1,7 @@ %% -*- erlang -*- {"%VSN%", [ + {"4.1.6", [{restart_application, ssl}]}, {"4.1.5", [{restart_application, ssl}]}, {"4.1.4", [{restart_application, ssl}]}, {"4.1.3", [{restart_application, ssl}]}, @@ -10,6 +11,7 @@ {"4.0.1", [{restart_application, ssl}]} ], [ + {"4.1.6", [{restart_application, ssl}]}, {"4.1.5", [{restart_application, ssl}]}, {"4.1.4", [{restart_application, ssl}]}, {"4.1.3", [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index d1ec0c141e..d0693445e0 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -25,18 +25,15 @@ -export([start/0, start/1, stop/0, transport_accept/1, transport_accept/2, ssl_accept/1, ssl_accept/2, ssl_accept/3, - ciphers/0, cipher_suites/0, cipher_suites/1, close/1, shutdown/2, + cipher_suites/0, cipher_suites/1, close/1, shutdown/2, connect/3, connect/2, connect/4, connection_info/1, - controlling_process/2, listen/2, pid/1, peername/1, recv/2, recv/3, - send/2, getopts/2, setopts/2, seed/1, sockname/1, peercert/1, - peercert/2, version/0, versions/0, session_info/1, format_error/1, + controlling_process/2, listen/2, pid/1, peername/1, peercert/1, + recv/2, recv/3, send/2, getopts/2, setopts/2, sockname/1, + versions/0, session_info/1, format_error/1, renegotiate/1]). -%% Should be deprecated as soon as old ssl is removed -%%-deprecated({pid, 1, next_major_release}). --deprecated({peercert, 2, next_major_release}). +-deprecated({pid, 1, next_major_release}). --include("ssl_int.hrl"). -include("ssl_internal.hrl"). -include("ssl_record.hrl"). -include("ssl_cipher.hrl"). @@ -134,20 +131,13 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket) -> connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). -connect(Host, Port, Options0, Timeout) -> - case proplists:get_value(ssl_imp, Options0, new) of - new -> - new_connect(Host, Port, Options0, Timeout); - old -> - %% Allow the option reuseaddr to be present - %% so that new and old ssl can be run by the same - %% code, however the option will be ignored by old ssl - %% that hardcodes reuseaddr to true in its portprogram. - Options1 = proplists:delete(reuseaddr, Options0), - Options = proplists:delete(ssl_imp, Options1), - old_connect(Host, Port, Options, Timeout); - Value -> - {error, {eoptions, {ssl_imp, Value}}} +connect(Host, Port, Options, Timeout) -> + try handle_options(Options, client) of + {ok, Config} -> + do_connect(Host,Port,Config,Timeout) + catch + throw:Error -> + Error end. %%-------------------------------------------------------------------- @@ -159,21 +149,19 @@ connect(Host, Port, Options0, Timeout) -> listen(_Port, []) -> {error, enooptions}; listen(Port, Options0) -> - case proplists:get_value(ssl_imp, Options0, new) of - new -> - new_listen(Port, Options0); - old -> - %% Allow the option reuseaddr to be present - %% so that new and old ssl can be run by the same - %% code, however the option will be ignored by old ssl - %% that hardcodes reuseaddr to true in its portprogram. - Options1 = proplists:delete(reuseaddr, Options0), - Options = proplists:delete(ssl_imp, Options1), - old_listen(Port, Options); - Value -> - {error, {eoptions, {ssl_imp, Value}}} + try + {ok, Config} = handle_options(Options0, server), + #config{cb={CbModule, _, _, _},inet_user=Options} = Config, + case CbModule:listen(Port, Options) of + {ok, ListenSocket} -> + {ok, #sslsocket{pid = {ListenSocket, Config}, fd = new_ssl}}; + Err = {error, _} -> + Err + end + catch + Error = {error, _} -> + Error end. - %%-------------------------------------------------------------------- -spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} | {error, reason()}. @@ -185,8 +173,7 @@ listen(Port, Options0) -> transport_accept(ListenSocket) -> transport_accept(ListenSocket, infinity). -transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts}}, - fd = new_ssl}, 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. @@ -208,12 +195,7 @@ transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts} end; {error, Reason} -> {error, Reason} - end; - -transport_accept(#sslsocket{} = ListenSocket, Timeout) -> - ensure_old_ssl_started(), - {ok, Pid} = ssl_broker:start_broker(acceptor), - ssl_broker:transport_accept(Pid, ListenSocket, Timeout). + end. %%-------------------------------------------------------------------- -spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}. @@ -227,16 +209,11 @@ transport_accept(#sslsocket{} = ListenSocket, Timeout) -> ssl_accept(ListenSocket) -> ssl_accept(ListenSocket, infinity). -ssl_accept(#sslsocket{fd = new_ssl} = Socket, Timeout) -> +ssl_accept(#sslsocket{} = Socket, Timeout) -> ssl_connection:handshake(Socket, Timeout); ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> - ssl_accept(ListenSocket, SslOptions, infinity); - -%% Old ssl -ssl_accept(#sslsocket{} = Socket, Timeout) -> - ensure_old_ssl_started(), - ssl_broker:ssl_accept(Socket, Timeout). + ssl_accept(ListenSocket, SslOptions, infinity). ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> EmulatedOptions = emulated_options(), @@ -257,25 +234,18 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> %% %% Description: Close an ssl connection %%-------------------------------------------------------------------- -close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}, fd = new_ssl}) -> +close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}) -> CbMod:close(ListenSocket); -close(#sslsocket{pid = Pid, fd = new_ssl}) -> - ssl_connection:close(Pid); -close(Socket = #sslsocket{}) -> - ensure_old_ssl_started(), - ssl_broker:close(Socket). +close(#sslsocket{pid = Pid}) -> + ssl_connection:close(Pid). %%-------------------------------------------------------------------- -spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}. %% %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- -send(#sslsocket{pid = Pid, fd = new_ssl}, Data) -> - ssl_connection:send(Pid, Data); - -send(#sslsocket{} = Socket, Data) -> - ensure_old_ssl_started(), - ssl_broker:send(Socket, Data). +send(#sslsocket{pid = Pid}, Data) -> + ssl_connection:send(Pid, Data). %%-------------------------------------------------------------------- -spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}. @@ -286,11 +256,7 @@ send(#sslsocket{} = Socket, Data) -> recv(Socket, Length) -> recv(Socket, Length, infinity). recv(#sslsocket{pid = Pid, fd = new_ssl}, Length, Timeout) -> - ssl_connection:recv(Pid, Length, Timeout); - -recv(Socket = #sslsocket{}, Length, Timeout) -> - ensure_old_ssl_started(), - ssl_broker:recv(Socket, Length, Timeout). + ssl_connection:recv(Pid, Length, Timeout). %%-------------------------------------------------------------------- -spec controlling_process(#sslsocket{}, pid()) -> ok | {error, reason()}. @@ -298,13 +264,8 @@ recv(Socket = #sslsocket{}, Length, Timeout) -> %% Description: Changes process that receives the messages when active = true %% or once. %%-------------------------------------------------------------------- -controlling_process(#sslsocket{pid = Pid, fd = new_ssl}, NewOwner) - when is_pid(Pid) -> - ssl_connection:new_user(Pid, NewOwner); - -controlling_process(Socket, NewOwner) when is_pid(NewOwner) -> - ensure_old_ssl_started(), - ssl_broker:controlling_process(Socket, NewOwner). +controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid) -> + ssl_connection:new_user(Pid, NewOwner). %%-------------------------------------------------------------------- -spec connection_info(#sslsocket{}) -> {ok, {tls_atom_version(), erl_cipher_suite()}} | @@ -312,82 +273,31 @@ controlling_process(Socket, NewOwner) when is_pid(NewOwner) -> %% %% Description: Returns ssl protocol and cipher used for the connection %%-------------------------------------------------------------------- -connection_info(#sslsocket{pid = Pid, fd = new_ssl}) -> - ssl_connection:info(Pid); +connection_info(#sslsocket{pid = Pid}) -> + ssl_connection:info(Pid). -connection_info(#sslsocket{} = Socket) -> - ensure_old_ssl_started(), - ssl_broker:connection_info(Socket). +%%-------------------------------------------------------------------- +-spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. +%% +%% Description: same as inet:peername/1. +%%-------------------------------------------------------------------- +peername(#sslsocket{pid = Pid}) -> + ssl_connection:peername(Pid). %%-------------------------------------------------------------------- --spec peercert(#sslsocket{}) ->{ok, der_cert()} | {error, reason()}. +-spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}. %% %% Description: Returns the peercert. %%-------------------------------------------------------------------- -peercert(Socket) -> - peercert(Socket, []). - -peercert(#sslsocket{pid = Pid, fd = new_ssl}, Opts) -> +peercert(#sslsocket{pid = Pid}) -> case ssl_connection:peer_certificate(Pid) of {ok, undefined} -> {error, no_peercert}; - {ok, BinCert} -> - decode_peercert(BinCert, Opts); - {error, Reason} -> - {error, Reason} - end; - -peercert(#sslsocket{} = Socket, Opts) -> - ensure_old_ssl_started(), - case ssl_broker:peercert(Socket) of - {ok, Bin} -> - decode_peercert(Bin, Opts); - {error, Reason} -> - {error, Reason} - end. - - -decode_peercert(BinCert, Opts) -> - PKOpts = [case Opt of ssl -> otp; pkix -> plain end || - Opt <- Opts, Opt =:= ssl orelse Opt =:= pkix], - case PKOpts of - [Opt] -> - select_part(Opt, public_key:pkix_decode_cert(BinCert, Opt), Opts); - [] -> - {ok, BinCert} - end. - -select_part(otp, Cert, Opts) -> - case lists:member(subject, Opts) of - true -> - TBS = Cert#'OTPCertificate'.tbsCertificate, - {ok, TBS#'OTPTBSCertificate'.subject}; - false -> - {ok, Cert} - end; - -select_part(plain, Cert, Opts) -> - case lists:member(subject, Opts) of - true -> - TBS = Cert#'Certificate'.tbsCertificate, - {ok, TBS#'TBSCertificate'.subject}; - false -> - {ok, Cert} + Result -> + Result end. %%-------------------------------------------------------------------- --spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. -%% -%% Description: same as inet:peername/1. -%%-------------------------------------------------------------------- -peername(#sslsocket{fd = new_ssl, pid = Pid}) -> - ssl_connection:peername(Pid); - -peername(#sslsocket{} = Socket) -> - ensure_old_ssl_started(), - ssl_broker:peername(Socket). - -%%-------------------------------------------------------------------- -spec cipher_suites() -> [erl_cipher_suite()]. -spec cipher_suites(erlang | openssl) -> [erl_cipher_suite()] | [string()]. @@ -410,9 +320,9 @@ cipher_suites(openssl) -> %% %% Description: Gets options %%-------------------------------------------------------------------- -getopts(#sslsocket{fd = new_ssl, pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> +getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> ssl_connection:get_opts(Pid, OptionTags); -getopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptionTags) when is_list(OptionTags) -> +getopts(#sslsocket{pid = {ListenSocket, _}}, OptionTags) when is_list(OptionTags) -> try inet:getopts(ListenSocket, OptionTags) of {ok, _} = Result -> Result; @@ -422,18 +332,15 @@ getopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptionTags) when is_l _:_ -> {error, {eoptions, {inet_options, OptionTags}}} end; -getopts(#sslsocket{fd = new_ssl}, OptionTags) -> - {error, {eoptions, {inet_options, OptionTags}}}; -getopts(#sslsocket{} = Socket, OptionTags) -> - ensure_old_ssl_started(), - ssl_broker:getopts(Socket, OptionTags). +getopts(#sslsocket{}, OptionTags) -> + {error, {eoptions, {inet_options, OptionTags}}}. %%-------------------------------------------------------------------- -spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}. %% %% Description: Sets options %%-------------------------------------------------------------------- -setopts(#sslsocket{fd = new_ssl, pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> +setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> try proplists:expand([{binary, [{mode, binary}]}, {list, [{mode, list}]}], Options0) of Options -> @@ -443,7 +350,7 @@ setopts(#sslsocket{fd = new_ssl, pid = Pid}, Options0) when is_pid(Pid), is_list {error, {eoptions, {not_a_proplist, Options0}}} end; -setopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, Options) when is_list(Options) -> +setopts(#sslsocket{pid = {ListenSocket, _}}, Options) when is_list(Options) -> try inet:setopts(ListenSocket, Options) of ok -> ok; @@ -453,20 +360,17 @@ setopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, Options) when is_list _:Error -> {error, {eoptions, {inet_options, Options, Error}}} end; -setopts(#sslsocket{fd = new_ssl}, Options) -> - {error, {eoptions,{not_a_proplist, Options}}}; -setopts(#sslsocket{} = Socket, Options) -> - ensure_old_ssl_started(), - ssl_broker:setopts(Socket, Options). +setopts(#sslsocket{}, Options) -> + {error, {eoptions,{not_a_proplist, Options}}}. %%--------------------------------------------------------------- -spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}. %% %% Description: Same as gen_tcp:shutdown/2 %%-------------------------------------------------------------------- -shutdown(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}, fd = new_ssl}, How) -> +shutdown(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}, How) -> CbMod:shutdown(ListenSocket, How); -shutdown(#sslsocket{pid = Pid, fd = new_ssl}, How) -> +shutdown(#sslsocket{pid = Pid}, How) -> ssl_connection:shutdown(Pid, How). %%-------------------------------------------------------------------- @@ -474,25 +378,11 @@ shutdown(#sslsocket{pid = Pid, fd = new_ssl}, How) -> %% %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- -sockname(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}) -> +sockname(#sslsocket{pid = {ListenSocket, _}}) -> inet:sockname(ListenSocket); -sockname(#sslsocket{fd = new_ssl, pid = Pid}) -> - ssl_connection:sockname(Pid); - -sockname(#sslsocket{} = Socket) -> - ensure_old_ssl_started(), - ssl_broker:sockname(Socket). - -%%--------------------------------------------------------------- --spec seed(term()) ->term(). -%% -%% Description: Only used by old ssl. -%%-------------------------------------------------------------------- -%% TODO: crypto:seed ? -seed(Data) -> - ensure_old_ssl_started(), - ssl_server:seed(Data). +sockname(#sslsocket{pid = Pid}) -> + ssl_connection:sockname(Pid). %%--------------------------------------------------------------- -spec session_info(#sslsocket{}) -> {ok, list()} | {error, reason()}. @@ -548,63 +438,6 @@ format_error(esslconnect) -> format_error({eoptions, Options}) -> lists:flatten(io_lib:format("Error in options list: ~p~n", [Options])); -%%%%%%%%%%%% START OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -format_error(ebadsocket) -> - "Connection not found (internal error)."; -format_error(ebadstate) -> - "Connection not in connect state (internal error)."; -format_error(ebrokertype) -> - "Wrong broker type (internal error)."; -format_error(echaintoolong) -> - "The chain of certificates provided by peer is too long."; -format_error(ecipher) -> - "Own list of specified ciphers is invalid."; -format_error(ekeymismatch) -> - "Own private key does not match own certificate."; -format_error(enoissuercert) -> - "Cannot find certificate of issuer of certificate provided by peer."; -format_error(enoservercert) -> - "Attempt to do accept without having set own certificate."; -format_error(enotlistener) -> - "Attempt to accept on a non-listening socket."; -format_error(enoproxysocket) -> - "No proxy socket found (internal error or max number of file " - "descriptors exceeded)."; -format_error(enooptions) -> - "List of options is empty."; -format_error(enotstarted) -> - "The SSL application has not been started."; -format_error(eoptions) -> - "Invalid list of options."; -format_error(epeercert) -> - "Certificate provided by peer is in error."; -format_error(epeercertexpired) -> - "Certificate provided by peer has expired."; -format_error(epeercertinvalid) -> - "Certificate provided by peer is invalid."; -format_error(eselfsignedcert) -> - "Certificate provided by peer is self signed."; -format_error(esslerrssl) -> - "SSL protocol failure. Typically because of a fatal alert from peer."; -format_error(ewantconnect) -> - "Protocol wants to connect, which is not supported in this " - "version of the SSL application."; -format_error(ex509lookup) -> - "Protocol wants X.509 lookup, which is not supported in this " - "version of the SSL application."; -format_error({badcall, _Call}) -> - "Call not recognized for current mode (active or passive) and state " - "of socket."; -format_error({badcast, _Cast}) -> - "Call not recognized for current mode (active or passive) and state " - "of socket."; - -format_error({badinfo, _Info}) -> - "Call not recognized for current mode (active or passive) and state " - "of socket."; - -%%%%%%%%%%%%%%%%%% END OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - format_error(Error) -> case (catch inet:format_error(Error)) of "unkknown POSIX" ++ _ -> @@ -618,16 +451,7 @@ format_error(Error) -> %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- -new_connect(Address, Port, Options, Timeout) when is_list(Options) -> - try handle_options(Options, client) of - {ok, Config} -> - do_new_connect(Address,Port,Config,Timeout) - catch - throw:Error -> - Error - end. - -do_new_connect(Address, Port, +do_connect(Address, Port, #config{cb=CbInfo, inet_user=UserOpts, ssl=SslOpts, emulated=EmOpts,inet_ssl=SocketOpts}, Timeout) -> @@ -647,35 +471,9 @@ do_new_connect(Address, Port, {error, {eoptions, {inet_options, UserOpts}}} end. -old_connect(Address, Port, Options, Timeout) -> - ensure_old_ssl_started(), - {ok, Pid} = ssl_broker:start_broker(connector), - ssl_broker:connect(Pid, Address, Port, Options, Timeout). - -new_listen(Port, Options0) -> - try - {ok, Config} = handle_options(Options0, server), - #config{cb={CbModule, _, _, _},inet_user=Options} = Config, - case CbModule:listen(Port, Options) of - {ok, ListenSocket} -> - {ok, #sslsocket{pid = {ListenSocket, Config}, fd = new_ssl}}; - Err = {error, _} -> - Err - end - catch - Error = {error, _} -> - Error - end. - -old_listen(Port, Options) -> - ensure_old_ssl_started(), - {ok, Pid} = ssl_broker:start_broker(listener), - ssl_broker:listen(Pid, Port, Options). - handle_options(Opts0, _Role) -> Opts = proplists:expand([{binary, [{mode, binary}]}, {list, [{mode, list}]}], Opts0), - ReuseSessionFun = fun(_, _, _, _) -> true end, DefaultVerifyNoneFun = @@ -742,7 +540,8 @@ handle_options(Opts0, _Role) -> 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) + hibernate_after = handle_option(hibernate_after, Opts, undefined), + erl_dist = handle_option(erl_dist, Opts, false) }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), @@ -751,7 +550,7 @@ handle_options(Opts0, _Role) -> 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], + cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -768,8 +567,6 @@ handle_option(OptionName, Opts, Default) -> validate_option(versions, Versions) -> validate_versions(Versions, Versions); -validate_option(ssl_imp, Value) when Value == new; Value == old -> - Value; validate_option(verify, Value) when Value == verify_none; Value == verify_peer -> Value; @@ -811,8 +608,11 @@ validate_option(certfile, Value) when Value == undefined; is_list(Value) -> validate_option(key, undefined) -> undefined; validate_option(key, {KeyType, Value}) when is_binary(Value), - KeyType == rsa; - KeyType == dsa -> + KeyType == rsa; %% Backwards compatibility + KeyType == dsa; %% Backwards compatibility + KeyType == 'RSAPrivateKey'; + KeyType == 'DSAPrivateKey'; + KeyType == 'PrivateKeyInfo' -> {KeyType, Value}; validate_option(keyfile, Value) when is_list(Value) -> Value; @@ -862,6 +662,9 @@ validate_option(hibernate_after, undefined) -> undefined; validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 -> Value; +validate_option(erl_dist,Value) when Value == true; + Value == false -> + Value; validate_option(Opt, Value) -> throw({error, {eoptions, {Opt, Value}}}). @@ -909,7 +712,6 @@ emulated_options() -> internal_inet_values() -> [{packet_size,0},{packet, 0},{header, 0},{active, false},{mode,binary}]. - %%[{packet, ssl},{header, 0},{active, false},{mode,binary}]. socket_options(InetValues) -> #socket_options{ @@ -970,47 +772,14 @@ cipher_suites(Version, Ciphers0) -> no_format(Error) -> lists:flatten(io_lib:format("No format string for error: \"~p\" available.", [Error])). - -%% Start old ssl port program if needed. -ensure_old_ssl_started() -> - case whereis(ssl_server) of - undefined -> - (catch supervisor:start_child(ssl_sup, - {ssl_server, {ssl_server, start_link, []}, - permanent, 2000, worker, [ssl_server]})); - _ -> - ok - end. - -%%%%%%%%%%%%%%%% Deprecated %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -ciphers() -> - ensure_old_ssl_started(), - case (catch ssl_server:ciphers()) of - {'EXIT', _} -> - {error, enotstarted}; - Res = {ok, _} -> - Res - end. - -version() -> - ensure_old_ssl_started(), - SSLVsn = ?VSN, - {CompVsn, LibVsn} = case (catch ssl_server:version()) of - {'EXIT', _} -> - {"", ""}; - {ok, Vsns} -> - Vsns - end, - {ok, {SSLVsn, CompVsn, LibVsn}}. - %% Only used to remove exit messages from old ssl %% First is a nonsense clause to provide some %% backward compatibility for orber that uses this %% function in a none recommended way, but will %% work correctly if a valid pid is returned. +%% Deprcated to be removed in r16 pid(#sslsocket{fd = new_ssl}) -> - whereis(ssl_connection_sup); + whereis(ssl_connection_sup); pid(#sslsocket{pid = Pid}) -> - Pid. + Pid. diff --git a/lib/ssl/src/ssl_broker.erl b/lib/ssl/src/ssl_broker.erl deleted file mode 100644 index 7ef88baf2b..0000000000 --- a/lib/ssl/src/ssl_broker.erl +++ /dev/null @@ -1,1188 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2010. 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 : SSL broker - --module(ssl_broker). --behaviour(gen_server). - -%% This module implements brokers for ssl. A broker is either a connector, -%% an acceptor, or a listener. All brokers are children to ssl_broker_sup, -%% to which they are linked. Each broker is also linked to ssl_server, and -%% to its client. -%% -%% The purpose of the broker is to set up SSL connections through calls to -%% ssl_server and gen_tcp. All control information goes to the server, -%% while all data is exchanged directly between gen_tcp and the port program -%% of the ssl_server. -%% -%% A broker is created by a call to start_broker/3 (do *not* use start_link/4 -%% - it is for ssl_broker_sup to call that one), and then call listen/3, -%% accept/4, or connect/5. -%% -%% The following table shows all functions dependency on status, active -%% mode etc. -%% -%% Permitted status transitions: -%% -%% nil -> open -%% open -> closing | closed (termination) -%% closing -> closed (termination) -%% -%% We are rather sloppy about nil, and consider open/closing == !closed, -%% open/closing/closed === any etc. -%% -%% -%% function/ valid mode new -%% message status state -%% -%% calls -%% ----- -%% recv open passive ditto -%% send open any ditto -%% transport_accept nil any open -%% ssl_accept nil any open -%% connect nil any open -%% listen nil any open -%% peername open/closing any ditto -%% setopts open/closing any ditto -%% getopts open/closing any ditto -%% sockname open/closing any ditto -%% peercert open/closing any ditto -%% inhibit any any ditto -%% release any any ditto -%% close any any closed (1) -%% -%% info -%% ---- -%% tcp open active ditto -%% tcp_closed open | closing active closing -%% tcp_error open | closing active closing -%% -%% (1) We just terminate. -%% -%% TODO -%% -%% XXX Timeouts are not checked (integer or infinity). -%% -%% XXX The collector thing is not gen_server compliant. -%% -%% NOTE: There are three different "modes": (a) passive or active mode, -%% specified as {active, bool()}, and (b) list or binary mode, specified -%% as {mode, list | binary}, and (c) encrypted or clear mode -%% - --include("ssl_int.hrl"). - -%% External exports - --export([start_broker/1, start_broker/2, start_link/3, - transport_accept/3, ssl_accept/2, - close/1, connect/5, connection_info/1, controlling_process/2, - listen/3, recv/3, send/2, getopts/2, getopts/3, setopts/2, - sockname/1, peername/1, peercert/1]). - --export([listen_prim/5, connect_prim/8, - transport_accept_prim/5, ssl_accept_prim/6]). - -%% Internal exports - --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - code_change/3, terminate/2, collector_init/1]). - --include("ssl_broker_int.hrl"). - -%% start_broker(Type) -> {ok, Pid} | {error, Reason} -%% start_broker(Type, GenOpts) -> {ok, Pid} | {error, Reason} -%% Type = accept | connect | listen -%% GenOpts = /standard gen_server options/ -%% -%% This is the function to be called from the interface module ssl.erl. -%% Links to the caller. -%% -start_broker(Type) -> - start_broker(Type, []). - -start_broker(Type, GenOpts) -> - case lists:member(Type, [listener, acceptor, connector]) of - true -> - case supervisor:start_child(ssl_broker_sup, - [self(), Type, GenOpts]) of - {ok, Pid} -> - link(Pid), - {ok, Pid}; - {error, Reason} -> - {error, Reason} - end; - false -> - {error, ebrokertype} - end. - -%% start_link(Client, Type, GenOpts) -> {ok, Pid} | {error, Reason} -%% -%% Type = accept | connect | listen -%% GenOpts = /standard gen_server options/ -%% -%% This function is called by ssl_broker_sup and must *not* be called -%% from an interface module (ssl.erl). - -start_link(Client, Type, GenOpts) -> - gen_server:start_link(?MODULE, [Client, Type], GenOpts). - - -%% accept(Pid, ListenSocket, Timeout) -> {ok, Socket} | {error, Reason} -%% -%% Types: Pid = pid() of acceptor -%% ListenSocket = Socket = sslsocket() -%% Timeout = timeout() -%% -%% accept(Pid, ListenSocket, Timeout) -%% when is_pid(Pid), is_record(ListenSocket, sslsocket) -> -%% Req = {accept, self(), ListenSocket, Timeout}, -%% gen_server:call(Pid, Req, infinity). - -%% transport_accept(Pid, ListenSocket, Timeout) -> {ok, Socket} | -%% {error, Reason} -%% -%% Types: Pid = pid() of acceptor -%% ListenSocket = Socket = sslsocket() -%% Timeout = timeout() -%% -transport_accept(Pid, #sslsocket{} = ListenSocket, Timeout) when is_pid(Pid) -> - Req = {transport_accept, self(), ListenSocket, Timeout}, - gen_server:call(Pid, Req, infinity). - -%% ssl_accept(Pid, Socket, Timeout) -> {ok, Socket} | {error, Reason} -%% -%% Types: Pid = pid() of acceptor -%% ListenSocket = Socket = sslsocket() -%% Timeout = timeout() -%% -ssl_accept(#sslsocket{pid = Pid} = Socket, Timeout) -> - Req = {ssl_accept, self(), Socket, Timeout}, - gen_server:call(Pid, Req, infinity). - -%% close(Socket) -> ok | {error, Reason} -%% -%% Types: Socket = sslsocket() | pid() -%% -close(#sslsocket{pid = Pid}) -> - close(Pid); -close(Pid) when is_pid(Pid) -> - gen_server:call(Pid, {close, self()}, infinity). - -%% connect(Pid, Address, Port, Opts, Timeout) -> {ok, Socket} | {error, Reason} -%% -%% Types: Pid = pid() of connector -%% Address = string() | {byte(), byte(), byte(), byte()} -%% Port = int() -%% Opts = options() -%% Timeout = timeout() -%% Socket = sslsocket() -%% -connect(Pid, Address, Port, Opts, Timeout) when is_pid(Pid), is_list(Opts) -> - case are_connect_opts(Opts) of - true -> - Req = {connect, self(), Address, Port, Opts, Timeout}, - gen_server:call(Pid, Req, infinity); - false -> - {error, eoptions} - end. - -%% -%% connection_info(Socket) -> {ok, {Protocol, Cipher} | {error, Reason} -%% -connection_info(#sslsocket{pid = Pid}) -> - Req = {connection_info, self()}, - gen_server:call(Pid, Req, infinity). - -%% controlling_process(Socket, NewOwner) -> ok | {error, Reason} - -controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(NewOwner) -> - case gen_server:call(Pid, {inhibit_msgs, self()}, infinity) of - ok -> - transfer_messages(Pid, NewOwner), - gen_server:call(Pid, {release_msgs, self(), NewOwner}, infinity); - Error -> - Error - end. - -%% listen(Pid, Port, Opts) -> {ok, ListenSocket} | {error, Reason} -%% -%% Types: Pid = pid() of listener -%% Port = int() -%% Opts = options() -%% ListenSocket = sslsocket() -%% -listen(Pid, Port, Opts) when is_pid(Pid) -> - case are_listen_opts(Opts) of - true -> - Req = {listen, self(), Port, Opts}, - gen_server:call(Pid, Req, infinity); - false -> - {error, eoptions} - end. - - -%% -%% peername(Socket) -> {ok, {Address, Port}} | {error, Reason} -%% -peername(#sslsocket{pid = Pid}) -> - Req = {peername, self()}, - gen_server:call(Pid, Req, infinity). - - -%% recv(Socket, Length, Timeout) -> {ok, Data} | {error, Reason} -%% -%% Types: Socket = sslsocket() -%% Length = Timeout = integer() -%% Data = bytes() | binary() -%% -recv(#sslsocket{pid = Pid}, Length, Timeout) -> - Req = {recv, self(), Length, Timeout}, - gen_server:call(Pid, Req, infinity). - - -%% send(Socket, Data) -> ok | {error, Reason} -%% -%% Types: Socket = sslsocket() -%% -send(#sslsocket{pid = Pid}, Data) -> - gen_server:call(Pid, {send, self(), Data}, infinity). - - -%% getopts(Socket, OptTags) -> {ok, Opts} | {error, einval} -%% -%% Types: Pid = pid() of broker -%% Timeout = timeout() -%% OptTags = option_tags() -%% Opts = options() -%% -getopts(Socket, OptTags) -> - getopts(Socket, OptTags, infinity). - -getopts(#sslsocket{pid = Pid}, OptTags, Timeout) when is_list(OptTags) -> - Req = {getopts, self(), OptTags}, - gen_server:call(Pid, Req, Timeout). - - -%% -%% setopts(Socket, Opts) -> ok | {error, Reason} -%% -setopts(#sslsocket{pid = Pid}, Opts) -> - Req = {setopts, self(), Opts}, - gen_server:call(Pid, Req, infinity). - -%% -%% sockname(Socket) -> {ok, {Address, Port}} | {error, Reason} -%% -sockname(#sslsocket{pid = Pid}) -> - Req = {sockname, self()}, - gen_server:call(Pid, Req, infinity). - - -%% -%% peercert(Socket) -> {ok, Cert} | {error, Reason} -%% -peercert(#sslsocket{pid = Pid}) -> - Req = {peercert, self()}, - gen_server:call(Pid, Req, infinity). - -%% -%% INIT -%% - -%% init -%% -init([Client, Type]) -> - process_flag(trap_exit, true), - link(Client), - Debug = case application:get_env(ssl, edebug) of - {ok, true} -> - true; - _ -> - case application:get_env(ssl, debug) of - {ok, true} -> - true; - _ -> - os:getenv("ERL_SSL_DEBUG") =/= false - end - end, - Server = whereis(ssl_server), - if - is_pid(Server) -> - link(Server), - debug1(Debug, Type, "in start, client = ~w", [Client]), - {ok, #st{brokertype = Type, server = Server, client = Client, - collector = Client, debug = Debug}}; - true -> - {stop, no_ssl_server} - end. - - -%% -%% HANDLE CALL -%% - -%% recv - passive mode -%% -handle_call({recv, Client, Length, Timeout}, _From, - #st{active = false, proxysock = Proxysock, status = Status} = St) -> - debug(St, "recv: client = ~w~n", [Client]), - if - Status =/= open -> - {reply, {error, closed}, St}; - true -> - case gen_tcp:recv(Proxysock, Length, Timeout) of - {ok, Data} -> - {reply, {ok, Data}, St}; - {error, timeout} -> - {reply, {error, timeout}, St}; - {error, Reason} -> - {reply, {error, Reason}, St#st{status = closing}} - end - end; - -%% send -%% -handle_call({send, Client, Data}, _From, St) -> - debug(St, "send: client = ~w~n", [Client]), - if - St#st.status =/= open -> - {reply, {error, closed}, St}; - true -> - case gen_tcp:send(St#st.proxysock, Data) of - ok -> - {reply, ok, St}; - {error, _Reason} -> - {reply, {error, closed}, St#st{status = closing}} - end - end; - -%% transport_accept -%% -%% Client = pid of client -%% ListenSocket = sslsocket() -%% -handle_call({transport_accept, Client, ListenSocket, Timeout}, _From, St) -> - debug(St, "transport_accept: client = ~w, listensocket = ~w~n", - [Client, ListenSocket]), - case getopts(ListenSocket, tcp_listen_opt_tags(), ?DEF_TIMEOUT) of - {ok, LOpts} -> - case transport_accept_prim( - ssl_server, ListenSocket#sslsocket.fd, LOpts, Timeout, St) of - {ok, ThisSocket, NSt} -> - {reply, {ok, ThisSocket}, NSt}; - {error, Reason, St} -> - What = what(Reason), - {stop, normal, {error, What}, St} - end; - {error, Reason} -> - What = what(Reason), - {stop, normal, {error, What}, St} - end; - -%% ssl_accept -%% -%% Client = pid of client -%% ListenSocket = sslsocket() -%% -handle_call({ssl_accept, Client, Socket, Timeout}, _From, St) -> - debug(St, "ssl_accept: client = ~w, socket = ~w~n", [Client, Socket]), - case ssl_accept_prim(ssl_server, gen_tcp, Client, St#st.opts, Timeout, St#st{thissock=Socket}) of - {ok, Socket, NSt} -> - {reply, ok, NSt}; - {error, Reason, St} -> - What = what(Reason), - {stop, normal, {error, What}, St} - end; - -%% connect -%% -%% Client = client pid -%% Address = hostname | ipstring | IP -%% Port = integer() -%% Opts = options() -%% -handle_call({connect, Client, Address, Port, Opts, Timeout}, _From, St) -> - debug(St, "connect: client = ~w, address = ~p, port = ~w~n", - [Client, Address, Port]), - case connect_prim(ssl_server, gen_tcp, Client, Address, Port, Opts, - Timeout, St) of - {ok, Res, NSt} -> - {reply, {ok, Res}, NSt}; - {error, Reason, NSt} -> - What = what(Reason), - {stop, normal, {error, What}, NSt} - end; - -%% connection_info -%% -handle_call({connection_info, Client}, _From, St) -> - debug(St, "connection_info: client = ~w~n", [Client]), - Reply = ssl_server:connection_info(St#st.fd), - {reply, Reply, St}; - -%% close from client -%% -handle_call({close, Client}, _From, St) -> - debug(St, "close: client = ~w~n", [Client]), - %% Terminate - {stop, normal, ok, St#st{status = closed}}; - -%% listen -%% -%% Client = pid of client -%% Port = int() -%% Opts = options() -%% -handle_call({listen, Client, Port, Opts}, _From, St) -> - debug(St, "listen: client = ~w, port = ~w~n", - [Client, Port]), - case listen_prim(ssl_server, Client, Port, Opts, St) of - {ok, Res, NSt} -> - {reply, {ok, Res}, NSt}; - {error, Reason, NSt} -> - What = what(Reason), - {stop, normal, {error, What}, NSt} - end; - -%% peername -%% -handle_call({peername, Client}, _From, St) -> - debug(St, "peername: client = ~w~n", [Client]), - Reply = case ssl_server:peername(St#st.fd) of - {ok, {Address, Port}} -> - {ok, At} = inet_parse:ipv4_address(Address), - {ok, {At, Port}}; - Error -> - Error - end, - {reply, Reply, St}; - -%% setopts -%% -handle_call({setopts, Client, Opts0}, _From, St0) -> - debug(St0, "setopts: client = ~w~n", [Client]), - OptsOK = case St0#st.brokertype of - listener -> - are_opts(fun is_tcp_listen_opt/1, Opts0); - acceptor -> - are_opts(fun is_tcp_accept_opt/1, Opts0); - connector -> - are_opts(fun is_tcp_connect_opt/1, Opts0) - end, - if - OptsOK =:= false -> - {reply, {error, eoptions}, St0}; - true -> - Opts1 = lists:keydelete(nodelay, 1, Opts0), - case inet:setopts(St0#st.proxysock, Opts1) of - ok -> - Opts2 = replace_opts(Opts1, St0#st.opts), - Active = get_active(Opts2), - St2 = St0#st{opts = Opts2, - active = Active}, - case get_nodelay(Opts0) of - empty -> - {reply, ok, St2}; - Bool -> - case setnodelay(ssl_server, St0, Bool) of - ok -> - Opts3 = replace_opts([{nodelay, Bool}], - Opts2), - St3 = St0#st{opts = Opts3, - active = Active}, - {reply, ok, St3}; - {error, Reason} -> - {reply, {error, Reason}, St2} - end - end; - {error, Reason} -> - {reply, {error, Reason}, St0} - end - end; - -%% sockname -%% -handle_call({sockname, Client}, _From, St) -> - debug(St, "sockname: client = ~w~n", [Client]), - Reply = case ssl_server:sockname(St#st.fd) of - {ok, {Address, Port}} -> - {ok, At} = inet_parse:ipv4_address(Address), - {ok, {At, Port}}; - Error -> - Error - end, - {reply, Reply, St}; - -%% peercert -%% -handle_call({peercert, Client}, _From, St) -> - debug(St, "peercert: client = ~w~n", [Client]), - Reply = ssl_server:peercert(St#st.fd), - {reply, Reply, St}; - -%% inhibit msgs -%% -handle_call({inhibit_msgs, Client}, _From, #st{client = Client} = St) -> - debug(St, "inhibit_msgs: client = ~w~n", [Client]), - {ok, Collector} = start_collector(), - {reply, ok, St#st{collector = Collector}}; - -%% release msgs -%% -handle_call({release_msgs, Client, NewClient}, _From, - #st{client = Client, collector = Collector} = St) -> - debug(St, "release_msgs: client = ~w~n", [Client]), - unlink(Client), - link(NewClient), - release_collector(Collector, NewClient), - NSt = St#st{client = NewClient, collector = NewClient}, - {reply, ok, NSt}; - -%% getopts -%% -handle_call({getopts, Client, OptTags}, _From, St) -> - debug(St, "getopts: client = ~w~n", [Client]), - Reply = case are_opt_tags(St#st.brokertype, OptTags) of - true -> - {ok, extract_opts(OptTags, St#st.opts)}; - _ -> - {error, einval} - end, - {reply, Reply, St}; - -%% bad call -%% -handle_call(Request, _From, St) -> - debug(St, "++++ ssl_broker: bad call: ~w~n", [Request]), - {reply, {error, {badcall, Request}}, St}. - -%% -%% HANDLE CAST -%% - -handle_cast(Request, St) -> - debug(St, "++++ ssl_broker: bad cast: ~w~n", [Request]), - {stop, {error, {badcast, Request}}, St}. - -%% -%% HANDLE INFO -%% - -%% tcp - active mode -%% -%% The collector is different from client only during change of -%% controlling process. -%% -handle_info({tcp, Socket, Data}, - #st{active = Active, collector = Collector, status = open, - proxysock = Socket, thissock = Thissock} = St) - when Active =/= false -> - debug(St, "tcp: socket = ~w~n", [Socket]), - Msg = {ssl, Thissock, Data}, - Collector ! Msg, - if - Active =:= once -> - {noreply, St#st{active = false}}; - true -> - {noreply, St} - end; - -%% tcp_closed - from proxy socket, active mode -%% -%% -handle_info({tcp_closed, Socket}, - #st{active = Active, collector = Collector, - proxysock = Socket, thissock = Thissock} = St) - when Active =/= false -> - debug(St, "tcp_closed: socket = ~w~n", [Socket]), - Msg = {ssl_closed, Thissock}, - Collector ! Msg, - if - Active =:= once -> - {noreply, St#st{status = closing, active = false}}; - true -> - {noreply, St#st{status = closing}} - end; - -%% tcp_error - from proxy socket, active mode -%% -%% -handle_info({tcp_error, Socket, Reason}, - #st{active = Active, collector = Collector, - proxysock = Socket} = St) - when Active =/= false -> - debug(St, "tcp_error: socket = ~w, reason = ~w~n", [Socket, Reason]), - Msg = {ssl_error, Socket, Reason}, - Collector ! Msg, - if - Active =:= once -> - {noreply, St#st{status = closing, active = false}}; - true -> - {noreply, St#st{status = closing}} - end; - -%% EXIT - from client -%% -%% -handle_info({'EXIT', Client, Reason}, #st{client = Client} = St) -> - debug(St, "exit client: client = ~w, reason = ~w~n", [Client, Reason]), - {stop, normal, St#st{status = closed}}; % do not make noise - -%% EXIT - from server -%% -%% -handle_info({'EXIT', Server, Reason}, #st{server = Server} = St) -> - debug(St, "exit server: reason = ~w~n", [Reason]), - {stop, Reason, St}; - -%% handle info catch all -%% -handle_info(Info, St) -> - debug(St, " bad info: ~w~n", [Info]), - {stop, {error, {badinfo, Info}}, St}. - - -%% terminate -%% -%% -terminate(Reason, St) -> - debug(St, "in terminate reason: ~w, state: ~w~n", [Reason, St]), - ok. - -%% code_change -%% -%% -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%% -%% Primitive interface -%% -listen_prim(ServerName, Client, Port, Opts, St) -> - LOpts = get_tcp_listen_opts(Opts), - SSLOpts = get_ssl_opts(Opts), - FlagStr =mk_ssl_optstr(SSLOpts), - BackLog = get_backlog(LOpts), - IP = get_ip(LOpts), - case ssl_server:listen_prim(ServerName, IP, Port, FlagStr, BackLog) of - {ok, ListenFd, _Port0} -> - ThisSocket = #sslsocket{fd = ListenFd, pid = self()}, - StOpts = add_default_tcp_listen_opts(LOpts) ++ - add_default_ssl_opts(SSLOpts), - NSt = St#st{fd = ListenFd, - active = get_active(LOpts), % irrelevant for listen - opts = StOpts, - thissock = ThisSocket, - status = open}, - debug(St, "listen: ok: client = ~w, listenfd = ~w~n", - [Client, ListenFd]), - {ok, ThisSocket, NSt}; - {error, Reason} -> - {error, Reason, St} - end. - -connect_prim(ServerName, TcpModule, Client, FAddress, FPort, Opts, - Timeout, St) -> - COpts = get_tcp_connect_opts(Opts), - SSLOpts = get_ssl_opts(Opts), - FlagStr = mk_ssl_optstr(SSLOpts), - case inet:getaddr(FAddress, inet) of - {ok, FIP} -> - %% Timeout is gen_server timeout - hence catch - LIP = get_ip(COpts), - LPort = get_port(COpts), - case (catch ssl_server:connect_prim(ServerName, - LIP, LPort, FIP, FPort, - FlagStr, Timeout)) of - {ok, Fd, ProxyPort} -> - case connect_proxy(ServerName, TcpModule, Fd, - ProxyPort, COpts, Timeout) of - {ok, Socket} -> - ThisSocket = #sslsocket{fd = Fd, pid = self()}, - StOpts = add_default_tcp_connect_opts(COpts) ++ - add_default_ssl_opts(SSLOpts), - NSt = St#st{fd = Fd, - active = get_active(COpts), - opts = StOpts, - thissock = ThisSocket, - proxysock = Socket, - status = open}, - case get_nodelay(COpts) of - true -> setnodelay(ServerName, NSt, true); - _ -> ok - end, - debug(St, "connect: ok: client = ~w, fd = ~w~n", - [Client, Fd]), - {ok, ThisSocket, NSt}; - {error, Reason} -> - {error, Reason, St} - end; - {'EXIT', Reason} -> - {error, Reason, St}; - {error, Reason} -> - {error, Reason, St} - end; - {error, Reason} -> - {error, Reason, St} - end. - -transport_accept_prim(ServerName, ListenFd, LOpts, Timeout, St) -> - AOpts = get_tcp_accept_opts(LOpts), - FlagStr = "", - %% Timeout is gen_server timeout - hence catch. - case (catch ssl_server:transport_accept_prim(ServerName, ListenFd, - FlagStr, Timeout)) of - {ok, Fd, ProxyPort} -> - ThisSocket = #sslsocket{fd = Fd, pid = self()}, - NSt = St#st{fd = Fd, - active = get_active(AOpts), - opts = AOpts, - thissock = ThisSocket, - proxyport = ProxyPort, - encrypted = false}, - debug(St, "transport_accept: ok: fd = ~w~n", [Fd]), - {ok, ThisSocket, NSt}; - {'EXIT', Reason} -> - debug(St, "transport_accept: EXIT: Reason = ~w~n", [Reason]), - {error, Reason, St}; - {error, Reason} -> - debug(St, "transport_accept: error: Reason = ~w~n", [Reason]), - {error, Reason, St} - end. - -ssl_accept_prim(ServerName, TcpModule, Client, LOpts, Timeout, St) -> - FlagStr = [], - SSLOpts = [], - AOpts = get_tcp_accept_opts(LOpts), - %% Timeout is gen_server timeout - hence catch. - debug(St, "ssl_accept_prim: self() ~w Client ~w~n", [self(), Client]), - Socket = St#st.thissock, - Fd = Socket#sslsocket.fd, - A = (catch ssl_server:ssl_accept_prim(ServerName, Fd, FlagStr, Timeout)), - debug(St, "ssl_accept_prim: ~w~n", [A]), - case A of - ok -> - B = connect_proxy(ServerName, TcpModule, Fd, - St#st.proxyport, AOpts, Timeout), - debug(St, "ssl_accept_prim: connect_proxy ~w~n", [B]), - case B of - {ok, Socket2} -> - StOpts = add_default_tcp_accept_opts(AOpts) ++ - add_default_ssl_opts(SSLOpts), - NSt = St#st{opts = StOpts, - proxysock = Socket2, - encrypted = true, - status = open}, - case get_nodelay(AOpts) of - true -> setnodelay(ServerName, NSt, true); - _ -> ok - end, - debug(St, "transport_accept: ok: client = ~w, fd = ~w~n", - [Client, Fd]), - {ok, St#st.thissock, NSt}; - {error, Reason} -> - {error, Reason, St} - end; - {'EXIT', Reason} -> - {error, Reason, St}; - {error, Reason} -> - {error, Reason, St} - end. - - -%% -%% LOCAL FUNCTIONS -%% - -%% -%% connect_proxy(Fd, ProxyPort, TOpts, Timeout) -> {ok, Socket} | -%% {error, Reason} -%% -connect_proxy(ServerName, TcpModule, Fd, ProxyPort, TOpts, Timeout) -> - case TcpModule:connect({127, 0, 0, 1}, ProxyPort, TOpts, Timeout) of - {ok, Socket} -> - {ok, Port} = inet:port(Socket), - A = ssl_server:proxy_join_prim(ServerName, Fd, Port), - case A of - ok -> - {ok, Socket}; - Error -> - Error - end; - Error -> - Error - end. - - -setnodelay(ServerName, St, Bool) -> - case ssl_server:setnodelay_prim(ServerName, St#st.fd, Bool) of - ok -> - case inet:setopts(St#st.proxysock, [{nodelay, Bool}]) of - ok -> - ok; - {error, Reason} -> - {error, Reason} - end; - {error, Reason} -> - {error, Reason} - end. - -%% -%% start_collector() -%% -%% A collector is a little process that keeps messages during change of -%% controlling process. -%% XXX This is not gen_server compliant :-(. -%% -start_collector() -> - Pid = spawn_link(?MODULE, collector_init, [self()]), - {ok, Pid}. - -%% -%% release_collector(Collector, NewOwner) -%% -release_collector(Collector, NewOwner) -> - Collector ! {release, self(), NewOwner}, - receive - %% Reap collector - {'EXIT', Collector, normal} -> - ok - end. - -%% -%% collector_init(Broker) -> void() -%% -collector_init(Broker) -> - receive - {release, Broker, NewOwner} -> - transfer_messages(Broker, NewOwner) - end. - -%% -%% transfer_messages(Pid, NewOwner) -> void() -%% -transfer_messages(Pid, NewOwner) -> - receive - {ssl, Sock, Data} -> - NewOwner ! {ssl, Sock, Data}, - transfer_messages(Pid, NewOwner); - {ssl_closed, Sock} -> - NewOwner ! {ssl_closed, Sock}, - transfer_messages(Pid, NewOwner); - {ssl_error, Sock, Reason} -> - NewOwner ! {ssl_error, Sock, Reason}, - transfer_messages(Pid, NewOwner) - after 0 -> - ok - end. - -%% -%% debug(St, Format, Args) -> void() - printouts -%% -debug(St, Format, Args) -> - debug1(St#st.debug, St#st.brokertype, Format, Args). - -debug1(true, Type, Format0, Args) -> - {_MS, S, MiS} = erlang:now(), - Secs = S rem 100, - MiSecs = MiS div 1000, - Format = "++++ ~3..0w:~3..0w ssl_broker (~w)[~w]: " ++ Format0, - io:format(Format, [Secs, MiSecs, self(), Type| Args]); -debug1(_, _, _, _) -> - ok. - -%% -%% what(Reason) -> What -%% -what(Reason) when is_atom(Reason) -> - Reason; -what({'EXIT', Reason}) -> - what(Reason); -what({What, _Where}) when is_atom(What) -> - What; -what(Reason) -> - Reason. - - -%% -%% OPTIONS -%% -%% Note that `accept' has no options when invoked, but get all its options -%% by inheritance from `listen'. -%% - -are_opt_tags(listener, OptTags) -> - is_subset(OptTags, listen_opt_tags()); -are_opt_tags(acceptor, OptTags) -> - is_subset(OptTags, accept_opt_tags()); -are_opt_tags(connector, OptTags) -> - is_subset(OptTags, connect_opt_tags()). - -listen_opt_tags() -> - tcp_listen_opt_tags() ++ ssl_opt_tags(). - -accept_opt_tags() -> - tcp_gen_opt_tags(). - -connect_opt_tags() -> - tcp_gen_opt_tags() ++ ssl_opt_tags(). - -tcp_listen_opt_tags() -> - tcp_gen_opt_tags() ++ tcp_listen_only_opt_tags(). - -tcp_gen_opt_tags() -> - %% All except `reuseaddr' and `deliver'. - [nodelay, active, packet, mode, header]. - -tcp_listen_only_opt_tags() -> - [ip, backlog]. - -ssl_opt_tags() -> - %% XXX Should remove cachetimeout. - [verify, depth, certfile, password, cacertfile, ciphers, cachetimeout]. - -%% Options - -%% -%% are_*_opts(Opts) -> boolean() -%% -are_connect_opts(Opts) -> - are_opts(fun is_connect_opt/1, Opts). - -are_listen_opts(Opts) -> - are_opts(fun is_listen_opt/1, Opts). - -are_opts(F, Opts) -> - lists:all(F, transform_opts(Opts)). - -%% -%% get_*_opts(Opts) -> Value -%% -get_tcp_accept_opts(Opts) -> - [O || O <- transform_opts(Opts), is_tcp_accept_opt(O)]. - -get_tcp_connect_opts(Opts) -> - [O || O <- transform_opts(Opts), is_tcp_connect_opt(O)]. - -get_tcp_listen_opts(Opts) -> - [O || O <- transform_opts(Opts), is_tcp_listen_opt(O)]. - -get_ssl_opts(Opts) -> - [O || O <- transform_opts(Opts), is_ssl_opt(O)]. - -get_active(Opts) -> - get_tagged_opt(active, Opts, true). - -get_backlog(Opts) -> - get_tagged_opt(backlog, Opts, ?DEF_BACKLOG). - -get_ip(Opts) -> - get_tagged_opt(ip, Opts, {0, 0, 0, 0}). - -get_port(Opts) -> - get_tagged_opt(port, Opts, 0). - -get_nodelay(Opts) -> - get_tagged_opt(nodelay, Opts, empty). - -%% -%% add_default_*_opts(Opts) -> NOpts -%% - -add_default_tcp_accept_opts(Opts) -> - add_default_opts(Opts, default_tcp_accept_opts()). - -add_default_tcp_connect_opts(Opts) -> - add_default_opts(Opts, default_tcp_connect_opts()). - -add_default_tcp_listen_opts(Opts) -> - add_default_opts(Opts, default_tcp_listen_opts()). - -add_default_ssl_opts(Opts) -> - add_default_opts(Opts, default_ssl_opts()). - -add_default_opts(Opts, DefOpts) -> - TOpts = transform_opts(Opts), - TOpts ++ [DP || {DTag, _DVal} = DP <- DefOpts, - not lists:keymember(DTag, 1, TOpts)]. - -default_tcp_accept_opts() -> - [O || O <- default_opts(), is_tcp_accept_opt(O)]. - -default_tcp_connect_opts() -> - [O || O <- default_opts(), is_tcp_connect_opt(O)]. - -default_tcp_listen_opts() -> - [O || O <- default_opts(), is_tcp_listen_opt(O)]. - -default_ssl_opts() -> - [O || O <- default_opts(), is_ssl_opt(O)]. - -default_opts() -> - [{mode, list}, {packet, 0}, {nodelay, false}, {active, true}, - {backlog, ?DEF_BACKLOG}, {ip, {0, 0, 0, 0}}, - {verify, 0}, {depth, 1}]. - - -%% Transform from old to new options, and also from old gen_tcp -%% options to new ones. All returned options are tagged options. -%% -transform_opts(Opts) -> - lists:flatmap(fun transform_opt/1, Opts). - -transform_opt(binary) -> [{mode, binary}]; -transform_opt(list) -> [{mode, list}]; -transform_opt({packet, raw}) -> [{packet, 0}]; -transform_opt(raw) -> []; -transform_opt(Opt) -> [Opt]. - -%% NOTE: The is_*_opt/1 functions must be applied on transformed options -%% only. - -is_connect_opt(Opt) -> - is_tcp_connect_opt(Opt) or is_ssl_opt(Opt). - -is_listen_opt(Opt) -> - is_tcp_listen_opt(Opt) or is_ssl_opt(Opt). - -is_tcp_accept_opt(Opt) -> - is_tcp_gen_opt(Opt). - -is_tcp_connect_opt(Opt) -> - is_tcp_gen_opt(Opt) or is_tcp_connect_only_opt(Opt). - -is_tcp_listen_opt(Opt) -> - is_tcp_gen_opt(Opt) or is_tcp_listen_only_opt(Opt). - -%% General options supported by gen_tcp: All except `reuseaddr' and -%% `deliver'. -is_tcp_gen_opt({mode, list}) -> true; -is_tcp_gen_opt({mode, binary}) -> true; -is_tcp_gen_opt({header, Sz}) when is_integer(Sz), 0 =< Sz -> true; -is_tcp_gen_opt({packet, Sz}) when is_integer(Sz), 0 =< Sz, Sz =< 4-> true; -is_tcp_gen_opt({packet, sunrm}) -> true; -is_tcp_gen_opt({packet, asn1}) -> true; -is_tcp_gen_opt({packet, cdr}) -> true; -is_tcp_gen_opt({packet, fcgi}) -> true; -is_tcp_gen_opt({packet, line}) -> true; -is_tcp_gen_opt({packet, tpkt}) -> true; -is_tcp_gen_opt({packet, http}) -> true; -is_tcp_gen_opt({packet, httph}) -> true; -is_tcp_gen_opt({nodelay, true}) -> true; -is_tcp_gen_opt({nodelay, false}) -> true; -is_tcp_gen_opt({active, true}) -> true; -is_tcp_gen_opt({active, false}) -> true; -is_tcp_gen_opt({active, once}) -> true; -is_tcp_gen_opt({keepalive, true}) -> true; -is_tcp_gen_opt({keepalive, false}) -> true; -is_tcp_gen_opt({ip, Addr}) -> is_ip_address(Addr); -is_tcp_gen_opt(_Opt) -> false. - -is_tcp_listen_only_opt({backlog, Size}) when is_integer(Size), 0 =< Size -> - true; -is_tcp_listen_only_opt({reuseaddr, Bool}) when is_boolean(Bool) -> - true; -is_tcp_listen_only_opt(_Opt) -> false. - -is_tcp_connect_only_opt({port, Port}) when is_integer(Port), 0 =< Port -> true; -is_tcp_connect_only_opt(_Opt) -> false. - -%% SSL options - -is_ssl_opt({verify, Code}) when 0 =< Code, Code =< 2 -> true; -is_ssl_opt({depth, Depth}) when 0 =< Depth -> true; -is_ssl_opt({certfile, String}) -> is_string(String); -is_ssl_opt({keyfile, String}) -> is_string(String); -is_ssl_opt({password, String}) -> is_string(String); -is_ssl_opt({cacertfile, String}) -> is_string(String); -is_ssl_opt({ciphers, String}) -> is_string(String); -is_ssl_opt({cachetimeout, Timeout}) when Timeout >= 0 -> true; -is_ssl_opt(_Opt) -> false. - -%% Various types -is_string(String) when is_list(String) -> - lists:all(fun (C) when is_integer(C), 0 =< C, C =< 255 -> true; - (_C) -> false end, - String); -is_string(_) -> - false. - -is_ip_address(Addr) when tuple_size(Addr) =:= 4 -> - is_string(tuple_to_list(Addr)); -is_ip_address(Addr) when is_list(Addr) -> - is_string(Addr); -is_ip_address(_) -> - false. - -get_tagged_opt(Tag, Opts, Default) -> - case lists:keysearch(Tag, 1, Opts) of - {value, {_, Value}} -> - Value; - _Other -> - Default - end. - -%% -%% mk_ssl_optstr(Opts) -> string() -%% -%% Makes a "command line" string of SSL options -%% -mk_ssl_optstr(Opts) -> - lists:flatten([mk_one_ssl_optstr(O) || O <- Opts]). - -mk_one_ssl_optstr({verify, Code}) -> - [" -verify ", integer_to_list(Code)]; -mk_one_ssl_optstr({depth, Depth}) -> - [" -depth ", integer_to_list(Depth)]; -mk_one_ssl_optstr({certfile, String}) -> - [" -certfile ", String]; -mk_one_ssl_optstr({keyfile, String}) -> - [" -keyfile ", String]; -mk_one_ssl_optstr({password, String}) -> - [" -password ", String]; -mk_one_ssl_optstr({cacertfile, String}) -> - [" -cacertfile ", String]; -mk_one_ssl_optstr({ciphers, String}) -> - [" -ciphers ", String]; -mk_one_ssl_optstr({cachetimeout, Timeout}) -> - [" -cachetimeout ", integer_to_list(Timeout)]; -mk_one_ssl_optstr(_) -> - "". - -extract_opts(OptTags, Opts) -> - [O || O = {Tag,_} <- Opts, lists:member(Tag, OptTags)]. - -replace_opts(NOpts, Opts) -> - lists:foldl(fun({Key, Val}, Acc) -> - lists:keyreplace(Key, 1, Acc, {Key, Val}); - %% XXX Check. Patch from Chandrashekhar Mullaparthi. - (binary, Acc) -> - lists:keyreplace(mode, 1, Acc, {mode, binary}) - end, - Opts, NOpts). - -%% Misc - -is_subset(A, B) -> - [] =:= A -- B. diff --git a/lib/ssl/src/ssl_broker_int.hrl b/lib/ssl/src/ssl_broker_int.hrl deleted file mode 100644 index b791485725..0000000000 --- a/lib/ssl/src/ssl_broker_int.hrl +++ /dev/null @@ -1,38 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-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: record definitions shared between ssl_prim.erl and ssl_broker.erl - --record(st, {brokertype = nil, % connector | listener | acceptor - server = nil, % pid of ssl_server - client = nil, % client pid - collector = nil, % client pid, or collector during change of - % controlling process - fd = nil, % fd of "external" socket in port program - active = true, % true | false | once - opts = [], % options - thissock = nil, % this sslsocket - proxysock = nil, % local proxy socket within Erlang - proxyport = nil, % local port for proxy within Erlang - status = nil, % open | closing | closed - encrypted = false, % - debug = false % - }). diff --git a/lib/ssl/src/ssl_broker_sup.erl b/lib/ssl/src/ssl_broker_sup.erl deleted file mode 100644 index 6d56a5fcf6..0000000000 --- a/lib/ssl/src/ssl_broker_sup.erl +++ /dev/null @@ -1,46 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% - -%%% Purpose : Supervisor for brokers - --module(ssl_broker_sup). - --behaviour(supervisor). - --export([start_link/0]). - -%% supervisor callbacks --export([init/1]). - -start_link() -> - supervisor:start_link({local, ssl_broker_sup}, ssl_broker_sup, - []). - -init([]) -> - {ok, {{simple_one_for_one, 10, 3600}, - [{ssl_broker, - {ssl_broker, start_link, []}, - temporary, - 100, - worker, - [ssl_broker]} - ]}}. - diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 72f02a4362..95a5efd6d0 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -154,18 +154,23 @@ decipher(?AES, HashSz, CipherState, Fragment, Version) -> block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, HashSz, Fragment, Version) -> - try Fun(Key, IV, Fragment) of - Text -> - GBC = generic_block_cipher_from_bin(Text, HashSz), - case is_correct_padding(GBC, Version) of - true -> - Content = GBC#generic_block_cipher.content, - Mac = GBC#generic_block_cipher.mac, - CipherState1 = CipherState0#cipher_state{iv=next_iv(Fragment, IV)}, - {Content, Mac, CipherState1}; - false -> - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) - end + try + Text = Fun(Key, IV, Fragment), + GBC = generic_block_cipher_from_bin(Text, HashSz), + Content = GBC#generic_block_cipher.content, + Mac = GBC#generic_block_cipher.mac, + CipherState1 = CipherState0#cipher_state{iv=next_iv(Fragment, IV)}, + case is_correct_padding(GBC, Version) of + true -> + {Content, Mac, CipherState1}; + false -> + %% decryption failed or invalid padding, + %% intentionally break Content to make + %% sure a packet with a an invalid padding + %% but otherwise correct data will fail + %% the MAC test later + {<<16#F0, Content/binary>>, Mac, CipherState1} + end catch _:_ -> %% This is a DECRYPTION_FAILED but @@ -500,14 +505,38 @@ hash_size(md5) -> hash_size(sha) -> 20. +%% RFC 5246: 6.2.3.2. CBC Block Cipher +%% +%% Implementation note: Canvel et al. [CBCTIME] have demonstrated a +%% timing attack on CBC padding based on the time required to compute +%% the MAC. In order to defend against this attack, implementations +%% MUST ensure that record processing time is essentially the same +%% whether or not the padding is correct. In general, the best way to +%% do this is to compute the MAC even if the padding is incorrect, and +%% only then reject the packet. For instance, if the pad appears to be +%% incorrect, the implementation might assume a zero-length pad and then +%% compute the MAC. This leaves a small timing channel, since MAC +%% performance depends to some extent on the size of the data fragment, +%% but it is not believed to be large enough to be exploitable, due to +%% the large block size of existing MACs and the small size of the +%% timing signal. +%% +%% implementation note: +%% We return the original (possibly invalid) PadLength in any case. +%% A invalid PadLength will be cought by is_correct_padding/2 +%% generic_block_cipher_from_bin(T, HashSize) -> Sz1 = byte_size(T) - 1, - <<_:Sz1/binary, ?BYTE(PadLength)>> = T, + <<_:Sz1/binary, ?BYTE(PadLength0)>> = T, + PadLength = if + PadLength0 >= Sz1 -> 0; + true -> PadLength0 + end, CompressedLength = byte_size(T) - PadLength - 1 - HashSize, <<Content:CompressedLength/binary, Mac:HashSize/binary, - Padding:PadLength/binary, ?BYTE(PadLength)>> = T, + Padding:PadLength/binary, ?BYTE(PadLength0)>> = T, #generic_block_cipher{content=Content, mac=Mac, - padding=Padding, padding_length=PadLength}. + padding=Padding, padding_length=PadLength0}. generic_stream_cipher_from_bin(T, HashSz) -> Sz = byte_size(T), @@ -516,17 +545,18 @@ generic_stream_cipher_from_bin(T, HashSz) -> #generic_stream_cipher{content=Content, mac=Mac}. -is_correct_padding(_, {3, 0}) -> - true; -%% For interoperability reasons we do not check the padding in TLS 1.0 as it -%% is not strictly required and breaks interopability with for instance -%% Google. -is_correct_padding(_, {3, 1}) -> - true; +%% For interoperability reasons we do not check the padding content in +%% SSL 3.0 and TLS 1.0 as it is not strictly required and breaks +%% interopability with for instance Google. +is_correct_padding(#generic_block_cipher{padding_length = Len, + padding = Padding}, {3, N}) + when N == 0; N == 1 -> + Len == byte_size(Padding); %% Padding must be check in TLS 1.1 and after -is_correct_padding(#generic_block_cipher{padding_length = Len, padding = Padding}, _) -> - list_to_binary(lists:duplicate(Len, Len)) == Padding. - +is_correct_padding(#generic_block_cipher{padding_length = Len, + padding = Padding}, _) -> + Len == byte_size(Padding) andalso + list_to_binary(lists:duplicate(Len, Len)) == Padding. get_padding(Length, BlockSize) -> get_padding_aux(BlockSize, Length rem BlockSize). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index cec81d551b..59b0132ff5 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -34,7 +34,6 @@ -include("ssl_record.hrl"). -include("ssl_cipher.hrl"). -include("ssl_internal.hrl"). --include("ssl_int.hrl"). -include_lib("public_key/include/public_key.hrl"). %% Internal application API @@ -1033,7 +1032,8 @@ code_change(_OldVsn, StateName, State, _Extra) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -start_fsm(Role, Host, Port, Socket, Opts, User, {CbModule, _,_, _} = CbInfo, +start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_} = Opts, + User, {CbModule, _,_, _} = CbInfo, Timeout) -> try {ok, Pid} = ssl_connection_sup:start_child([Role, Host, Port, Socket, @@ -1044,9 +1044,26 @@ start_fsm(Role, Host, Port, Socket, Opts, User, {CbModule, _,_, _} = CbInfo, catch error:{badmatch, {error, _} = Error} -> Error + end; + +start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_} = Opts, + User, {CbModule, _,_, _} = CbInfo, + Timeout) -> + try + {ok, Pid} = ssl_connection_sup:start_child_dist([Role, Host, Port, Socket, + Opts, User, CbInfo]), + {ok, SslSocket} = socket_control(Socket, Pid, CbModule), + ok = handshake(SslSocket, Timeout), + {ok, SslSocket} + catch + error:{badmatch, {error, _} = Error} -> + Error end. ssl_init(SslOpts, Role) -> + + init_manager_name(SslOpts#ssl_options.erl_dist), + {ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert} = init_certificates(SslOpts, Role), PrivateKey = init_private_key(CertDbHandle, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile, @@ -1054,6 +1071,10 @@ ssl_init(SslOpts, Role) -> DHParams = init_diffie_hellman(CertDbHandle, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role), {ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert, PrivateKey, DHParams}. +init_manager_name(false) -> + put(ssl_manager, ssl_manager); +init_manager_name(true) -> + put(ssl_manager, ssl_manager_dist). init_certificates(#ssl_options{cacerts = CaCerts, cacertfile = CACertFile, @@ -1105,18 +1126,38 @@ init_private_key(DbHandle, undefined, KeyFile, Password, _) -> {ok, List} = ssl_manager:cache_pem_file(KeyFile, DbHandle), [PemEntry] = [PemEntry || PemEntry = {PKey, _ , _} <- List, PKey =:= 'RSAPrivateKey' orelse - PKey =:= 'DSAPrivateKey'], - public_key:pem_entry_decode(PemEntry, Password) + PKey =:= 'DSAPrivateKey' orelse + PKey =:= 'PrivateKeyInfo' + ], + private_key(public_key:pem_entry_decode(PemEntry, Password)) catch Error:Reason -> handle_file_error(?LINE, Error, Reason, KeyFile, ekeyfile, erlang:get_stacktrace()) end; +%% First two clauses are for backwards compatibility init_private_key(_,{rsa, PrivateKey}, _, _,_) -> - public_key:der_decode('RSAPrivateKey', PrivateKey); + init_private_key('RSAPrivateKey', PrivateKey); init_private_key(_,{dsa, PrivateKey},_,_,_) -> - public_key:der_decode('DSAPrivateKey', PrivateKey). + init_private_key('DSAPrivateKey', PrivateKey); +init_private_key(_,{Asn1Type, PrivateKey},_,_,_) -> + private_key(init_private_key(Asn1Type, PrivateKey)). + +init_private_key(Asn1Type, PrivateKey) -> + public_key:der_decode(Asn1Type, PrivateKey). + +private_key(#'PrivateKeyInfo'{privateKeyAlgorithm = + #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'rsaEncryption'}, + privateKey = Key}) -> + public_key:der_decode('RSAPrivateKey', iolist_to_binary(Key)); + +private_key(#'PrivateKeyInfo'{privateKeyAlgorithm = + #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'id-dsa'}, + privateKey = Key}) -> + public_key:der_decode('DSAPrivateKey', iolist_to_binary(Key)); +private_key(Key) -> + Key. -spec(handle_file_error(_,_,_,_,_,_) -> no_return()). handle_file_error(Line, Error, {badmatch, Reason}, File, Throw, Stack) -> diff --git a/lib/ssl/src/ssl_connection_sup.erl b/lib/ssl/src/ssl_connection_sup.erl index e9328d5f7c..78cfda5e63 100644 --- a/lib/ssl/src/ssl_connection_sup.erl +++ b/lib/ssl/src/ssl_connection_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-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 @@ -26,8 +26,8 @@ -behaviour(supervisor). %% API --export([start_link/0]). --export([start_child/1]). +-export([start_link/0, start_link_dist/0]). +-export([start_child/1, start_child_dist/1]). %% Supervisor callback -export([init/1]). @@ -38,9 +38,15 @@ start_link() -> supervisor:start_link({local, ?MODULE}, ?MODULE, []). +start_link_dist() -> + supervisor:start_link({local, ssl_connection_sup_dist}, ?MODULE, []). + start_child(Args) -> supervisor:start_child(?MODULE, Args). +start_child_dist(Args) -> + supervisor:start_child(ssl_connection_sup_dist, Args). + %%%========================================================================= %%% Supervisor callback %%%========================================================================= diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl new file mode 100644 index 0000000000..c1912401d7 --- /dev/null +++ b/lib/ssl/src/ssl_dist_sup.erl @@ -0,0 +1,84 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-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% +%% + +%% + +-module(ssl_dist_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= + +-spec start_link() -> {ok, pid()} | ignore | {error, term()}. + +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= +-spec init([]) -> {ok, {SupFlags :: tuple(), [ChildSpec :: tuple()]}}. + +init([]) -> + SessionCertManager = session_and_cert_manager_child_spec(), + ConnetionManager = connection_manager_child_spec(), + ProxyServer = proxy_server_child_spec(), + + {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager, + ProxyServer]}}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +session_and_cert_manager_child_spec() -> + Opts = ssl_sup:manager_opts(), + Name = ssl_manager_dist, + StartFunc = {ssl_manager, start_link_dist, [Opts]}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_manager], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +connection_manager_child_spec() -> + Name = ssl_connection_dist, + StartFunc = {ssl_connection_sup, start_link_dist, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_connection], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +proxy_server_child_spec() -> + Name = ssl_tls_dist_proxy, + StartFunc = {ssl_tls_dist_proxy, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_tls_dist_proxy], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + diff --git a/lib/ssl/src/ssl_int.hrl b/lib/ssl/src/ssl_int.hrl deleted file mode 100644 index 3686deffce..0000000000 --- a/lib/ssl/src/ssl_int.hrl +++ /dev/null @@ -1,99 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% - -%% op codes commands are in capital and reply codes in lower case - --define(CONNECT, 1). --define(CONNECT_WAIT, 2). --define(CONNECT_REP, 3). --define(CONNECT_ERR, 4). - --define(TERMINATE, 5). --define(CLOSE, 6). - --define(LISTEN, 7). --define(LISTEN_REP, 8). --define(LISTEN_ERR, 9). - --define(TRANSPORT_ACCEPT, 10). --define(NOACCEPT, 11). --define(TRANSPORT_ACCEPT_REP, 12). --define(TRANSPORT_ACCEPT_ERR, 13). - --define(FROMNET_CLOSE, 14). - --define(CONNECT_SYNC_ERR, 15). --define(LISTEN_SYNC_ERR, 16). - --define(PROXY_PORT, 23). --define(PROXY_JOIN, 24). --define(PROXY_JOIN_REP, 25). --define(PROXY_JOIN_ERR, 26). - --define(SET_SOCK_OPT, 27). --define(IOCTL_OK, 28). --define(IOCTL_ERR, 29). - --define(GETPEERNAME, 30). --define(GETPEERNAME_REP, 31). --define(GETPEERNAME_ERR, 32). - --define(GETSOCKNAME, 33). --define(GETSOCKNAME_REP, 34). --define(GETSOCKNAME_ERR, 35). - --define(GETPEERCERT, 36). --define(GETPEERCERT_REP, 37). --define(GETPEERCERT_ERR, 38). - --define(GETVERSION, 39). --define(GETVERSION_REP, 40). - --define(SET_SEED, 41). - --define(GETCONNINFO, 42). --define(GETCONNINFO_REP, 43). --define(GETCONNINFO_ERR, 44). - --define(SSL_ACCEPT, 45). --define(SSL_ACCEPT_REP, 46). --define(SSL_ACCEPT_ERR, 47). - --define(DUMP_CMD, 48). --define(DEBUG_CMD, 49). --define(DEBUGMSG_CMD, 50). - -%% -------------- - --define(SSLv2, 1). --define(SSLv3, 2). --define(TLSv1, 4). - - -%% Set socket options codes 'SET_SOCK_OPT' --define(SET_TCP_NODELAY, 1). - --define(DEF_BACKLOG, 128). - --define(DEF_TIMEOUT, 10000). - --record(sslsocket, { fd = nil, pid = nil}). - diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 6bf1edc452..18cfcdcd68 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -24,6 +24,9 @@ -include_lib("public_key/include/public_key.hrl"). +%% Looks like it does for backwards compatibility reasons +-record(sslsocket, {fd = nil, pid = nil}). + -type reason() :: term(). -type reply() :: term(). -type msg() :: term(). @@ -98,10 +101,12 @@ renegotiate_at, secure_renegotiate, debug, - hibernate_after % undefined if not hibernating, + hibernate_after,% undefined if not hibernating, % or number of ms of inactivity % after which ssl_connection will % go into hibernation + %% This option should only be set to true by inet_tls_dist + erl_dist = false }). -record(socket_options, diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 725a085d1f..dcf310c535 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -27,7 +27,7 @@ -include("ssl_internal.hrl"). %% Internal application API --export([start_link/1, +-export([start_link/1, start_link_dist/1, connection_init/2, cache_pem_file/2, lookup_trusted_cert/4, issuer_candidate/2, client_session_id/4, server_session_id/4, @@ -66,10 +66,20 @@ %%-------------------------------------------------------------------- -spec start_link(list()) -> {ok, pid()} | ignore | {error, term()}. %% -%% Description: Starts the server +%% Description: Starts the ssl manager that takes care of sessions +%% and certificate caching. %%-------------------------------------------------------------------- start_link(Opts) -> - gen_server:start_link({local, ?MODULE}, ?MODULE, [Opts], []). + gen_server:start_link({local, ?MODULE}, ?MODULE, [?MODULE, Opts], []). + +%%-------------------------------------------------------------------- +-spec start_link_dist(list()) -> {ok, pid()} | ignore | {error, term()}. +%% +%% Description: Starts a special instance of the ssl manager to +%% be used by the erlang distribution. Note disables soft upgrade! +%%-------------------------------------------------------------------- +start_link_dist(Opts) -> + gen_server:start_link({local, ssl_manager_dist}, ?MODULE, [ssl_manager_dist, Opts], []). %%-------------------------------------------------------------------- -spec connection_init(string()| {der, list()}, client | server) -> @@ -166,7 +176,8 @@ invalidate_session(Port, Session) -> %% %% Description: Initiates the server %%-------------------------------------------------------------------- -init([Opts]) -> +init([Name, Opts]) -> + put(ssl_manager, Name), process_flag(trap_exit, true), CacheCb = proplists:get_value(session_cb, Opts, ssl_session_cache), SessionLifeTime = @@ -376,10 +387,10 @@ code_change(_OldVsn, State, _Extra) -> %%% Internal functions %%-------------------------------------------------------------------- call(Msg) -> - gen_server:call(?MODULE, {Msg, self()}, infinity). + gen_server:call(get(ssl_manager), {Msg, self()}, infinity). cast(Msg) -> - gen_server:cast(?MODULE, Msg). + gen_server:cast(get(ssl_manager), Msg). validate_session(Host, Port, Session, LifeTime) -> case ssl_session:valid_session(Session, LifeTime) of @@ -399,9 +410,10 @@ validate_session(Port, Session, LifeTime) -> start_session_validator(Cache, CacheCb, LifeTime) -> spawn_link(?MODULE, init_session_validator, - [[Cache, CacheCb, LifeTime]]). + [[get(ssl_manager), Cache, CacheCb, LifeTime]]). -init_session_validator([Cache, CacheCb, LifeTime]) -> +init_session_validator([SslManagerName, Cache, CacheCb, LifeTime]) -> + put(ssl_manager, SslManagerName), CacheCb:foldl(fun session_validation/2, LifeTime, Cache). diff --git a/lib/ssl/src/ssl_prim.erl b/lib/ssl/src/ssl_prim.erl deleted file mode 100644 index e3140a89d1..0000000000 --- a/lib/ssl/src/ssl_prim.erl +++ /dev/null @@ -1,173 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-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: Primitive interface to SSL, without broker process (used by -%% SSL distribution). - --module(ssl_prim). - --export([listen/2, connect/3, accept/1, close/1, send/2, send/3, recv/2, recv/3, - getll/1, getstat/2, setopts/2, controlling_process/2, peername/1, - sockname/1, getif/1]). - --include("ssl_int.hrl"). --include("ssl_broker_int.hrl"). - -%-define(filter(Call), filter((catch Call))). --define(filter(Call), filter(Call)). - -listen(Port, Opts) -> - St = newstate(listener), - ?filter(ssl_broker:listen_prim(ssl_server_prim, self(), Port, nonactive(Opts), St)). - -connect(Address, Port, Opts) -> - St = newstate(connector), - ?filter(ssl_broker:connect_prim(ssl_server_prim, inet_tcp, self(), Address, - Port, nonactive(Opts), infinity, St)). - -accept(#st{} = ListenSt0) -> - case transport_accept(ListenSt0) of - {ok, ListenSt1} -> - ssl_accept(ListenSt0, ListenSt1); - Error -> - Error - end. - -transport_accept(#st{opts = ListenOpts, thissock = ListenSocket}) -> - NewSt = newstate(acceptor), - ListenFd = ListenSocket#sslsocket.fd, - ?filter(ssl_broker:transport_accept_prim(ssl_server_prim, ListenFd, - ListenOpts, infinity, NewSt)). - -ssl_accept(#st{opts = LOpts}, ListenSt1) -> - ?filter(ssl_broker:ssl_accept_prim(ssl_server_prim, gen_tcp, self(), - LOpts, infinity, ListenSt1)). - -close(#st{fd = Fd}) when is_integer(Fd) -> - ssl_server:close_prim(ssl_server_prim, Fd), - ok; -close(_) -> - ok. - -send(St, Data) -> - send(St, Data, []). - -send(#st{proxysock = Proxysock, status = open}, Data, Opts) -> - case inet_tcp:send(Proxysock, Data, Opts) of - ok -> - ok; - {error, _} -> - {error, closed} - end; -send(#st{}, _Data, _Opts) -> - {error, closed}. - -recv(St, Length) -> - recv(St, Length, infinity). - -recv(#st{proxysock = Proxysock, status = open}, Length, Tmo) -> - inet_tcp:recv(Proxysock, Length, Tmo); -recv(#st{}, _Length, _Tmo) -> - {error, closed}. - -getll(#st{proxysock = Proxysock, status = open}) -> - inet:getll(Proxysock); -getll(#st{}) -> - {error, closed}. - -getstat(#st{proxysock = Proxysock, status = open}, Opts) -> - inet:getstat(Proxysock, Opts); -getstat(#st{}, _Opts) -> - {error, closed}. - -setopts(#st{proxysock = Proxysock, status = open}, Opts) -> - case remove_supported(Opts) of - [] -> - inet:setopts(Proxysock, Opts); - _ -> - {error, enotsup} - end; -setopts(#st{}, _Opts) -> - {error, closed}. - - -controlling_process(#st{proxysock = Proxysock, status = open}, Pid) - when is_pid(Pid) -> - inet_tcp:controlling_process(Proxysock, Pid); -controlling_process(#st{}, Pid) when is_pid(Pid) -> - {error, closed}. - -peername(#st{fd = Fd, status = open}) -> - case ssl_server:peername_prim(ssl_server_prim, Fd) of - {ok, {Address, Port}} -> - {ok, At} = inet_parse:ipv4_address(Address), - {ok, {At, Port}}; - Error -> - Error - end; -peername(#st{}) -> - {error, closed}. - -sockname(#st{fd = Fd, status = open}) -> - case ssl_server:sockname_prim(ssl_server_prim, Fd) of - {ok, {Address, Port}} -> - {ok, At} = inet_parse:ipv4_address(Address), - {ok, {At, Port}}; - Error -> - Error - end; -sockname(#st{}) -> - {error, closed}. - -getif(#st{proxysock = Proxysock, status = open}) -> - inet:getif(Proxysock); -getif(#st{}) -> - {error, closed}. - -remove_supported([{active, _}|T]) -> - remove_supported(T); -remove_supported([{packet,_}|T]) -> - remove_supported(T); -remove_supported([{deliver,_}|T]) -> - remove_supported(T); -remove_supported([H|T]) -> - [H | remove_supported(T)]; -remove_supported([]) -> - []. - -filter(Result) -> - case Result of - {ok, _Sock,St} -> - {ok, St}; - {error, Reason, _St} -> - {error,Reason} - end. - -nonactive([{active,_}|T]) -> - nonactive(T); -nonactive([H|T]) -> - [H | nonactive(T)]; -nonactive([]) -> - [{active, false}]. - -newstate(Type) -> - #st{brokertype = Type, server = whereis(ssl_server_prim), - client = undefined, collector = undefined, debug = false}. diff --git a/lib/ssl/src/ssl_server.erl b/lib/ssl/src/ssl_server.erl deleted file mode 100644 index b66e20a397..0000000000 --- a/lib/ssl/src/ssl_server.erl +++ /dev/null @@ -1,1378 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% - -%%% Purpose : SSL server - -%% -%% TODO -%% -%% XXX The ip option in listen is not general enough. It is assumed -%% to be a tuple, which is not always the case. - --module(ssl_server). --behaviour(gen_server). - -%% External exports --export([start_link/0]). - --export([transport_accept/2, transport_accept/3, ssl_accept/2, ssl_accept/3, - ciphers/0, connect/5, connect/6, - connection_info/1, close/1, listen/3, listen/4, peercert/1, - peername/1, proxy_join/2, seed/1, setnodelay/2, sockname/1, - version/0]). - --export([start_link_prim/0]). --export([ssl_accept_prim/4, transport_accept_prim/4, - connect_prim/7, close_prim/2, - listen_prim/5, proxy_join_prim/3, peername_prim/2, setnodelay_prim/3, - sockname_prim/2]). - --export([dump/0, dump/1]). --export([enable_debug/0, disable_debug/0, set_debug/1]). --export([enable_debugmsg/0, disable_debugmsg/0, set_debugmsg/1]). - -%% gen_server callbacks --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - code_change/3, terminate/2]). - --include("ssl_int.hrl"). - --record(st, { - port = [], % port() of port program - progpid = [], % OS pid of port program - debug = false, % debug printout flag - cons = [], % All brokers except pending accepts - paccepts = [], % Pending accept brokers - proxylsport = [], % proxy listen socket port - intref = 0, % internal reference counter - compvsn = "", % ssl compile library version - libvsn = "", % ssl library version - ciphers = [] % available ciphers - }). - - -%% In all functions below IP is a four tuple, e.g. {192, 236, 52, 7}. -%% Port, Fd and ListenFd are integers; Flags is a string of characters. -%% -%% The prefixes F and L mean foreign and local, respectively. -%% Example: FIP (IP address for foreign end). - -%% -%% start_link() -> {ok, Pid} | {error, Reason} -%% -start_link() -> - gen_server:start_link({local, ssl_server}, ssl_server, [], []). - -start_link_prim() -> - gen_server:start_link({local, ssl_server_prim}, ssl_server, [], []). - -%% -%% transport_accept(ListenFd, Flags) -> {ok, Fd, ProxyLLPort} | -%% {error, Reason} -%% -transport_accept(ListenFd, Flags) -> - transport_accept(ListenFd, Flags, infinity). -transport_accept(ListenFd, Flags, Timeout) -> - transport_accept_prim(ssl_server,ListenFd, Flags, Timeout). - -transport_accept_prim(ServerName, ListenFd, Flags, Timeout) -> - Req = {transport_accept, self(), ListenFd, Flags}, - gen_server:call(ServerName, Req, Timeout). - -%% -%% ssl_accept(ListenFd, Flags) -> {ok, Fd, ProxyLLPort} | -%% {error, Reason} -%% -ssl_accept(ListenFd, Flags) -> - ssl_accept(ListenFd, Flags, infinity). -ssl_accept(ListenFd, Flags, Timeout) -> - ssl_accept_prim(ssl_server, ListenFd, Flags, Timeout). - -ssl_accept_prim(ServerName, Fd, Flags, Timeout) -> - Req = {ssl_accept, Fd, Flags}, - gen_server:call(ServerName, Req, Timeout). - -%% -%% ciphers() -> {ok, Ciphers} -%% -ciphers() -> - gen_server:call(ssl_server, ciphers, infinity). - -%% -%% close(Fd) -> ok -%% -close(Fd) -> - close_prim(ssl_server, Fd). -close_prim(ServerName, Fd) -> - gen_server:call(ServerName, {close, self(), Fd}, infinity), - ok. - -%% -%% connect(LIP, LPort, FIP, FPort, Flags) -> {ok, Fd, ProxyLFPort} | -%% {error, Reason} -%% -connect(LIP, LPort, FIP, FPort, Flags) -> - connect(LIP, LPort, FIP, FPort, Flags, infinity). -connect(LIP, LPort, FIP, FPort, Flags, Timeout) -> - connect_prim(ssl_server, LIP, LPort, FIP, FPort, Flags, Timeout). - -connect_prim(ServerName, LIP, LPort, FIP, FPort, Flags, Timeout) -> - Req = {connect, self(), LIP, LPort, FIP, FPort, Flags}, - gen_server:call(ServerName, Req, Timeout). - -%% -%% connection_info(Fd) -> {ok, {Protocol, Cipher}} | {error, Reason} -%% -connection_info(Fd) -> - Req = {connection_info, self(), Fd}, - gen_server:call(ssl_server, Req, infinity). - -%% -%% listen(IP, LPort, Flags), -%% listen(IP, LPort, Flags, BackLog) -> {ok, ListenFd, LPort0} | -%% {error, Reason} -%% -listen(IP, LPort, Flags) -> - listen(IP, LPort, Flags, ?DEF_BACKLOG). -listen(IP, LPort, Flags, BackLog) -> - listen_prim(ssl_server, IP, LPort, Flags, BackLog). -listen_prim(ServerName, IP, LPort, Flags, BackLog) -> - Req = {listen, self(), IP, LPort, Flags, BackLog}, - gen_server:call(ServerName, Req, infinity). - -%% -%% peercert(Fd) -> {ok, Cert} | {error, Reason} -%% -peercert(Fd) -> - Req = {peercert, self(), Fd}, - gen_server:call(ssl_server, Req, infinity). - -%% -%% peername(Fd) -> {ok, {Address, Port}} | {error, Reason} -%% -peername(Fd) -> - peername_prim(ssl_server, Fd). -peername_prim(ServerName, Fd) -> - Req = {peername, self(), Fd}, - gen_server:call(ServerName, Req, infinity). - -%% -%% proxy_join(Fd, LPort) -> ok | {error, Reason} -%% -proxy_join(Fd, LPort) -> - proxy_join_prim(ssl_server, Fd, LPort). -proxy_join_prim(ServerName, Fd, LPort) -> - Req = {proxy_join, self(), Fd, LPort}, - gen_server:call(ServerName, Req, infinity). - -%% -%% seed(Data) -%% -seed(Data) -> - Req = {seed, Data}, - gen_server:call(ssl_server, Req, infinity). - -%% -%% set_nodelay(Fd, Boolean) -%% -setnodelay(Fd, Boolean) -> - setnodelay_prim(ssl_server, Fd, Boolean). -setnodelay_prim(ServerName, Fd, Boolean) -> - Req = {setnodelay, self(), Fd, Boolean}, - gen_server:call(ServerName, Req, infinity). - -%% -%% sockname(Fd) -> {ok, {Address, Port}} | {error, Reason} -%% -sockname(Fd) -> - sockname_prim(ssl_server, Fd). -sockname_prim(ServerName, Fd) -> - Req = {sockname, self(), Fd}, - gen_server:call(ServerName, Req, infinity). - -%% -%% version() -> {ok, {CompVsn, LibVsn}} -%% -version() -> - gen_server:call(ssl_server, version, infinity). - - -enable_debug() -> - set_debug(true). - -disable_debug() -> - set_debug(false). - -set_debug(Bool) -> - set_debug(Bool, infinity). - -set_debug(Bool, Timeout) when is_boolean(Bool) -> - Req = {set_debug, Bool, self()}, - gen_server:call(ssl_server, Req, Timeout). - -enable_debugmsg() -> - set_debugmsg(true). - -disable_debugmsg() -> - set_debugmsg(false). - -set_debugmsg(Bool) -> - set_debugmsg(Bool, infinity). - -set_debugmsg(Bool, Timeout) when is_boolean(Bool) -> - Req = {set_debugmsg, Bool, self()}, - gen_server:call(ssl_server, Req, Timeout). - -dump() -> - dump(infinity). - -dump(Timeout) -> - Req = {dump, self()}, - gen_server:call(ssl_server, Req, Timeout). - -%% -%% init -%% -init([]) -> - Debug = case application:get_env(ssl, edebug) of - {ok, true} -> - true; - _ -> - case application:get_env(ssl, debug) of - {ok, true} -> - true; - _ -> - os:getenv("ERL_SSL_DEBUG") =/= false - end - end, - ProgDir = - case init:get_argument(ssl_portprogram_dir) of - {ok, [[D]]} -> - D; - _ -> - find_priv_bin() - end, - {Program, Flags} = mk_cmd_line("ssl_esock"), - Cmd = filename:join(ProgDir, Program) ++ " " ++ Flags, - debug1(Debug, " start, Cmd = ~s~n", [Cmd]), - case (catch open_port({spawn, Cmd}, [binary, {packet, 4}])) of - Port when is_port(Port) -> - process_flag(trap_exit, true), - receive - {Port, {data, Bin}} -> - {ProxyLLPort, ProgPid, CompVsn, LibVsn, Ciphers} = - decode_msg(Bin, [int16, int32, string, string, - string]), - debug1(Debug, "port program pid = ~w~n", - [ProgPid]), - {ok, #st{port = Port, - proxylsport = ProxyLLPort, - progpid = ProgPid, - debug = Debug, - compvsn = CompVsn, - libvsn = LibVsn, - ciphers = Ciphers}}; - {'EXIT', Port, Reason} -> - {stop, Reason} - end; - {'EXIT', Reason} -> - {stop, Reason} - end. - -%% -%% transport_accept -%% -handle_call({transport_accept, Broker, ListenFd, Flags}, From, St) -> - debug(St, "transport_accept: broker = ~w, listenfd = ~w~n", - [Broker, ListenFd]), - case get_by_fd(ListenFd, St#st.cons) of - {ok, {ListenFd, _, _}} -> - send_cmd(St#st.port, ?TRANSPORT_ACCEPT, [int32(ListenFd), Flags, 0]), - PAccepts = add({ListenFd, Broker, From}, St#st.paccepts), - %% - %% We reply when we get TRANSPORT_ACCEPT_REP or ASYNC_ACCEPT_ERR - %% - {noreply, St#st{paccepts = PAccepts}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% ssl_accept -%% -handle_call({ssl_accept, Fd, Flags}, From, St) -> - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} = _Rep -> - send_cmd(St#st.port, ?SSL_ACCEPT, [int32(Fd), Flags, 0]), - %% We reply when we get SSL_ACCEPT_REP or ASYNC_ACCEPT_ERR - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% version -%% -handle_call(ciphers, From, St) -> - debug(St, "ciphers: from = ~w~n", [From]), - {reply, {ok, St#st.ciphers}, St}; - -%% -%% connect -%% -handle_call({connect, Broker, LIP, LPort, FIP, FPort, Flags}, From, St) -> - debug(St, "connect: broker = ~w, ip = ~w, " - "sport = ~w~n", [Broker, FIP, FPort]), - Port = St#st.port, - LIPStr = ip_to_string(LIP), - FIPStr = ip_to_string(FIP), - IntRef = new_intref(St), - send_cmd(Port, ?CONNECT, [int32(IntRef), - int16(LPort), LIPStr, 0, - int16(FPort), FIPStr, 0, - Flags, 0]), - Cons = add({{intref, IntRef}, Broker, From}, St#st.cons), - %% We reply when we have got CONNECT_SYNC_ERR, or CONNECT_WAIT - %% and CONNECT_REP, or CONNECT_ERR. - {noreply, St#st{cons = Cons, intref = IntRef}}; - -%% -%% connection_info -%% -handle_call({connection_info, Broker, Fd}, From, St) -> - debug(St, "connection_info: broker = ~w, fd = ~w~n", - [Broker, Fd]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?GETCONNINFO, [int32(Fd)]), - %% We reply when we get GETCONNINFO_REP or GETCONNINFO_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% close -%% -handle_call({close, Broker, Fd}, _From, St) -> - debug(St, "close: broker = ~w, fd = ~w~n", - [Broker, Fd]), - #st{port = Port, cons = Cons0, paccepts = PAccepts0} = St, - case delete_by_fd(Fd, Cons0) of - %% Must match Broker pid; fd may be reused already. - {ok, {Fd, Broker, _}, Cons} -> - send_cmd(Port, ?CLOSE, int32(Fd)), - %% If Fd is a listen socket fd, there might be pending - %% accepts for that fd. - case delete_all_by_fd(Fd, PAccepts0) of - {ok, DelAccepts, RemAccepts} -> - %% Reply {error, closed} to all pending accepts - lists:foreach(fun({_, _, AccFrom}) -> - gen_server:reply(AccFrom, - {error, closed}) - end, DelAccepts), - {reply, ok, - St#st{cons = Cons, paccepts = RemAccepts}}; - _ -> - {reply, ok, St#st{cons = Cons}} - end; - _ -> - {reply, ok, St} - end; - -%% -%% listen -%% -handle_call({listen, Broker, IP, LPort, Flags, BackLog}, From, St) -> - debug(St, "listen: broker = ~w, IP = ~w, " - "sport = ~w~n", [Broker, IP, LPort]), - Port = St#st.port, - IPStr = ip_to_string(IP), - IntRef = new_intref(St), - send_cmd(Port, ?LISTEN, [int32(IntRef), int16(LPort), IPStr, 0, - int16(BackLog), Flags, 0]), - Cons = add({{intref, IntRef}, Broker, From}, St#st.cons), - %% We reply when we have got LISTEN_REP. - {noreply, St#st{cons = Cons, intref = IntRef}}; - -%% -%% peercert -%% -handle_call({peercert, Broker, Fd}, From, St) -> - debug(St, "peercert: broker = ~w, fd = ~w~n", - [Broker, Fd]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?GETPEERCERT, [int32(Fd)]), - %% We reply when we get GETPEERCERT_REP or GETPEERCERT_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - - -%% -%% peername -%% -handle_call({peername, Broker, Fd}, From, St) -> - debug(St, "peername: broker = ~w, fd = ~w~n", - [Broker, Fd]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?GETPEERNAME, [int32(Fd)]), - %% We reply when we get GETPEERNAME_REP or GETPEERNAME_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% proxy join -%% -handle_call({proxy_join, Broker, Fd, LPort}, From, St) -> - debug(St, "proxy_join: broker = ~w, fd = ~w, " - "sport = ~w~n", [Broker, Fd, LPort]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?PROXY_JOIN, [int32(Fd), - int16(LPort)]), - %% We reply when we get PROXY_JOIN_REP, or PROXY_JOIN_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% seed -%% -handle_call({seed, Data}, _From, St) when is_binary(Data) -> - send_cmd(St#st.port, ?SET_SEED, [int32(byte_size(Data)), Data]), - {reply, ok, St}; - -handle_call({seed, Data}, From, St) -> - case catch list_to_binary(Data) of - {'EXIT', _} -> - {reply, {error, edata}, St}; - Bin -> - handle_call({seed, Bin}, From, St) - end; - -%% -%% setnodelay -%% -handle_call({setnodelay, Broker, Fd, Boolean}, From, St) -> - debug(St, "setnodelay: broker = ~w, fd = ~w, " - "boolean = ~w~n", [Broker, Fd, Boolean]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - Val = if Boolean == true -> 1; true -> 0 end, - send_cmd(St#st.port, ?SET_SOCK_OPT, - [int32(Fd), ?SET_TCP_NODELAY, Val]), - %% We reply when we get IOCTL_OK or IOCTL_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% sockname -%% -handle_call({sockname, Broker, Fd}, From, St) -> - debug(St, "sockname: broker = ~w, fd = ~w~n", - [Broker, Fd]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?GETSOCKNAME, [int32(Fd)]), - %% We reply when we get GETSOCKNAME_REP or GETSOCKNAME_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% version -%% -handle_call(version, From, St) -> - debug(St, "version: from = ~w~n", [From]), - {reply, {ok, {St#st.compvsn, St#st.libvsn}}, St}; - -%% -%% dump -%% -handle_call({dump, Broker}, _From, St) -> - debug(St, "dump: broker = ~w", [Broker]), - Port = St#st.port, - send_cmd(Port, ?DUMP_CMD, []), - {reply, ok, St}; - -%% -%% set_debug -%% -handle_call({set_debug, Bool, Broker}, _From, St) -> - debug(St, "set_debug: broker = ~w", [Broker]), - Value = case Bool of - true -> - 1; - false -> - 0 - end, - Port = St#st.port, - send_cmd(Port, ?DEBUG_CMD, [Value]), - {reply, ok, St}; - -%% -%% set_debugmsg -%% -handle_call({set_debugmsg, Bool, Broker}, _From, St) -> - debug(St, "set_debugmsg: broker = ~w", [Broker]), - Value = case Bool of - true -> - 1; - false -> - 0 - end, - Port = St#st.port, - send_cmd(Port, ?DEBUGMSG_CMD, [Value]), - {reply, ok, St}; - -handle_call(Request, _From, St) -> - debug(St, "unexpected call: ~w~n", [Request]), - Reply = {error, {badcall, Request}}, - {reply, Reply, St}. - -%% -%% handle_cast(Msg, St) -%% - - -handle_cast(Msg, St) -> - debug(St, "unexpected cast: ~w~n", [Msg]), - {noreply, St}. - -%% -%% handle_info(Info, St) -%% - -%% Data from port -%% -handle_info({Port, {data, Bin}}, - #st{cons = StCons, paccepts = Paccepts, - port = Port, proxylsport = Proxylsport} = St) - when is_binary(Bin) -> - %% io:format("++++ ssl_server got from port: ~w~n", [Bin]), - <<OpCode:8, _/binary>> = Bin, - case OpCode of - %% - %% transport_accept - %% - ?TRANSPORT_ACCEPT_ERR when byte_size(Bin) >= 5 -> - {ListenFd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "transport_accept_err: listenfd = ~w, " - "reason = ~w~n", [ListenFd, Reason]), - case delete_last_by_fd(ListenFd, Paccepts) of - {ok, {_, _, From}, PAccepts} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{paccepts = PAccepts}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?TRANSPORT_ACCEPT_REP when byte_size(Bin) >= 9 -> - {ListenFd, Fd} = decode_msg(Bin, [int32, int32]), - debug(St, "transport_accept_rep: listenfd = ~w, " - "fd = ~w~n", [ListenFd, Fd]), - case delete_last_by_fd(ListenFd, Paccepts) of - {ok, {_, Broker, From}, PAccepts} -> - Reply = {ok, Fd, Proxylsport}, - gen_server:reply(From, Reply), - debug(St, "transport_accept_rep: From = ~w\n", [From]), - Cons = add({Fd, Broker, From}, StCons), - {noreply, St#st{cons = Cons, paccepts = PAccepts}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% ssl_accept - %% - ?SSL_ACCEPT_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "ssl_accept_err: listenfd = ~w, " - "reason = ~w~n", [Fd, Reason]), - %% JC: remove this? - case delete_last_by_fd(Fd, StCons) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?SSL_ACCEPT_REP when byte_size(Bin) >= 5 -> - Fd = decode_msg(Bin, [int32]), - debug(St, "ssl_accept_rep: Fd = ~w\n", [Fd]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, ok), - {noreply, St#st{cons = Cons}}; - _ -> - {noreply, St} - end; - - %% - %% connect - %% - ?CONNECT_SYNC_ERR when byte_size(Bin) >= 5 -> - {IntRef, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "connect_sync_err: intref = ~w, " - "reason = ~w~n", [IntRef, Reason]), - case delete_by_intref(IntRef, StCons) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - {noreply, St} - end; - ?CONNECT_WAIT when byte_size(Bin) >= 9 -> - {IntRef, Fd} = decode_msg(Bin, [int32, int32]), - debug(St, "connect_wait: intref = ~w, " - "fd = ~w~n", [IntRef, Fd]), - case replace_fd_by_intref(IntRef, StCons, Fd) of - {ok, _, Cons} -> - %% We reply when we get CONNECT_REP or CONNECT_ERR - {noreply, St#st{cons = Cons}}; - _Other -> - %% We have a new Fd which must be closed - send_cmd(Port, ?CLOSE, int32(Fd)), - {noreply, St} - end; - ?CONNECT_REP when byte_size(Bin) >= 5 -> - %% after CONNECT_WAIT - Fd = decode_msg(Bin, [int32]), - debug(St, "connect_rep: fd = ~w~n", [Fd]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, Fd, Proxylsport}), - {noreply, St#st{cons = Cons}}; - _Other -> - {noreply, St} - end; - ?CONNECT_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "connect_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case delete_by_fd(Fd, StCons) of - {ok, {_, _, From}, Cons} -> - %% Fd not yet published - hence close ourselves - send_cmd(Port, ?CLOSE, int32(Fd)), - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% connection_info - %% - ?GETCONNINFO_REP when byte_size(Bin) >= 5 -> - {Fd, Protocol, Cipher} = decode_msg(Bin, [int32, string, string]), - debug(St, "connection_info_rep: fd = ~w, " - "protcol = ~p, ip = ~p~n", [Fd, Protocol, Cipher]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, {protocol_name(Protocol), - Cipher}}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?GETCONNINFO_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "connection_info_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% listen - %% - ?LISTEN_SYNC_ERR when byte_size(Bin) >= 5 -> - {IntRef, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "listen_sync_err: intref = ~w, " - "reason = ~w~n", [IntRef, Reason]), - case delete_by_intref(IntRef, StCons) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - {noreply, St} - end; - ?LISTEN_REP when byte_size(Bin) >= 11 -> - {IntRef, ListenFd, LPort} = decode_msg(Bin, [int32, int32, int16]), - debug(St, "listen_rep: intref = ~w, " - "listenfd = ~w, sport = ~w~n", [IntRef, ListenFd, LPort]), - case replace_fd_from_by_intref(IntRef, StCons, ListenFd, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, ListenFd, LPort}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% ListenFd has to be closed. - send_cmd(Port, ?CLOSE, int32(ListenFd)), - {noreply, St} - end; - - %% - %% proxy join - %% - ?PROXY_JOIN_REP when byte_size(Bin) >= 5 -> - Fd = decode_msg(Bin, [int32]), - debug(St, "proxy_join_rep: fd = ~w~n", - [Fd]), - case get_by_fd(Fd, StCons) of - {ok, {_, _, From}} -> - gen_server:reply(From, ok), - {noreply, St}; - _Other -> - %% Already closed - {noreply, St} - end; - ?PROXY_JOIN_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "proxy_join_rep: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case delete_by_fd(Fd, StCons) of - {ok, {_, _, From}, Cons} -> - case Reason of - enoproxysocket -> - send_cmd(Port, ?CLOSE, int32(Fd)); - _ -> - ok - %% Must not close Fd since it is published - end, - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% peername - %% - ?GETPEERNAME_REP when byte_size(Bin) >= 5 -> - {Fd, LPort, IPString} = decode_msg(Bin, [int32, int16, string]), - debug(St, "getpeername_rep: fd = ~w, " - "sport = ~w, ip = ~p~n", [Fd, LPort, IPString]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, {IPString, LPort}}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?GETPEERNAME_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "getpeername_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% ioctl - %% - ?IOCTL_OK when byte_size(Bin) >= 5 -> - Fd = decode_msg(Bin, [int32]), - debug(St, "ioctl_ok: fd = ~w~n", - [Fd]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, ok), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?IOCTL_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "ioctl_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% sockname - %% - ?GETSOCKNAME_REP when byte_size(Bin) >= 5 -> - {Fd, LPort, IPString} = decode_msg(Bin, [int32, int16, string]), - debug(St, "getsockname_rep: fd = ~w, " - "sport = ~w, ip = ~p~n", [Fd, LPort, IPString]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, {IPString, LPort}}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?GETSOCKNAME_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "getsockname_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% peercert - %% - ?GETPEERCERT_REP when byte_size(Bin) >= 5 -> - {Fd, Cert} = decode_msg(Bin, [int32, bin]), - debug(St, "getpeercert_rep: fd = ~w~n", [Fd]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, Cert}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?GETPEERCERT_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "getpeercert_err: fd = ~w, reason = ~w~n", - [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end - end; - -%% -%% EXIT -%% -handle_info({'EXIT', Pid, Reason}, St) when is_pid(Pid) -> - debug(St, "exit pid = ~w, " - "reason = ~w~n", [Pid, Reason]), - case delete_by_pid(Pid, St#st.cons) of - {ok, {{intref, _}, Pid, _}, Cons} -> - {noreply, St#st{cons = Cons}}; - {ok, {Fd, Pid, _}, Cons} -> - send_cmd(St#st.port, ?CLOSE, int32(Fd)), - %% If Fd is a listen socket fd, there might be pending - %% accepts for that fd. - case delete_all_by_fd(Fd, St#st.paccepts) of - {ok, DelAccepts, RemAccepts} -> - %% Reply {error, closed} to all pending accepts. - lists:foreach(fun({_, _, From}) -> - gen_server:reply(From, - {error, closed}) - end, DelAccepts), - {noreply, - St#st{cons = Cons, paccepts = RemAccepts}}; - _ -> - {noreply, St#st{cons = Cons}} - end; - _ -> - case delete_by_pid(Pid, St#st.paccepts) of - {ok, {ListenFd, _, _}, PAccepts} -> - %% decrement ref count in port program - send_cmd(St#st.port, ?NOACCEPT, int32(ListenFd)), - {noreply, St#st{paccepts = PAccepts}}; - _ -> - {noreply, St} - end - end; - -%% -%% 'badsig' means bad message to port. Port program is unaffected. -%% -handle_info({'EXIT', Port, badsig}, #st{port = Port} = St) -> - debug(St, "badsig!!!~n", []), - {noreply, St}; - -handle_info({'EXIT', Port, Reason}, #st{port = Port} = St) -> - {stop, Reason, St}; - -handle_info(Info, St) -> - debug(St, "unexpected info: ~w~n", [Info]), - {noreply, St}. - -%% -%% terminate(Reason, St) -> any -%% -terminate(_Reason, _St) -> - ok. - -%% -%% code_change(OldVsn, St, Extra) -> {ok, NSt} -%% -code_change(_OldVsn, St, _Extra) -> - {ok, St}. - -%%%---------------------------------------------------------------------- -%%% Internal functions -%%%---------------------------------------------------------------------- - -%% -%% Send binary command to sock -%% -send_cmd(Port, Cmd, Args) -> - Port ! {self(), {command, [Cmd| Args]}}. - -%% -%% add(Descr, Cons) -> NCons -%% -add(D, L) -> - [D| L]. - -%% -%% get_by_fd(Fd, Cons) -> {ok, Descr} | not_found -%% -get_by_fd(Fd, Cons) -> - get_by_pos(Fd, 1, Cons). - -%% -%% delete_by_fd(Fd, Cons) -> {ok, OldDesc, NewCons} | not_found. -%% -delete_by_fd(Fd, Cons) -> - delete_by_pos(Fd, 1, Cons). - -%% -%% delete_all_by_fd(Fd, Cons) -> {ok, DelCons, RemCons} | not_found. -%% -delete_all_by_fd(Fd, Cons) -> - delete_all_by_pos(Fd, 1, Cons). - -%% -%% delete_by_intref(IntRef, Cons) -> {ok, OldDesc, NewCons} | not_found. -%% -delete_by_intref(IntRef, Cons) -> - delete_by_pos({intref, IntRef}, 1, Cons). - -%% -%% delete_by_pid(Pid, Cons) -> {ok, OldDesc, NewCons} | not_found. -%% -delete_by_pid(Pid, Cons) -> - delete_by_pos(Pid, 2, Cons). - -%% -%% delete_last_by_fd(Fd, Cons) -> {ok, OldDesc, NCons} | not_found -%% -delete_last_by_fd(Fd, Cons) -> - case dlbf(Fd, Cons) of - {X, L} -> - {ok, X, L}; - _Other -> - not_found - end. - -dlbf(Fd, [H]) -> - last_elem(Fd, H, []); -dlbf(Fd, [H|T]) -> - case dlbf(Fd, T) of - {X, L} -> - {X, [H|L]}; - L -> - last_elem(Fd, H, L) - end; -dlbf(_Fd, []) -> - []. - -last_elem(Fd, H, L) when element(1, H) == Fd -> - {H, L}; -last_elem(_, H, L) -> - [H|L]. - - -%% -%% replace_from_by_fd(Fd, Cons, From) -> {ok, OldDesc, NewList} | not_found -%% -replace_from_by_fd(Fd, Cons, From) -> - replace_posn_by_pos(Fd, 1, Cons, [{From, 3}]). - -%% -%% replace_fd_by_intref(IntRef, Cons, Fd) -> {ok, OldDesc, NewList} | not_f. -%% -replace_fd_by_intref(IntRef, Cons, Fd) -> - replace_posn_by_pos({intref, IntRef}, 1, Cons, [{Fd, 1}]). - -%% -%% replace_fd_from_by_intref(IntRef, Cons, NFd, From) -> -%% {ok, OldDesc, NewList} | not_found -%% -replace_fd_from_by_intref(IntRef, Cons, NFd, From) -> - replace_posn_by_pos({intref, IntRef}, 1, Cons, [{NFd, 1}, {From, 3}]). - - -%% -%% All *_by_pos functions -%% - -get_by_pos(Key, Pos, [H|_]) when element(Pos, H) == Key -> - {ok, H}; -get_by_pos(Key, Pos, [_|T]) -> - get_by_pos(Key, Pos, T); -get_by_pos(_, _, []) -> - not_found. - -delete_by_pos(Key, Pos, Cons) -> - case delete_by_pos1(Key, Pos, {not_found, Cons}) of - {not_found, _} -> - not_found; - {ODesc, NCons} -> - {ok, ODesc, NCons} - end. -delete_by_pos1(Key, Pos, {_R, [H|T]}) when element(Pos, H) == Key -> - {H, T}; -delete_by_pos1(Key, Pos, {R, [H|T]}) -> - {R0, T0} = delete_by_pos1(Key, Pos, {R, T}), - {R0, [H| T0]}; -delete_by_pos1(_, _, {R, []}) -> - {R, []}. - -delete_all_by_pos(Key, Pos, Cons) -> - case lists:foldl(fun(H, {Ds, Rs}) when element(Pos, H) == Key -> - {[H|Ds], Rs}; - (H, {Ds, Rs}) -> - {Ds, [H|Rs]} - end, {[], []}, Cons) of - {[], _} -> - not_found; - {DelCons, RemCons} -> - {ok, DelCons, RemCons} - end. - -replace_posn_by_pos(Key, Pos, Cons, Repls) -> - replace_posn_by_pos1(Key, Pos, Cons, Repls, []). - -replace_posn_by_pos1(Key, Pos, [H0| T], Repls, Acc) - when element(Pos, H0) =:= Key -> - H = lists:foldl(fun({Val, VPos}, Tuple) -> - setelement(VPos, Tuple, Val) - end, H0, Repls), - {ok, H0, lists:reverse(Acc, [H| T])}; -replace_posn_by_pos1(Key, Pos, [H|T], Repls, Acc) -> - replace_posn_by_pos1(Key, Pos, T, Repls, [H| Acc]); -replace_posn_by_pos1(_, _, [], _, _) -> - not_found. - -%% -%% Binary/integer conversions -%% -int16(I) -> - %%[(I bsr 8) band 255, I band 255]. - <<I:16>>. - -int32(I) -> - %% [(I bsr 24) band 255, - %% (I bsr 16) band 255, - %% (I bsr 8) band 255, - %% I band 255]. - <<I:32>>. - -%% decode_msg(Bin, Format) -> Tuple | integer() | atom() | string() | -%% list of binaries() -%% -%% Decode message from binary -%% Format = [spec()] -%% spec() = int16 | int32 | string | atom | bin | bins -%% -%% Notice: The first byte (op code) of the binary message is removed. -%% Notice: bins returns a *list* of binaries. -%% -decode_msg(<<_, Bin/binary>>, Format) -> - Dec = dec(Format, Bin), - case Dec of - [Dec1] -> Dec1; - _ -> list_to_tuple(Dec) - end. - -dec([], _) -> - []; -dec([int16| F], <<N:16, Bin/binary>>) -> - [N| dec(F, Bin)]; -dec([int32| F], <<N:32, Bin/binary>>) -> - [N| dec(F, Bin)]; -dec([string| F], Bin0) -> - {Cs, Bin1} = dec_string(Bin0), - [Cs| dec(F, Bin1)]; -dec([atom|F], Bin0) -> - {Cs, Bin1} = dec_string(Bin0), - [list_to_atom(Cs)| dec(F, Bin1)]; - -dec([bin|F], Bin) -> - {Bin1, Bin2} = dec_bin(Bin), - [Bin1| dec(F, Bin2)]. - -%% NOTE: This clause is not actually used yet. -%% dec([bins|F], <<N:32, Bin0/binary>>) -> -%% {Bins, Bin1} = dec_bins(N, Bin0), -%% [Bins| dec(F, Bin1)]. - -dec_string(Bin) -> - dec_string(Bin, []). - -dec_string(<<0, Bin/binary>>, RCs) -> - {lists:reverse(RCs), Bin}; -dec_string(<<C, Bin/binary>>, RCs) -> - dec_string(Bin, [C| RCs]). - -dec_bin(<<L:32, Bin0/binary>>) -> - <<Bin1:L/binary, Bin2/binary>> = Bin0, - {Bin1, Bin2}. - -%% dec_bins(N, Bin) -> -%% dec_bins(N, Bin, []). - -%% dec_bins(0, Bin, Acc) -> -%% {lists:reverse(Acc), Bin}; -%% dec_bins(N, Bin0, Acc) when N > 0 -> -%% {Bin1, Bin2} = dec_bin(Bin0), -%% dec_bins(N - 1, Bin2, [Bin1| Acc]). - -%% -%% new_intref -%% -new_intref(St) -> - (St#st.intref + 1) band 16#ffffffff. - -%% -%% {Program, Flags} = mk_cmd_line(DefaultProgram) -%% -mk_cmd_line(Default) -> - {port_program(Default), - lists:flatten([debug_flag(), " ", debug_port_flag(), " ", - debugdir_flag(), " ", - msgdebug_flag(), " ", proxylsport_flag(), " ", - proxybacklog_flag(), " ", ephemeral_rsa_flag(), " ", - ephemeral_dh_flag(), " ", - protocol_version_flag(), " "])}. - -port_program(Default) -> - case application:get_env(ssl, port_program) of - {ok, Program} when is_list(Program) -> - Program; - _Other -> - Default - end. - -%% -%% As this server may be started by the distribution, it is not safe to assume -%% a working code server, neither a working file server. -%% I try to utilize the most primitive interfaces available to determine -%% the directory of the port_program. -%% -find_priv_bin() -> - PrivDir = case (catch code:priv_dir(ssl)) of - {'EXIT', _} -> - %% Code server probably not startet yet - {ok, P} = erl_prim_loader:get_path(), - ModuleFile = atom_to_list(?MODULE) ++ extension(), - Pd = (catch lists:foldl - (fun(X,Acc) -> - M = filename:join([X, ModuleFile]), - %% The file server probably not started - %% either, has to use raw interface. - case file:raw_read_file_info(M) of - {ok,_} -> - %% Found our own module in the - %% path, lets bail out with - %% the priv_dir of this directory - Y = filename:split(X), - throw(filename:join - (lists:sublist - (Y,length(Y) - 1) - ++ ["priv"])); - _ -> - Acc - end - end, - false,P)), - case Pd of - false -> - exit(ssl_priv_dir_indeterminate); - _ -> - Pd - end; - Dir -> - Dir - end, - filename:join([PrivDir, "bin"]). - -extension() -> - %% erlang:info(machine) returns machine name as text in all uppercase - "." ++ string:to_lower(erlang:system_info(machine)). - -debug_flag() -> - case os:getenv("ERL_SSL_DEBUG") of - false -> - get_env(debug, "-d"); - _ -> - "-d" - end. - -debug_port_flag() -> - case os:getenv("ERL_SSL_DEBUGPORT") of - false -> - get_env(debug, "-d"); - _ -> - "-d" - end. - -msgdebug_flag() -> - case os:getenv("ERL_SSL_MSGDEBUG") of - false -> - get_env(msgdebug, "-dm"); - _ -> - "-dm" - end. - -proxylsport_flag() -> - case application:get_env(ssl, proxylsport) of - {ok, PortNum} -> - "-pp " ++ integer_to_list(PortNum); - _Other -> - "" - end. - -proxybacklog_flag() -> - case application:get_env(ssl, proxylsbacklog) of - {ok, Size} -> - "-pb " ++ integer_to_list(Size); - _Other -> - "" - end. - -debugdir_flag() -> - case os:getenv("ERL_SSL_DEBUG") of - false -> - case application:get_env(ssl, debugdir) of - {ok, Dir} when is_list(Dir) -> - "-dd " ++ Dir; - _Other -> - "" - end; - _ -> - "-dd ./" - end. - -ephemeral_rsa_flag() -> - case application:get_env(ssl, ephemeral_rsa) of - {ok, true} -> - "-ersa "; - _Other -> - "" - end. - -ephemeral_dh_flag() -> - case application:get_env(ssl, ephemeral_dh) of - {ok, true} -> - "-edh "; - _Other -> - "" - end. - -protocol_version_flag() -> - case application:get_env(ssl, protocol_version) of - {ok, []} -> - ""; - {ok, Vsns} when is_list(Vsns) -> - case transform_vsns(Vsns) of - N when (N > 0) -> - "-pv " ++ integer_to_list(N); - _ -> - "" - end; - _Other -> - "" - end. - -transform_vsns(Vsns) -> - transform_vsns(Vsns, 0). - -transform_vsns([sslv2| Vsns], I) -> - transform_vsns(Vsns, I bor ?SSLv2); -transform_vsns([sslv3| Vsns], I) -> - transform_vsns(Vsns, I bor ?SSLv3); -transform_vsns([tlsv1| Vsns], I) -> - transform_vsns(Vsns, I bor ?TLSv1); -transform_vsns([_ | Vsns], I) -> - transform_vsns(Vsns, I); -transform_vsns([], I) -> - I. - -protocol_name("SSLv2") -> sslv2; -protocol_name("SSLv3") -> sslv3; -protocol_name("TLSv1") -> tlsv1. - -get_env(Key, Val) -> - case application:get_env(ssl, Key) of - {ok, true} -> - Val; - _Other -> - "" - end. - -ip_to_string({A,B,C,D}) -> - [integer_to_list(A),$.,integer_to_list(B),$., - integer_to_list(C),$.,integer_to_list(D)]. - -debug(St, Format, Args) -> - debug1(St#st.debug, Format, Args). - -debug1(true, Format0, Args) -> - {_MS, S, MiS} = erlang:now(), - Secs = S rem 100, - MiSecs = MiS div 1000, - Format = "++++ ~3..0w:~3..0w ssl_server (~w): " ++ Format0, - io:format(Format, [Secs, MiSecs, self()| Args]); -debug1(_, _, _) -> - ok. diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl index 316ed8a4e9..cb10b1362a 100644 --- a/lib/ssl/src/ssl_sup.erl +++ b/lib/ssl/src/ssl_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-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 @@ -24,7 +24,7 @@ -behaviour(supervisor). %% API --export([start_link/0]). +-export([start_link/0, manager_opts/0]). %% Supervisor callback -export([init/1]). @@ -51,17 +51,32 @@ init([]) -> %% Does not start any port programs so it does matter %% so much if it is not used! - Child2 = {ssl_broker_sup, {ssl_broker_sup, start_link, []}, - permanent, 2000, supervisor, [ssl_broker_sup]}, + %% Child2 = {ssl_broker_sup, {ssl_broker_sup, start_link, []}, + %% permanent, 2000, supervisor, [ssl_broker_sup]}, %% New ssl SessionCertManager = session_and_cert_manager_child_spec(), ConnetionManager = connection_manager_child_spec(), - {ok, {{one_for_all, 10, 3600}, [Child2, SessionCertManager, - ConnetionManager]}}. + {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager]}}. + +manager_opts() -> + CbOpts = case application:get_env(ssl, session_cb) of + {ok, Cb} when is_atom(Cb) -> + InitArgs = session_cb_init_args(), + [{session_cb, Cb}, {session_cb_init_args, InitArgs}]; + _ -> + [] + end, + case application:get_env(ssl, session_lifetime) of + {ok, Time} when is_integer(Time) -> + [{session_lifetime, Time}| CbOpts]; + _ -> + CbOpts + end. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -86,21 +101,6 @@ connection_manager_child_spec() -> {Name, StartFunc, Restart, Shutdown, Type, Modules}. -manager_opts() -> - CbOpts = case application:get_env(ssl, session_cb) of - {ok, Cb} when is_atom(Cb) -> - InitArgs = session_cb_init_args(), - [{session_cb, Cb}, {session_cb_init_args, InitArgs}]; - _ -> - [] - end, - case application:get_env(ssl, session_lifetime) of - {ok, Time} when is_integer(Time) -> - [{session_lifetime, Time}| CbOpts]; - _ -> - CbOpts - end. - session_cb_init_args() -> case application:get_env(ssl, session_cb_init_args) of {ok, Args} when is_list(Args) -> diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl new file mode 100644 index 0000000000..d63eada571 --- /dev/null +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -0,0 +1,325 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-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% +%% +-module(ssl_tls_dist_proxy). + + +-export([listen/1, accept/1, connect/2, get_remote_id/2]). +-export([init/1, start_link/0, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3, ssl_options/2]). + +-include_lib("kernel/include/net_address.hrl"). + +-record(state, + {listen, + accept_loop + }). + +-define(PPRE, 4). +-define(PPOST, 4). + + +%%==================================================================== +%% Internal application API +%%==================================================================== + +listen(Name) -> + gen_server:call(?MODULE, {listen, Name}, infinity). + +accept(Listen) -> + gen_server:call(?MODULE, {accept, Listen}, infinity). + +connect(Ip, Port) -> + gen_server:call(?MODULE, {connect, Ip, Port}, infinity). + +get_remote_id(Socket, Node) -> + gen_server:call(?MODULE, {get_remote_id, {Socket,Node}}, infinity). + +%%==================================================================== +%% gen_server callbacks +%%==================================================================== + +start_link() -> + gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). + +init([]) -> + process_flag(priority, max), + {ok, #state{}}. + +handle_call({listen, Name}, _From, State) -> + case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}]) of + {ok, Socket} -> + {ok, World} = gen_tcp:listen(0, [{active, false}, binary, {packet,?PPRE}]), + TcpAddress = get_tcp_address(Socket), + WorldTcpAddress = get_tcp_address(World), + {_,Port} = WorldTcpAddress#net_address.address, + {ok, Creation} = erl_epmd:register_node(Name, Port), + {reply, {ok, {Socket, TcpAddress, Creation}}, + State#state{listen={Socket, World}}}; + Error -> + {reply, Error, State} + end; + +handle_call({accept, Listen}, {From, _}, State = #state{listen={_, World}}) -> + Self = self(), + ErtsPid = spawn_link(fun() -> accept_loop(Self, erts, Listen, From) end), + WorldPid = spawn_link(fun() -> accept_loop(Self, world, World, Listen) end), + {reply, ErtsPid, State#state{accept_loop={ErtsPid, WorldPid}}}; + +handle_call({connect, Ip, Port}, {From, _}, State) -> + Me = self(), + Pid = spawn_link(fun() -> setup_proxy(Ip, Port, Me) end), + receive + {Pid, go_ahead, LPort} -> + Res = {ok, Socket} = try_connect(LPort), + ok = gen_tcp:controlling_process(Socket, From), + flush_old_controller(From, Socket), + {reply, Res, State}; + {Pid, Error} -> + {reply, Error, State} + end; + +handle_call({get_remote_id, {Socket,_Node}}, _From, State) -> + Address = get_tcp_address(Socket), + {reply, Address, State}; + +handle_call(_What, _From, State) -> + {reply, ok, State}. + +handle_cast(_What, State) -> + {noreply, State}. + +handle_info(_What, State) -> + {noreply, State}. + +terminate(_Reason, _St) -> + ok. + +code_change(_OldVsn, St, _Extra) -> + {ok, St}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +get_tcp_address(Socket) -> + {ok, Address} = inet:sockname(Socket), + {ok, Host} = inet:gethostname(), + #net_address{ + address = Address, + host = Host, + protocol = proxy, + family = inet + }. + +accept_loop(Proxy, erts = Type, Listen, Extra) -> + process_flag(priority, max), + case gen_tcp:accept(Listen) of + {ok, Socket} -> + Extra ! {accept,self(),Socket,inet,proxy}, + receive + {_Kernel, controller, Pid} -> + ok = gen_tcp:controlling_process(Socket, Pid), + flush_old_controller(Pid, Socket), + Pid ! {self(), controller}; + {_Kernel, unsupported_protocol} -> + exit(unsupported_protocol) + end; + Error -> + exit(Error) + end, + accept_loop(Proxy, Type, Listen, Extra); + +accept_loop(Proxy, world = Type, Listen, Extra) -> + process_flag(priority, max), + case gen_tcp:accept(Listen) of + {ok, Socket} -> + Opts = get_ssl_options(server), + case ssl:ssl_accept(Socket, Opts) of + {ok, SslSocket} -> + PairHandler = + spawn_link(fun() -> + setup_connection(SslSocket, Extra) + end), + ok = ssl:controlling_process(SslSocket, PairHandler), + flush_old_controller(PairHandler, SslSocket); + _ -> + gen_tcp:close(Socket) + end; + Error -> + exit(Error) + end, + accept_loop(Proxy, Type, Listen, Extra). + +try_connect(Port) -> + case gen_tcp:connect({127,0,0,1}, Port, [{active, false}, {packet,?PPRE}]) of + R = {ok, _S} -> + R; + {error, _R} -> + try_connect(Port) + end. + +setup_proxy(Ip, Port, Parent) -> + process_flag(trap_exit, true), + Opts = get_ssl_options(client), + case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}] ++ Opts) of + {ok, World} -> + {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, binary, {packet,?PPRE}]), + #net_address{address={_,LPort}} = get_tcp_address(ErtsL), + Parent ! {self(), go_ahead, LPort}, + case gen_tcp:accept(ErtsL) of + {ok, Erts} -> + %% gen_tcp:close(ErtsL), + loop_conn_setup(World, Erts); + Err -> + Parent ! {self(), Err} + end; + Err -> + Parent ! {self(), Err} + end. + +setup_connection(World, ErtsListen) -> + process_flag(trap_exit, true), + TcpAddress = get_tcp_address(ErtsListen), + {_Addr,Port} = TcpAddress#net_address.address, + {ok, Erts} = gen_tcp:connect({127,0,0,1}, Port, [{active, true}, binary, {packet,?PPRE}]), + ssl:setopts(World, [{active,true}, {packet,?PPRE}]), + loop_conn_setup(World, Erts). + +loop_conn_setup(World, Erts) -> + receive + {ssl, World, Data = <<$a, _/binary>>} -> + gen_tcp:send(Erts, Data), + ssl:setopts(World, [{packet,?PPOST}]), + inet:setopts(Erts, [{packet,?PPOST}]), + loop_conn(World, Erts); + {tcp, Erts, Data = <<$a, _/binary>>} -> + ssl:send(World, Data), + ssl:setopts(World, [{packet,?PPOST}]), + inet:setopts(Erts, [{packet,?PPOST}]), + loop_conn(World, Erts); + {ssl, World, Data = <<_, _/binary>>} -> + gen_tcp:send(Erts, Data), + loop_conn_setup(World, Erts); + {tcp, Erts, Data = <<_, _/binary>>} -> + ssl:send(World, Data), + loop_conn_setup(World, Erts); + {ssl, World, Data} -> + gen_tcp:send(Erts, Data), + loop_conn_setup(World, Erts); + {tcp, Erts, Data} -> + ssl:send(World, Data), + loop_conn_setup(World, Erts) + end. + +loop_conn(World, Erts) -> + receive + {ssl, World, Data} -> + gen_tcp:send(Erts, Data), + loop_conn(World, Erts); + {tcp, Erts, Data} -> + ssl:send(World, Data), + loop_conn(World, Erts); + {tcp_closed, Erts} -> + ssl:close(World); + {ssl_closed, World} -> + gen_tcp:close(Erts) + end. + +get_ssl_options(Type) -> + case init:get_argument(ssl_dist_opt) of + {ok, Args} -> + [{erl_dist, true} | ssl_options(Type, lists:append(Args))]; + _ -> + [{erl_dist, true}] + end. + +ssl_options(_,[]) -> + []; +ssl_options(server, ["client_" ++ _, _Value |T]) -> + ssl_options(server,T); +ssl_options(client, ["server_" ++ _, _Value|T]) -> + ssl_options(client,T); +ssl_options(server, ["server_certfile", Value|T]) -> + [{certfile, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_certfile", Value | T]) -> + [{certfile, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_cacertfile", Value|T]) -> + [{cacertfile, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_cacertfile", Value|T]) -> + [{cacertfile, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_keyfile", Value|T]) -> + [{keyfile, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_keyfile", Value|T]) -> + [{keyfile, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_password", Value|T]) -> + [{password, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_password", Value|T]) -> + [{password, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_verify", Value|T]) -> + [{verify, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_verify", Value|T]) -> + [{verify, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_reuse_sessions", Value|T]) -> + [{reuse_sessions, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_reuse_sessions", Value|T]) -> + [{reuse_sessions, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_secure_renegotiate", Value|T]) -> + [{secure_renegotiate, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_secure_renegotiate", Value|T]) -> + [{secure_renegotiate, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_depth", Value|T]) -> + [{depth, list_to_integer(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_depth", Value|T]) -> + [{depth, list_to_integer(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_hibernate_after", Value|T]) -> + [{hibernate_after, list_to_integer(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_hibernate_after", Value|T]) -> + [{hibernate_after, list_to_integer(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_ciphers", Value|T]) -> + [{ciphers, Value} | ssl_options(server,T)]; +ssl_options(client, ["client_ciphers", Value|T]) -> + [{ciphers, Value} | ssl_options(client,T)]; +ssl_options(server, ["server_dhfile", Value|T]) -> + [{dhfile, Value} | ssl_options(server,T)]; +ssl_options(server, ["server_fail_if_no_peer_cert", Value|T]) -> + [{fail_if_no_peer_cert, atomize(Value)} | ssl_options(server,T)]; +ssl_options(_,_) -> + exit(malformed_ssl_dist_opt). + +atomize(List) when is_list(List) -> + list_to_atom(List); +atomize(Atom) when is_atom(Atom) -> + Atom. + +flush_old_controller(Pid, Socket) -> + receive + {tcp, Socket, Data} -> + Pid ! {tcp, Socket, Data}, + flush_old_controller(Pid, Socket); + {tcp_closed, Socket} -> + Pid ! {tcp_closed, Socket}, + flush_old_controller(Pid, Socket); + {ssl, Socket, Data} -> + Pid ! {ssl, Socket, Data}, + flush_old_controller(Pid, Socket); + {ssl_closed, Socket} -> + Pid ! {ssl_closed, Socket}, + flush_old_controller(Pid, Socket) + after 0 -> + ok + end. diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 922abea41b..6b1da63d08 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -39,32 +39,24 @@ MODULES = \ ssl_basic_SUITE \ ssl_handshake_SUITE \ ssl_packet_SUITE \ + ssl_cipher_SUITE \ ssl_payload_SUITE \ ssl_to_openssl_SUITE \ ssl_session_cache_SUITE \ - ssl_test_MACHINE \ - old_ssl_active_SUITE \ - old_ssl_active_once_SUITE \ - old_ssl_passive_SUITE \ - old_ssl_verify_SUITE \ - old_ssl_peer_cert_SUITE \ - old_ssl_misc_SUITE \ - old_ssl_protocol_SUITE \ - old_transport_accept_SUITE \ - old_ssl_dist_SUITE \ + ssl_dist_SUITE \ make_certs\ erl_make_certs ERL_FILES = $(MODULES:%=%.erl) -HRL_FILES = ssl_test_MACHINE.hrl +HRL_FILES = HRL_FILES_SRC = \ - ssl_int.hrl \ ssl_internal.hrl\ ssl_alert.hrl \ ssl_handshake.hrl \ + ssl_cipher.hrl \ ssl_record.hrl HRL_FILES_INC = diff --git a/lib/ssl/test/old_ssl_active_SUITE.erl b/lib/ssl/test/old_ssl_active_SUITE.erl deleted file mode 100644 index 52ff0bcc5d..0000000000 --- a/lib/ssl/test/old_ssl_active_SUITE.erl +++ /dev/null @@ -1,395 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% - -%% --module(old_ssl_active_SUITE). - --export([all/0, suite/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, - cinit_return_chkclose/1, - sinit_return_chkclose/1, - cinit_big_return_chkclose/1, - sinit_big_return_chkclose/1, - cinit_big_echo_chkclose/1, - cinit_huge_echo_chkclose/1, - sinit_big_echo_chkclose/1, - cinit_few_echo_chkclose/1, - cinit_many_echo_chkclose/1, - cinit_cnocert/1 - ]). - --import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). - --include_lib("test_server/include/test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - --define(MANYCONNS, ssl_test_MACHINE:many_conns()). - -init_per_testcase(_Case, Config) -> - WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [cinit_return_chkclose, sinit_return_chkclose, - cinit_big_return_chkclose, sinit_big_return_chkclose, - cinit_big_echo_chkclose, cinit_huge_echo_chkclose, - sinit_big_echo_chkclose, cinit_few_echo_chkclose, - cinit_many_echo_chkclose, cinit_cnocert]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(doc) -> - "Want to se what Config contains, and record the number of available " - "file descriptors"; -init_per_suite(suite) -> - []; -init_per_suite(Config) -> - io:format("Config: ~p~n", [Config]), - case os:type() of - {unix, _} -> - ?line io:format("Max fd value: ~s", [os:cmd("ulimit -n")]); - _ -> - ok - end, - %% XXX Also record: Erlang/SSL version, version of OpenSSL, - %% operating system, version of OTP, Erts, kernel and stdlib. - - %% Check if SSL exists. If this case fails, all other cases are skipped - case catch crypto:start() of - ok -> - application:start(public_key), - case ssl:start() of - ok -> ssl:stop(); - {error, {already_started, _}} -> ssl:stop(); - Error -> ?t:fail({failed_starting_ssl,Error}) - end, - Config; - _Else -> - {skip,"Could not start crypto!"} - end. - -end_per_suite(doc) -> - "This test case has no mission other than closing the conf case"; -end_per_suite(suite) -> - []; -end_per_suite(Config) -> - crypto:stop(), - Config. - -cinit_return_chkclose(doc) -> - "Client sends 1000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -cinit_return_chkclose(suite) -> - []; -cinit_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_return_chkclose(doc) -> - "Server sends 1000 bytes to client, that receives them, sends them " - "back, and closes. Server waits for close. Both have certs."; -sinit_return_chkclose(suite) -> - []; -sinit_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, [{ssl_imp, old}|SsslOpts]}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sslopts, [{ssl_imp, old}|CsslOpts]}, - {connect, {Host, LPort}}, - {recv, DataSize}, {send, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_big_return_chkclose(doc) -> - "Client sends 50000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -cinit_big_return_chkclose(suite) -> - []; -cinit_big_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_big_return_chkclose(doc) -> - "Server sends 50000 bytes to client, that receives them, sends them " - "back, and closes. Server waits for close. Both have certs."; -sinit_big_return_chkclose(suite) -> - []; -sinit_big_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {recv, DataSize}, {send, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_big_echo_chkclose(doc) -> - "Client sends 50000 bytes to server, that echoes them back " - "and closes. Client waits for close. Both have certs."; -cinit_big_echo_chkclose(suite) -> - []; -cinit_big_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_huge_echo_chkclose(doc) -> - "Client sends 500000 bytes to server, that echoes them back " - "and closes. Client waits for close. Both have certs."; -cinit_huge_echo_chkclose(suite) -> - []; -cinit_huge_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 500000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_big_echo_chkclose(doc) -> - "Server sends 50000 bytes to client, that echoes them back " - "and closes. Server waits for close. Both have certs."; -sinit_big_echo_chkclose(suite) -> - []; -sinit_big_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {echo, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - - -%% This case is repeated several times. - -cinit_few_echo_chkclose(X) -> cinit_many_echo_chkclose(X, 7). - -cinit_many_echo_chkclose(X) -> cinit_many_echo_chkclose(X, ?MANYCONNS). - -cinit_many_echo_chkclose(doc, _NConns) -> - "N client sends 10000 bytes to server, that echoes them back " - "and closes. Clients wait for close. All have certs."; -cinit_many_echo_chkclose(suite, _NConns) -> - []; -cinit_many_echo_chkclose(Config, NConns) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 10000, LPort = 3456, - Timeout = 80000, - - io:format("~w connections", [NConns]), - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - - -cinit_cnocert(doc) -> - "Client sends 1000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Client has no cert, " - "but server has."; -cinit_cnocert(suite) -> - []; -cinit_cnocert(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3457, - Timeout = 40000, NConns = 1, - - ?line {ok, {_CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - - diff --git a/lib/ssl/test/old_ssl_active_once_SUITE.erl b/lib/ssl/test/old_ssl_active_once_SUITE.erl deleted file mode 100644 index c7beadb301..0000000000 --- a/lib/ssl/test/old_ssl_active_once_SUITE.erl +++ /dev/null @@ -1,417 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-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% -%% - -%% --module(old_ssl_active_once_SUITE). - --export([all/0, suite/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, - server_accept_timeout/1, - cinit_return_chkclose/1, - sinit_return_chkclose/1, - cinit_big_return_chkclose/1, - sinit_big_return_chkclose/1, - cinit_big_echo_chkclose/1, - cinit_huge_echo_chkclose/1, - sinit_big_echo_chkclose/1, - cinit_few_echo_chkclose/1, - cinit_many_echo_chkclose/1, - cinit_cnocert/1 - ]). - --import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). --include_lib("test_server/include/test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - --define(MANYCONNS, ssl_test_MACHINE:many_conns()). - -init_per_testcase(_Case, Config) -> - WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [server_accept_timeout, cinit_return_chkclose, - sinit_return_chkclose, cinit_big_return_chkclose, - sinit_big_return_chkclose, cinit_big_echo_chkclose, - cinit_huge_echo_chkclose, sinit_big_echo_chkclose, - cinit_few_echo_chkclose, cinit_many_echo_chkclose, - cinit_cnocert]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(doc) -> - "Want to se what Config contains."; -init_per_suite(suite) -> - []; -init_per_suite(Config) -> - io:format("Config: ~p~n", [Config]), - - %% Check if SSL exists. If this case fails, all other cases are skipped - case catch crypto:start() of - ok -> - application:start(public_key), - case ssl:start() of - ok -> ssl:stop(); - {error, {already_started, _}} -> ssl:stop(); - Error -> ?t:fail({failed_starting_ssl,Error}) - end, - Config; - _Else -> - {skip,"Could not start crypto"} - end. - -end_per_suite(doc) -> - "This test case has no mission other than closing the conf case"; -end_per_suite(suite) -> - []; -end_per_suite(Config) -> - crypto:stop(), - Config. - -server_accept_timeout(doc) -> - "Server has one pending accept with timeout. Checks that return " - "value is {error, timeout}."; -server_accept_timeout(suite) -> - []; -server_accept_timeout(Config) when list(Config) -> - process_flag(trap_exit, true), - LPort = 3456, - Timeout = 40000, NConns = 1, - AccTimeout = 3000, - - ?line {ok, {_, SsslOpts}} = mk_ssl_cert_opts(Config), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, AccTimeout}, - accept_timeout], - ?line test_server_only(NConns, LCmds, ACmds, Timeout, ?MODULE, - Config). - -cinit_return_chkclose(doc) -> - "Client sends 1000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -cinit_return_chkclose(suite) -> - []; -cinit_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_return_chkclose(doc) -> - "Server sends 1000 bytes to client, that receives them, sends them " - "back, and closes. Server waits for close. Both have certs."; -sinit_return_chkclose(suite) -> - []; -sinit_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {recv, DataSize}, {send, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_big_return_chkclose(doc) -> - "Client sends 50000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -cinit_big_return_chkclose(suite) -> - []; -cinit_big_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - %% Set {active, false} so that accept is passive to begin with. - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {sockopts, [{active, once}]}, % {active, once} here. - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_big_return_chkclose(doc) -> - "Server sends 50000 bytes to client, that receives them, sends them " - "back, and closes. Server waits for close. Both have certs."; -sinit_big_return_chkclose(suite) -> - []; -sinit_big_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {recv, DataSize}, {send, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_big_echo_chkclose(doc) -> - "Client sends 50000 bytes to server, that echoes them back " - "and closes. Client waits for close. Both have certs."; -cinit_big_echo_chkclose(suite) -> - []; -cinit_big_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_huge_echo_chkclose(doc) -> - "Client sends 500000 bytes to server, that echoes them back " - "and closes. Client waits for close. Both have certs."; -cinit_huge_echo_chkclose(suite) -> - []; -cinit_huge_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 500000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_big_echo_chkclose(doc) -> - "Server sends 50000 bytes to client, that echoes them back " - "and closes. Server waits for close. Both have certs."; -sinit_big_echo_chkclose(suite) -> - []; -sinit_big_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {echo, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_few_echo_chkclose(X) -> cinit_many_echo_chkclose(X, 7). - -cinit_many_echo_chkclose(X) -> cinit_many_echo_chkclose(X, ?MANYCONNS). - -cinit_many_echo_chkclose(doc, _NConns) -> - "client send 10000 bytes to server, that echoes them back " - "and closes. Clients wait for close. All have certs."; -cinit_many_echo_chkclose(suite, _NConns) -> - []; -cinit_many_echo_chkclose(Config, NConns) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 10000, LPort = 3456, - Timeout = 80000, - - io:format("~w connections", [NConns]), - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_cnocert(doc) -> - "Client sends 1000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Client has no cert, " - "but server has."; -cinit_cnocert(suite) -> - []; -cinit_cnocert(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3457, - Timeout = 40000, NConns = 1, - - ?line {ok, {_CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - - diff --git a/lib/ssl/test/old_ssl_misc_SUITE.erl b/lib/ssl/test/old_ssl_misc_SUITE.erl deleted file mode 100644 index ea03e83867..0000000000 --- a/lib/ssl/test/old_ssl_misc_SUITE.erl +++ /dev/null @@ -1,117 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-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% -%% - -%% --module(old_ssl_misc_SUITE). - --export([all/0, suite/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, - seed/1, - app/1 - ]). - --import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). --include_lib("test_server/include/test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - --define(MANYCONNS, 5). - -init_per_testcase(_Case, Config) -> - WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [seed, app]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(doc) -> - "Want to se what Config contains."; -init_per_suite(suite) -> - []; -init_per_suite(Config) -> - io:format("Config: ~p~n", [Config]), - - %% Check if SSL exists. If this case fails, all other cases are skipped - case catch crypto:start() of - ok -> - application:start(public_key), - case ssl:start() of - ok -> ssl:stop(); - {error, {already_started, _}} -> ssl:stop(); - Error -> ?t:fail({failed_starting_ssl,Error}) - end, - Config; - _Else -> - {skip,"Could not start crypto!"} - end. - -end_per_suite(doc) -> - "This test case has no mission other than closing the conf case"; -end_per_suite(suite) -> - []; -end_per_suite(Config) -> - crypto:stop(), - Config. - -seed(doc) -> - "Test that ssl:seed/1 works."; -seed(suite) -> - []; -seed(Config) when list(Config) -> - process_flag(trap_exit, true), - LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {_, SsslOpts}} = mk_ssl_cert_opts(Config), - - LCmds = [{seed, "tjosan"}, - {sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ?line test_server_only(NConns, LCmds, [], Timeout, ?MODULE, - Config). - -app(doc) -> - "Test that the ssl app file is ok"; -app(suite) -> - []; -app(Config) when list(Config) -> - ?line ok = test_server:app_test(ssl). - - diff --git a/lib/ssl/test/old_ssl_passive_SUITE.erl b/lib/ssl/test/old_ssl_passive_SUITE.erl deleted file mode 100644 index 7b54fe876a..0000000000 --- a/lib/ssl/test/old_ssl_passive_SUITE.erl +++ /dev/null @@ -1,382 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% - -%% --module(old_ssl_passive_SUITE). - --export([all/0, suite/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, - server_accept_timeout/1, - cinit_return_chkclose/1, - sinit_return_chkclose/1, - cinit_big_return_chkclose/1, - sinit_big_return_chkclose/1, - cinit_big_echo_chkclose/1, - sinit_big_echo_chkclose/1, - cinit_few_echo_chkclose/1, - cinit_many_echo_chkclose/1, - cinit_cnocert/1 - ]). - --import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). - --include_lib("test_server/include/test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - --define(MANYCONNS, ssl_test_MACHINE:many_conns()). - -init_per_testcase(_Case, Config) -> - WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [server_accept_timeout, cinit_return_chkclose, - sinit_return_chkclose, cinit_big_return_chkclose, - sinit_big_return_chkclose, cinit_big_echo_chkclose, - sinit_big_echo_chkclose, cinit_few_echo_chkclose, - cinit_many_echo_chkclose, cinit_cnocert]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(doc) -> - "Want to se what Config contains."; -init_per_suite(suite) -> - []; -init_per_suite(Config) -> - io:format("Config: ~p~n", [Config]), - - %% Check if SSL exists. If this case fails, all other cases are skipped - case catch crypto:start() of - ok -> - application:start(public_key), - case ssl:start() of - ok -> ssl:stop(); - {error, {already_started, _}} -> ssl:stop(); - Error -> ?t:fail({failed_starting_ssl,Error}) - end, - Config; - _Else -> - {skip,"Could not start crypto"} - end. - -end_per_suite(doc) -> - "This test case has no mission other than closing the conf case"; -end_per_suite(suite) -> - []; -end_per_suite(Config) -> - crypto:stop(), - Config. - -server_accept_timeout(doc) -> - "Server has one pending accept with timeout. Checks that return " - "value is {error, timeout}."; -server_accept_timeout(suite) -> - []; -server_accept_timeout(Config) when list(Config) -> - process_flag(trap_exit, true), - LPort = 3456, - Timeout = 40000, NConns = 1, - AccTimeout = 3000, - - ?line {ok, {_, SsslOpts}} = mk_ssl_cert_opts(Config), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, AccTimeout}, - accept_timeout], - ?line test_server_only(NConns, LCmds, ACmds, Timeout, ?MODULE, Config). - -cinit_return_chkclose(doc) -> - "Client sends 1000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -cinit_return_chkclose(suite) -> - []; -cinit_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_return_chkclose(doc) -> - "Server sends 1000 bytes to client, that receives them, sends them " - "back, and closes. Server waits for close. Both have certs."; -sinit_return_chkclose(suite) -> - []; -sinit_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {recv, DataSize}, {send, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_big_return_chkclose(doc) -> - "Client sends 50000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -cinit_big_return_chkclose(suite) -> - []; -cinit_big_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_big_return_chkclose(doc) -> - "Server sends 50000 bytes to client, that receives them, sends them " - "back, and closes. Server waits for close. Both have certs."; -sinit_big_return_chkclose(suite) -> - []; -sinit_big_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {recv, DataSize}, {send, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_big_echo_chkclose(doc) -> - "Client sends 50000 bytes to server, that echoes them back " - "and closes. Client waits for close. Both have certs."; -cinit_big_echo_chkclose(suite) -> - []; -cinit_big_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_big_echo_chkclose(doc) -> - "Server sends 50000 bytes to client, that echoes them back " - "and closes. Server waits for close. Both have certs."; -sinit_big_echo_chkclose(suite) -> - []; -sinit_big_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {echo, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - - -cinit_few_echo_chkclose(X) -> cinit_many_echo_chkclose(X, 7). - -cinit_many_echo_chkclose(X) -> cinit_many_echo_chkclose(X, ?MANYCONNS). - -cinit_many_echo_chkclose(doc, _NConns) -> - "clients send 10000 bytes to server, that echoes them back " - "and closes. Clients wait for close. All have certs."; -cinit_many_echo_chkclose(suite, _NConns) -> - []; -cinit_many_echo_chkclose(Config, NConns) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 10000, LPort = 3456, - Timeout = 80000, - - io:format("~w connections", [NConns]), - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_cnocert(doc) -> - "Client sends 1000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Client has no cert, " - "but server has."; -cinit_cnocert(suite) -> - []; -cinit_cnocert(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3457, - Timeout = 40000, NConns = 1, - - ?line {ok, {_CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - diff --git a/lib/ssl/test/old_ssl_peer_cert_SUITE.erl b/lib/ssl/test/old_ssl_peer_cert_SUITE.erl deleted file mode 100644 index ee19bad175..0000000000 --- a/lib/ssl/test/old_ssl_peer_cert_SUITE.erl +++ /dev/null @@ -1,191 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-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% -%% - -%% --module(old_ssl_peer_cert_SUITE). - --export([all/0, suite/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, - cinit_plain/1, - cinit_both_verify/1, - cinit_cnocert/1 - ]). - --import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). --include_lib("test_server/include/test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - - -init_per_testcase(_Case, Config) -> - WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [cinit_plain, cinit_both_verify, cinit_cnocert]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(doc) -> - "Want to se what Config contains."; -init_per_suite(suite) -> - []; -init_per_suite(Config) -> - io:format("Config: ~p~n", [Config]), - - %% Check if SSL exists. If this case fails, all other cases are skipped - case catch crypto:start() of - ok -> - application:start(public_key), - case ssl:start() of - ok -> ssl:stop(); - {error, {already_started, _}} -> ssl:stop(); - Error -> ?t:fail({failed_starting_ssl,Error}) - end, - Config; - _Else -> - {skip,"Could not start crypto"} - end. - -end_per_suite(doc) -> - "This test case has no mission other than closing the conf case"; -end_per_suite(suite) -> - []; -end_per_suite(Config) -> - crypto:stop(), - Config. - -cinit_plain(doc) -> - "Server closes after accept, Client waits for close. Both have certs " - "but both use the defaults for verify and depth, but still tries " - "to retreive each others certificates."; -cinit_plain(suite) -> - []; -cinit_plain(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - nopeercert, - {recv, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - peercert, - {send, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, - ?MODULE, Config). - -cinit_both_verify(doc) -> - "Server closes after accept, Client waits for close. Both have certs " - "and both verify each other."; -cinit_both_verify(suite) -> - []; -cinit_both_verify(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts0, SsslOpts0}} = mk_ssl_cert_opts(Config), - ?line CsslOpts = [{verify, 2}, {depth, 2} | CsslOpts0], - ?line SsslOpts = [{verify, 2}, {depth, 3} | SsslOpts0], - - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - peercert, - {recv, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - peercert, - {send, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, - ?MODULE, Config). - -cinit_cnocert(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close."; -cinit_cnocert(suite) -> - []; -cinit_cnocert(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3457, - Timeout = 40000, NConns = 1, - - ?line {ok, {_, SsslOpts0}} = mk_ssl_cert_opts(Config), - ?line SsslOpts = [{verify, 0}, {depth, 2} | SsslOpts0], - - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {connect, {Host, LPort}}, - peercert, - {send, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, - ?MODULE, Config). - - diff --git a/lib/ssl/test/old_ssl_protocol_SUITE.erl b/lib/ssl/test/old_ssl_protocol_SUITE.erl deleted file mode 100644 index 9b9937c210..0000000000 --- a/lib/ssl/test/old_ssl_protocol_SUITE.erl +++ /dev/null @@ -1,185 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-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% -%% - -%% --module(old_ssl_protocol_SUITE). - --export([all/0, suite/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, - sslv2/1, sslv3/1, tlsv1/1, sslv2_sslv3/1, - sslv2_tlsv1/1, sslv3_tlsv1/1, sslv2_sslv3_tlsv1/1]). - --import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). --include_lib("test_server/include/test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - - -init_per_testcase(_Case, Config) -> - WatchDog = test_server:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [sslv2, sslv3, tlsv1, sslv2_sslv3, sslv2_tlsv1, - sslv3_tlsv1, sslv2_sslv3_tlsv1]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(doc) -> - "Want to se what Config contains."; -init_per_suite(suite) -> - []; -init_per_suite(Config) -> - io:format("Config: ~p~n", [Config]), - - %% Check if SSL exists. If this case fails, all other cases are skipped - case catch crypto:start() of - ok -> - application:start(public_key), - case ssl:start() of - ok -> ssl:stop(); - {error, {already_started, _}} -> ssl:stop(); - Error -> ?t:fail({failed_starting_ssl,Error}) - end, - Config; - _Else -> - {skip,"Could not start crypto"} - end. - -end_per_suite(doc) -> - "This test case has no other purpose than closing the conf case."; -end_per_suite(suite) -> - []; -end_per_suite(Config) -> - crypto:stop(), - Config. - -%%%%% - -sslv2(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close. " - "Client and server choose SSLv2."; -sslv2(suite) -> - []; -sslv2(Config) when list(Config) -> - do_run_test(Config, [sslv2]). - -sslv3(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close. " - "Client and server choose SSLv3."; -sslv3(suite) -> - []; -sslv3(Config) when list(Config) -> - do_run_test(Config, [sslv3]). - -tlsv1(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close. " - "Client and server choose TLSv1."; -tlsv1(suite) -> - []; -tlsv1(Config) when list(Config) -> - do_run_test(Config, [tlsv1]). - -sslv2_sslv3(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close. " - "Client and server choose between SSLv2 and SSLv3."; -sslv2_sslv3(suite) -> - []; -sslv2_sslv3(Config) when list(Config) -> - do_run_test(Config, [sslv2, sslv3]). - -sslv2_tlsv1(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close. " - "Client and server choose between SSLv2 and TLSv1."; -sslv2_tlsv1(suite) -> - []; -sslv2_tlsv1(Config) when list(Config) -> - do_run_test(Config, [sslv2, tlsv1]). - -sslv3_tlsv1(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close. " - "Client and server choose between SSLv3 and TLSv1."; -sslv3_tlsv1(suite) -> - []; -sslv3_tlsv1(Config) when list(Config) -> - do_run_test(Config, [sslv3, tlsv1]). - -sslv2_sslv3_tlsv1(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close. " - "Client and server choose between SSLv2, SSLv3, and TLSv1."; -sslv2_sslv3_tlsv1(suite) -> - []; -sslv2_sslv3_tlsv1(Config) when list(Config) -> - do_run_test(Config, [sslv2, sslv3, tlsv1]). - -%%%% - -do_run_test(Config0, Protocols) -> - process_flag(trap_exit, true), - LPort = 3456, - Timeout = 40000, NConns = 1, - DataSize = 10, - - ?line {ok, {_, SsslOpts0}} = mk_ssl_cert_opts(Config0), - ?line SsslOpts = [{verify, 0}, {depth, 2} | SsslOpts0], - - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - connection_info, - {recv, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {connect, {Host, LPort}}, - connection_info, - {send, DataSize}, - await_close], - Config1 = [{env, [{protocol_version, Protocols}]} | Config0], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, - ?MODULE, Config1). - - diff --git a/lib/ssl/test/old_ssl_verify_SUITE.erl b/lib/ssl/test/old_ssl_verify_SUITE.erl deleted file mode 100644 index 4c11ea6850..0000000000 --- a/lib/ssl/test/old_ssl_verify_SUITE.erl +++ /dev/null @@ -1,153 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% - -%% --module(old_ssl_verify_SUITE). - --export([all/0, suite/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, - cinit_both_verify/1, - cinit_cnocert/1 - ]). - --import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). --include_lib("test_server/include/test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - - -init_per_testcase(_Case, Config) -> - WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [cinit_both_verify, cinit_cnocert]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(doc) -> - "Want to se what Config contains."; -init_per_suite(suite) -> - []; -init_per_suite(Config) -> - io:format("Config: ~p~n", [Config]), - - %% Check if SSL exists. If this case fails, all other cases are skipped - case catch crypto:start() of - ok -> - application:start(public_key), - case ssl:start() of - ok -> ssl:stop(); - {error, {already_started, _}} -> ssl:stop(); - Error -> ?t:fail({failed_starting_ssl,Error}) - end, - Config; - _Else -> - {skip,"Could not start crypto"} - end. - -end_per_suite(doc) -> - "This test case has no mission other than closing the conf case"; -end_per_suite(suite) -> - []; -end_per_suite(Config) -> - crypto:stop(), - Config. - -cinit_both_verify(doc) -> - "Server closes after accept, Client waits for close. Both have certs " - "and both verify each other."; -cinit_both_verify(suite) -> - []; -cinit_both_verify(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts0, SsslOpts0}} = mk_ssl_cert_opts(Config), - ?line CsslOpts = [{verify, 2}, {depth, 2} | CsslOpts0], - ?line SsslOpts = [{verify, 2}, {depth, 3} | SsslOpts0], - - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, - ?MODULE, Config). - -cinit_cnocert(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close."; -cinit_cnocert(suite) -> - []; -cinit_cnocert(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3457, - Timeout = 40000, NConns = 1, - - ?line {ok, {_, SsslOpts0}} = mk_ssl_cert_opts(Config), - ?line SsslOpts = [{verify, 0}, {depth, 2} | SsslOpts0], - - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {connect, {Host, LPort}}, - {send, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, - ?MODULE, Config). - - diff --git a/lib/ssl/test/old_transport_accept_SUITE.erl b/lib/ssl/test/old_transport_accept_SUITE.erl deleted file mode 100644 index 6f0c8e456b..0000000000 --- a/lib/ssl/test/old_transport_accept_SUITE.erl +++ /dev/null @@ -1,258 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-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% -%% - -%% --module(old_transport_accept_SUITE). --include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). - -%% Default timetrap timeout (set in init_per_testcase). --define(default_timeout, ?t:minutes(1)). --define(application, ssh). - --export([all/0, suite/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, - config/1, - echo_once/1, - echo_twice/1, - close_before_ssl_accept/1, - server/5, - tolerant_server/5, - client/5 - ]). - -init_per_testcase(_Case, Config) -> - WatchDog = ssl_test_lib:timetrap(?default_timeout), - [{watchdog, WatchDog}, {protomod, gen_tcp}, {serialize_accept, true}| - Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [config, echo_once, echo_twice, close_before_ssl_accept]. - -groups() -> - []. - -init_per_suite(Config) -> - try crypto:start() of - ok -> - Config - catch _:_ -> - {skip, "Crypto did not start"} - end. - -end_per_suite(_Config) -> - application:stop(crypto), - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -config(doc) -> - "Want to se what Config contains."; -config(suite) -> - []; -config(Config) -> - io:format("Config: ~p~n", [Config]), - ok. - -echo_once(doc) -> - "Client sends 256 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -echo_once(suite) -> - []; -echo_once(Config) when list(Config) -> - process_flag(trap_exit, true), - LPort = 3456, - {ok, Host} = inet:gethostname(), - {ok, {COpts, SOpts}} = ssl_test_MACHINE:mk_ssl_cert_opts(Config), - N = 1, - Msg = lists:seq(0, 255), - Self = self(), - Params = "-pa " ++ filename:dirname(code:which(?MODULE)), - Node = start_node(server, Params), - CNode = start_node(client, Params), - Server = spawn_link(Node, ?MODULE, server, [Self, LPort, SOpts, Msg, N]), - Client = spawn_link(Node, ?MODULE, client, [Host, LPort, COpts, Msg, N]), - ok = receive - {Server, listening} -> - Client ! {Server, listening}, - ok; - E -> - io:format("bad receive (1) ~p\n", [E]), - E - end, - receive - {Server, done} -> - ok - end, - test_server:stop_node(Node), - test_server:stop_node(CNode). - -close_before_ssl_accept(doc) -> - "Client sends 256 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -close_before_ssl_accept(suite) -> - []; -close_before_ssl_accept(Config) when list(Config) -> - process_flag(trap_exit, true), - LPort = 3456, - {ok, Host} = inet:gethostname(), - {ok, {COpts, SOpts}} = ssl_test_MACHINE:mk_ssl_cert_opts(Config), - Msg = lists:seq(0, 255), - Self = self(), - Params = "-pa " ++ filename:dirname(code:which(?MODULE)), - Node = start_node(server, Params), - CNode = start_node(client, Params), - Server = spawn_link(Node, ?MODULE, tolerant_server, - [Self, LPort, SOpts, Msg, 2]), - Client = spawn_link(Node, ?MODULE, client, - [Host, LPort, COpts, Msg, 1]), - ok = receive - {Server, listening} -> - {ok, S} = gen_tcp:connect(Host, LPort, []), - gen_tcp:close(S), - Client ! {Server, listening}, - ok; - E -> - io:format("bad receive (1) ~p\n", [E]), - E - end, - receive - {Server, done} -> - ok - end, - test_server:stop_node(Node), - test_server:stop_node(CNode). - -client(Host, LPort, COpts, Msg, N) -> - ok = receive - {_Server, listening} -> - ok; - E -> - io:format("bad receive (2) ~p\n", [E]), - E - end, - Opts = COpts ++ [{packet, raw}, {active, false}], - app(), - lists:foreach(fun(_) -> - {ok, S} = ssl:connect(Host, LPort, Opts), - ssl:send(S, Msg), - {ok, Msg} = ssl:recv(S, length(Msg)), - ssl:close(S) - end, lists:seq(1, N)). - -echo_twice(doc) -> - "Two clients sends 256 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -echo_twice(suite) -> - []; -echo_twice(Config) when list(Config) -> - process_flag(trap_exit, true), - LPort = 3456, - {ok, Host} = inet:gethostname(), - {ok, {COpts, SOpts}} = ssl_test_MACHINE:mk_ssl_cert_opts(Config), - N = 2, - Msg = lists:seq(0, 255), - Self = self(), - Params = "-pa " ++ filename:dirname(code:which(?MODULE)), - Node = start_node(server, Params), - CNode = start_node(client, Params), - Server = spawn_link(Node, ?MODULE, server, - [Self, LPort, SOpts, Msg, N]), - Client = spawn_link(Node, ?MODULE, client, - [Host, LPort, COpts, Msg, N]), - ok = receive - {Server, listening} -> - Client ! {Server, listening}, - ok; - E -> - io:format("bad receive (3) ~p\n", [E]), - E - end, - receive - {Server, done} -> - ok - end, - test_server:stop_node(Node), - test_server:stop_node(CNode). - -server(Client, Port, SOpts, Msg, N) -> - app(), - process_flag(trap_exit, true), - Opts = SOpts ++ [{packet, raw}, {active, false}], - {ok, LSock} = ssl:listen(Port, Opts), - Client ! {self(), listening}, - server_loop(Client, LSock, Msg, N). - -server_loop(Client, _, _, 0) -> - Client ! {self(), done}; -server_loop(Client, LSock, Msg, N) -> - {ok, S} = ssl:transport_accept(LSock), - ok = ssl:ssl_accept(S), - %% P = ssl:controlling_process(S, Proxy), - {ok, Msg} = ssl:recv(S, length(Msg)), - ok = ssl:send(S, Msg), - ok = ssl:close(S), - server_loop(Client, LSock, Msg, N-1). - -tolerant_server(Client, Port, SOpts, Msg, N) -> - app(), - process_flag(trap_exit, true), - Opts = SOpts ++ [{packet, raw}, {active, false}], - {ok, LSock} = ssl:listen(Port, Opts), - Client ! {self(), listening}, - tolerant_server_loop(Client, LSock, Msg, N). - -tolerant_server_loop(Client, _, _, 0) -> - Client ! {self(), done}; -tolerant_server_loop(Client, LSock, Msg, N) -> - {ok, S} = ssl:transport_accept(LSock), - case ssl:ssl_accept(S) of - ok -> - %% P = ssl:controlling_process(S, Proxy), - {ok, Msg} = ssl:recv(S, length(Msg)), - ok = ssl:send(S, Msg), - ok = ssl:close(S); - E -> - io:format("ssl_accept error: ~p\n", [E]) - end, - tolerant_server_loop(Client, LSock, Msg, N-1). - -app() -> - crypto:start(), - application:start(public_key), - ssl:start(). - -start_node(Kind, Params) -> - S = atom_to_list(?MODULE)++"_" ++ atom_to_list(Kind), - {ok, Node} = test_server:start_node(list_to_atom(S), slave, [{args, Params}]), - Node. - diff --git a/lib/ssl/test/ssl.cover b/lib/ssl/test/ssl.cover index 60774cc0f1..6b13e07a37 100644 --- a/lib/ssl/test/ssl.cover +++ b/lib/ssl/test/ssl.cover @@ -1,21 +1,4 @@ {incl_app,ssl,details}. -{excl_mods, ssl, [ssl_pkix_oid, - 'PKIX1Algorithms88', - 'PKIX1Explicit88', - 'PKIX1Implicit88', - 'PKIXAttributeCertificate', - 'SSL-PKIX', - ssl_pem, - ssl_pkix, - ssl_base64, - ssl_broker, - ssl_broker_int, - ssl_broker_sup, - ssl_debug, - ssl_server, - ssl_prim, - inet_ssl_dist, - 'OTP-PKIX' - ]}. +{excl_mods, ssl, [ssl_debug]}. diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 8da1d947d3..42dc44c39b 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -28,7 +28,6 @@ -include_lib("public_key/include/public_key.hrl"). -include("ssl_alert.hrl"). --include("ssl_int.hrl"). -include("ssl_internal.hrl"). -include("ssl_record.hrl"). @@ -207,8 +206,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [app, alerts, connection_info, protocol_versions, empty_protocol_versions, controlling_process, - controller_dies, client_closes_socket, peercert, - connect_dist, peername, sockname, socket_options, + controller_dies, client_closes_socket, + connect_dist, peername, peercert, sockname, socket_options, invalid_inet_get_option, invalid_inet_get_option_not_list, invalid_inet_get_option_improper_list, invalid_inet_set_option, invalid_inet_set_option_not_list, @@ -584,50 +583,6 @@ client_closes_socket(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, {error,closed}). %%-------------------------------------------------------------------- - -peercert(doc) -> - [""]; - -peercert(suite) -> - []; - -peercert(Config) when is_list(Config) -> - ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - - Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, - {from, self()}, - {mfa, {?MODULE, peercert_result, []}}, - {options, ServerOpts}]), - Port = ssl_test_lib:inet_port(Server), - Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {?MODULE, peercert_result, []}}, - {options, ClientOpts}]), - - CertFile = proplists:get_value(certfile, ServerOpts), - [{'Certificate', BinCert, _}]= ssl_test_lib:pem_to_der(CertFile), - ErlCert = public_key:pkix_decode_cert(BinCert, otp), - - ServerMsg = {{error, no_peercert}, {error, no_peercert}}, - ClientMsg = {{ok, BinCert}, {ok, ErlCert}}, - - test_server:format("Testcase ~p, Client ~p Server ~p ~n", - [self(), Client, Server]), - - ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), - - ssl_test_lib:close(Server), - ssl_test_lib:close(Client). - -peercert_result(Socket) -> - Result1 = ssl:peercert(Socket), - Result2 = ssl:peercert(Socket, [ssl]), - {Result1, Result2}. - -%%-------------------------------------------------------------------- connect_dist(doc) -> ["Test a simple connect as is used by distribution"]; @@ -708,6 +663,44 @@ peername_result(S) -> ssl:peername(S). %%-------------------------------------------------------------------- +peercert(doc) -> + [""]; +peercert(suite) -> + []; +peercert(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, peercert_result, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, peercert_result, []}}, + {options, ClientOpts}]), + + CertFile = proplists:get_value(certfile, ServerOpts), + [{'Certificate', BinCert, _}]= ssl_test_lib:pem_to_der(CertFile), + + ServerMsg = {error, no_peercert}, + ClientMsg = {ok, BinCert}, + + test_server:format("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + + ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +peercert_result(Socket) -> + ssl:peercert(Socket). + +%%-------------------------------------------------------------------- sockname(doc) -> ["Test API function sockname/1"]; @@ -1528,7 +1521,6 @@ eoptions(Config) when is_list(Config) -> end, TestOpts = [{versions, [sslv2, sslv3]}, - {ssl_imp, cool}, {verify, 4}, {verify_fun, function}, {fail_if_no_peer_cert, 0}, @@ -2792,7 +2784,7 @@ extended_key_usage_verify_peer(Config) when is_list(Config) -> KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), [KeyEntry] = ssl_test_lib:pem_to_der(KeyFile), - Key = public_key:pem_entry_decode(KeyEntry), + Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)), ServerCertFile = proplists:get_value(certfile, ServerOpts), NewServerCertFile = filename:join(PrivDir, "server/new_cert.pem"), @@ -2854,7 +2846,7 @@ extended_key_usage_verify_none(Config) when is_list(Config) -> KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), [KeyEntry] = ssl_test_lib:pem_to_der(KeyFile), - Key = public_key:pem_entry_decode(KeyEntry), + Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)), ServerCertFile = proplists:get_value(certfile, ServerOpts), NewServerCertFile = filename:join(PrivDir, "server/new_cert.pem"), @@ -2916,7 +2908,7 @@ no_authority_key_identifier(Config) when is_list(Config) -> KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), [KeyEntry] = ssl_test_lib:pem_to_der(KeyFile), - Key = public_key:pem_entry_decode(KeyEntry), + Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)), CertFile = proplists:get_value(certfile, ServerOpts), NewCertFile = filename:join(PrivDir, "server/new_cert.pem"), @@ -2974,7 +2966,7 @@ invalid_signature_server(Config) when is_list(Config) -> KeyFile = filename:join(PrivDir, "server/key.pem"), [KeyEntry] = ssl_test_lib:pem_to_der(KeyFile), - Key = public_key:pem_entry_decode(KeyEntry), + Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)), ServerCertFile = proplists:get_value(certfile, ServerOpts), NewServerCertFile = filename:join(PrivDir, "server/invalid_cert.pem"), @@ -3014,7 +3006,7 @@ invalid_signature_client(Config) when is_list(Config) -> KeyFile = filename:join(PrivDir, "client/key.pem"), [KeyEntry] = ssl_test_lib:pem_to_der(KeyFile), - Key = public_key:pem_entry_decode(KeyEntry), + Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)), ClientCertFile = proplists:get_value(certfile, ClientOpts), NewClientCertFile = filename:join(PrivDir, "client/invalid_cert.pem"), @@ -3091,7 +3083,7 @@ cert_expired(Config) when is_list(Config) -> KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), [KeyEntry] = ssl_test_lib:pem_to_der(KeyFile), - Key = public_key:pem_entry_decode(KeyEntry), + Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)), ServerCertFile = proplists:get_value(certfile, ServerOpts), NewServerCertFile = filename:join(PrivDir, "server/expired_cert.pem"), @@ -3366,14 +3358,14 @@ der_input_opts(Opts) -> Keyfile = proplists:get_value(keyfile, Opts), Dhfile = proplists:get_value(dhfile, Opts), [{_, Cert, _}] = ssl_test_lib:pem_to_der(Certfile), - [{_, Key, _}] = ssl_test_lib:pem_to_der(Keyfile), + [{Asn1Type, Key, _}] = ssl_test_lib:pem_to_der(Keyfile), [{_, DHParams, _}] = ssl_test_lib:pem_to_der(Dhfile), CaCerts = lists:map(fun(Entry) -> {_, CaCert, _} = Entry, CaCert end, ssl_test_lib:pem_to_der(CaCertsfile)), - {Cert, {rsa, Key}, CaCerts, DHParams}. + {Cert, {Asn1Type, Key}, CaCerts, DHParams}. %%-------------------------------------------------------------------- %% different_ca_peer_sign(doc) -> diff --git a/lib/ssl/test/ssl_cipher_SUITE.erl b/lib/ssl/test/ssl_cipher_SUITE.erl new file mode 100644 index 0000000000..87478e13bc --- /dev/null +++ b/lib/ssl/test/ssl_cipher_SUITE.erl @@ -0,0 +1,163 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-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% +%% + +-module(ssl_cipher_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +-include("ssl_internal.hrl"). +-include("ssl_record.hrl"). +-include("ssl_cipher.hrl"). + +-define(TIMEOUT, 600000). + +%% Test server callback functions +%%-------------------------------------------------------------------- +%% Function: init_per_suite(Config) -> Config +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Initialization before the whole suite +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + try crypto:start() of + ok -> + Config + catch _:_ -> + {skip, "Crypto did not start"} + end. +%%-------------------------------------------------------------------- +%% Function: end_per_suite(Config) -> _ +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Cleanup after the whole suite +%%-------------------------------------------------------------------- +end_per_suite(_Config) -> + ssl:stop(), + application:stop(crypto). + +%%-------------------------------------------------------------------- +%% Function: init_per_testcase(TestCase, Config) -> Config +%% Case - atom() +%% Name of the test case that is about to be run. +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% +%% Description: Initialization before each test case +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%% Description: Initialization before each test case +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config0) -> + Config = lists:keydelete(watchdog, 1, Config0), + Dog = ssl_test_lib:timetrap(?TIMEOUT), + [{watchdog, Dog} | Config]. + +%%-------------------------------------------------------------------- +%% Function: end_per_testcase(TestCase, Config) -> _ +%% Case - atom() +%% Name of the test case that is about to be run. +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Cleanup after each test case +%%-------------------------------------------------------------------- +end_per_testcase(_TestCase, Config) -> + Dog = ?config(watchdog, Config), + case Dog of + undefined -> + ok; + _ -> + test_server:timetrap_cancel(Dog) + end. + +%%-------------------------------------------------------------------- +%% Function: all(Clause) -> TestCases +%% Clause - atom() - suite | doc +%% TestCases - [Case] +%% Case - atom() +%% Name of a test case. +%% Description: Returns a list of all test cases in this test suite +%%-------------------------------------------------------------------- +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [aes_decipher_good, aes_decipher_fail]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +%% Test cases starts here. +%%-------------------------------------------------------------------- +aes_decipher_good(doc) -> + ["Decipher a known cryptotext."]; + +aes_decipher_good(suite) -> + []; + +aes_decipher_good(Config) when is_list(Config) -> + HashSz = 32, + CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, + key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}, + Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, + 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, + 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, + 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, + Version = {3,3}, + Content = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56,72,69,76,76,79,10>>, + Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, + {Content, Mac, CipherState1} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), + ok. + +%%-------------------------------------------------------------------- + +aes_decipher_fail(doc) -> + ["Decipher a known cryptotext."]; + +aes_decipher_fail(suite) -> + []; + +%% same as above, last byte of key replaced +aes_decipher_fail(Config) when is_list(Config) -> + HashSz = 32, + CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, + key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}, + Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, + 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, + 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, + 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, + Version = {3,3}, + {Content, Mac, CipherState1} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), + 32 = byte_size(Content), + 32 = byte_size(Mac), + ok. + +%%-------------------------------------------------------------------- diff --git a/lib/ssl/test/old_ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl index 4544fb616a..23e9268f9b 100644 --- a/lib/ssl/test/old_ssl_dist_SUITE.erl +++ b/lib/ssl/test/ssl_dist_SUITE.erl @@ -17,41 +17,32 @@ %% %CopyrightEnd% %% -%% - - -%%%------------------------------------------------------------------- -%%% File : ssl_dist_SUITE.erl -%%% Author : Rickard Green -%%% Description : Test that the Erlang distribution works over ssl. -%%% -%%% Created : 15 Nov 2007 by Rickard Green -%%%------------------------------------------------------------------- --module(old_ssl_dist_SUITE). +-module(ssl_dist_SUITE). -include_lib("test_server/include/test_server.hrl"). +%% Note: This directive should only be used in test suites. +-compile(export_all). + -define(DEFAULT_TIMETRAP_SECS, 240). -define(AWAIT_SLL_NODE_UP_TIMEOUT, 30000). --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). --export([init_per_suite/1, - end_per_suite/1, - init_per_testcase/2, - end_per_testcase/2]). --export([cnct2tstsrvr/1]). +-record(node_handle, + {connection_handler, + socket, + name, + nodename} + ). --export([basic/1]). +%% Test server callback functions +suite() -> + [{ct_hooks,[ts_install_cth]}]. --record(node_handle, {connection_handler, socket, name, nodename}). +all() -> + [basic, payload, plain_options, plain_verify_options]. -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [basic]. - -groups() -> +groups() -> []. init_per_group(_GroupName, Config) -> @@ -60,11 +51,12 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - -init_per_suite(Config) -> +init_per_suite(Config0) -> try crypto:start() of ok -> - add_ssl_opts_config(Config) + Config = add_ssl_opts_config(Config0), + setup_certs(Config), + Config catch _:_ -> {skip, "Crypto did not start"} end. @@ -73,85 +65,164 @@ end_per_suite(Config) -> application:stop(crypto), Config. -init_per_testcase(Case, Config) when list(Config) -> +init_per_testcase(Case, Config) when is_list(Config) -> Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)), [{watchdog, Dog},{testcase, Case}|Config]. -end_per_testcase(_Case, Config) when list(Config) -> +end_per_testcase(_Case, Config) when is_list(Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Testcases %% -%% %% - +%%-------------------------------------------------------------------- +%% Test cases starts here. +%%-------------------------------------------------------------------- basic(doc) -> ["Test that two nodes can connect via ssl distribution"]; -basic(suite) -> - []; basic(Config) when is_list(Config) -> - ?line NH1 = start_ssl_node(Config), - ?line Node1 = NH1#node_handle.nodename, - ?line NH2 = start_ssl_node(Config), - ?line Node2 = NH2#node_handle.nodename, + NH1 = start_ssl_node(Config), + Node1 = NH1#node_handle.nodename, + NH2 = start_ssl_node(Config), + Node2 = NH2#node_handle.nodename, - ?line pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), - ?line [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), - ?line [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), + [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), %% The test_server node has the same cookie as the ssl nodes %% but it should not be able to communicate with the ssl nodes %% via the erlang distribution. - ?line pang = net_adm:ping(Node1), - ?line pang = net_adm:ping(Node2), - + pang = net_adm:ping(Node1), + pang = net_adm:ping(Node2), %% %% Check that we are able to communicate over the erlang %% distribution between the ssl nodes. %% - ?line Ref = make_ref(), - ?line spawn(fun () -> - apply_on_ssl_node( - NH1, - fun () -> - tstsrvr_format("Hi from ~p!~n", - [node()]), - send_to_tstcntrl({Ref, self()}), - receive - {From, ping} -> - From ! {self(), pong} - end - end) - end), - ?line receive - {Ref, SslPid} -> - ?line ok = apply_on_ssl_node( - NH2, - fun () -> - tstsrvr_format("Hi from ~p!~n", - [node()]), - SslPid ! {self(), ping}, - receive - {SslPid, pong} -> - ok - end - end) - end, - - ?line stop_ssl_node(NH1), - ?line stop_ssl_node(NH2), - ?line success(Config). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Internal functions %% -%% %% + Ref = make_ref(), + spawn(fun () -> + apply_on_ssl_node( + NH1, + fun () -> + tstsrvr_format("Hi from ~p!~n", [node()]), + send_to_tstcntrl({Ref, self()}), + receive + {From, ping} -> + tstsrvr_format("Received ping ~p!~n", [node()]), + From ! {self(), pong} + end + end) + end), + receive + {Ref, SslPid} -> + ok = apply_on_ssl_node( + NH2, + fun () -> + tstsrvr_format("Hi from ~p!~n", [node()]), + SslPid ! {self(), ping}, + receive + {SslPid, pong} -> + ok + end + end) + end, + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). + +%%-------------------------------------------------------------------- +payload(doc) -> + ["Test that send a lot of data between the ssl distributed noes"]; +payload(Config) when is_list(Config) -> + NH1 = start_ssl_node(Config), + Node1 = NH1#node_handle.nodename, + NH2 = start_ssl_node(Config), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + Ref = make_ref(), + spawn(fun () -> + apply_on_ssl_node( + NH1, + fun () -> + send_to_tstcntrl({Ref, self()}), + receive + {From, Msg} -> + From ! {self(), Msg} + end + end) + end), + receive + {Ref, SslPid} -> + ok = apply_on_ssl_node( + NH2, + fun () -> + Msg = crypto:rand_bytes(100000), + SslPid ! {self(), Msg}, + receive + {SslPid, Msg} -> + ok + end + end) + end, + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). +%%-------------------------------------------------------------------- +plain_options(doc) -> + ["Test specifying additional options"]; +plain_options(Config) when is_list(Config) -> + DistOpts = "-ssl_dist_opt server_secure_renegotiate true " + "client_secure_renegotiate true " + "server_reuse_sessions true client_reuse_sessions true " + "client_verify verify_none server_verify verify_none " + "server_depth 1 client_depth 1 " + "server_hibernate_after 500 client_hibernate_after 500", + + NH1 = start_ssl_node([{additional_dist_opts, DistOpts} | Config]), + Node1 = NH1#node_handle.nodename, + NH2 = start_ssl_node([{additional_dist_opts, DistOpts} | Config]), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). +%%-------------------------------------------------------------------- +plain_verify_options(doc) -> + ["Test specifying additional options"]; +plain_verify_options(Config) when is_list(Config) -> + DistOpts = "-ssl_dist_opt server_secure_renegotiate true " + "client_secure_renegotiate true " + "server_reuse_sessions true client_reuse_sessions true " + "server_hibernate_after 500 client_hibernate_after 500", + + NH1 = start_ssl_node([{additional_dist_opts, DistOpts}, {many_verify_opts, true} | Config]), + Node1 = NH1#node_handle.nodename, + NH2 = start_ssl_node([{additional_dist_opts, DistOpts}, {many_verify_opts, true} | Config]), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- -%% %% ssl_node side api %% @@ -166,7 +237,7 @@ send_to_tstcntrl(Message) -> %% test_server side api %% -apply_on_ssl_node(Node, M, F, A) when atom(M), atom(F), list(A) -> +apply_on_ssl_node(Node, M, F, A) when is_atom(M), is_atom(F), is_list(A) -> Ref = make_ref(), send_to_ssl_node(Node, {apply, self(), Ref, M, F, A}), receive @@ -208,7 +279,7 @@ start_ssl_node(Config) -> start_ssl_node(Config, XArgs) -> Name = mk_node_name(Config), SSL = ?config(ssl_opts, Config), - SSLDistOpts = setup_dist_opts(Name, ?config(priv_dir, Config)), + SSLDistOpts = setup_dist_opts(Config), start_ssl_node_raw(Name, SSL ++ " " ++ SSLDistOpts ++ XArgs). start_ssl_node_raw(Name, Args) -> @@ -218,7 +289,7 @@ start_ssl_node_raw(Name, Args) -> CmdLine = mk_node_cmdline(ListenPort, Name, Args), ?t:format("Attempting to start ssl node ~s: ~s~n", [Name, CmdLine]), case open_port({spawn, CmdLine}, []) of - Port when port(Port) -> + Port when is_port(Port) -> unlink(Port), erlang:port_close(Port), case await_ssl_node_up(Name, LSock) of @@ -270,8 +341,8 @@ mk_node_cmdline(ListenPort, Name, Args) -> Prog ++ " " ++ Static ++ " " ++ NameSw ++ " " ++ Name ++ " " - ++ "-pa " ++ Pa ++ " " - ++ "-run application start crypto -run application start public_key " + ++ "-pa " ++ Pa ++ " " + ++ "-run application start crypto -run application start public_key " ++ "-run " ++ atom_to_list(?MODULE) ++ " cnct2tstsrvr " ++ host_name() ++ " " ++ integer_to_list(ListenPort) ++ " " @@ -355,6 +426,7 @@ tstsrvr_con_loop(Name, Socket, Parent) -> {format, FmtStr, ArgList} -> ?t:format(FmtStr, ArgList); {message, Msg} -> + ?t:format("Got message ~p", [Msg]), Parent ! Msg; {apply_res, To, Ref, Res} -> To ! {Ref, Res}; @@ -376,7 +448,7 @@ tstsrvr_con_loop(Name, Socket, Parent) -> %% % cnct2tstsrvr() is called via command line arg -run ... -cnct2tstsrvr([Host, Port]) when list(Host), list(Port) -> +cnct2tstsrvr([Host, Port]) when is_list(Host), is_list(Port) -> %% Spawn connection handler on ssl node side ConnHandler = spawn(fun () -> @@ -419,7 +491,7 @@ notify_ssl_node_up(Socket) -> send_to_tstsrvr(Term) -> case catch ets:lookup_element(test_server_info, test_server_handler, 2) of - Hndlr when pid(Hndlr) -> + Hndlr when is_pid(Hndlr) -> Hndlr ! {relay_to_test_server, term_to_binary(Term)}, ok; _ -> receive after 200 -> ok end, @@ -499,9 +571,10 @@ do_append_files([F|Fs], RF) -> {ok, Data} = file:read_file(F), ok = file:write(RF, Data), do_append_files(Fs, RF). - -setup_dist_opts(Name, PrivDir) -> - NodeDir = filename:join([PrivDir, Name]), + +setup_certs(Config) -> + PrivDir = ?config(priv_dir, Config), + NodeDir = filename:join([PrivDir, "Certs"]), RGenDir = filename:join([NodeDir, "rand_gen"]), ok = file:make_dir(NodeDir), ok = file:make_dir(RGenDir), @@ -516,11 +589,46 @@ setup_dist_opts(Name, PrivDir) -> CC = filename:join([CDir, "cert.pem"]), CK = filename:join([CDir, "key.pem"]), CKC = filename:join([CDir, "keycert.pem"]), - append_files([CK, CC], CKC), - "-proto_dist inet_ssl " - ++ "-ssl_dist_opt server_certfile " ++ SKC ++ " " - ++ "-ssl_dist_opt client_certfile " ++ CKC ++ " " -.% ++ "-ssl_dist_opt verify 1 depth 1". + append_files([CK, CC], CKC). + +setup_dist_opts(Config) -> + PrivDir = ?config(priv_dir, Config), + DataDir = ?config(data_dir, Config), + Dhfile = filename:join([DataDir, "dHParam.pem"]), + NodeDir = filename:join([PrivDir, "Certs"]), + SDir = filename:join([NodeDir, "server"]), + CDir = filename:join([NodeDir, "client"]), + SC = filename:join([SDir, "cert.pem"]), + SK = filename:join([SDir, "key.pem"]), + SKC = filename:join([SDir, "keycert.pem"]), + SCA = filename:join([CDir, "cacerts.pem"]), + CC = filename:join([CDir, "cert.pem"]), + CK = filename:join([CDir, "key.pem"]), + CKC = filename:join([CDir, "keycert.pem"]), + CCA = filename:join([SDir, "cacerts.pem"]), + + DistOpts = case proplists:get_value(many_verify_opts, Config, false) of + false -> + "-proto_dist inet_tls " + ++ "-ssl_dist_opt server_certfile " ++ SKC ++ " " + ++ "-ssl_dist_opt client_certfile " ++ CKC ++ " "; + true -> + "-proto_dist inet_tls " + ++ "-ssl_dist_opt server_certfile " ++ SC ++ " " + ++ "-ssl_dist_opt server_keyfile " ++ SK ++ " " + ++ "-ssl_dist_opt server_cacertfile " ++ SCA ++ " " + ++ "-ssl_dist_opt server_verify verify_peer " + ++ "-ssl_dist_opt server_fail_if_no_peer_cert true " + ++ "-ssl_dist_opt server_ciphers DHE-RSA-AES256-SHA:DHE-RSA-AES128-SHA " + ++ "-ssl_dist_opt server_dhfile " ++ Dhfile ++ " " + ++ "-ssl_dist_opt client_certfile " ++ CC ++ " " + ++ "-ssl_dist_opt client_keyfile " ++ CK ++ " " + ++ "-ssl_dist_opt client_cacertfile " ++ CCA ++ " " + ++ "-ssl_dist_opt client_verify verify_peer " + ++ "-ssl_dist_opt client_ciphers DHE-RSA-AES256-SHA:DHE-RSA-AES128-SHA " + end, + MoreOpts = proplists:get_value(additional_dist_opts, Config, []), + DistOpts ++ MoreOpts. %% %% Start scripts etc... @@ -544,7 +652,7 @@ add_ssl_opts_config(Config) -> SSL_VSN = vsn(ssl), VSN_CRYPTO = vsn(crypto), VSN_PKEY = vsn(public_key), - + SslDir = filename:join([LibDir, "ssl-" ++ SSL_VSN]), {ok, _} = file:read_file_info(SslDir), %% We are using an installed otp system, create the boot script. diff --git a/lib/ssl/test/ssl_dist_SUITE_data/dHParam.pem b/lib/ssl/test/ssl_dist_SUITE_data/dHParam.pem new file mode 100644 index 0000000000..feb581da30 --- /dev/null +++ b/lib/ssl/test/ssl_dist_SUITE_data/dHParam.pem @@ -0,0 +1,5 @@ +-----BEGIN DH PARAMETERS----- +MIGHAoGBAMY5VmCZ22ZEy/KO8kjt94PH7ZtSG0Z0zitlMlvd4VsNkDzXsVeu+wkH +FGDC3h3vgv6iwXGCbmrSOVk/FPZbzLhwZ8aLnkUFOBbOvVvb1JptQwOt8mf+eScG +M2gGBktheQV5Nf1IrzOctG7VGt+neiqb/Y86uYCcDdL+M8++0qnLAgEC +-----END DH PARAMETERS----- diff --git a/lib/ssl/test/ssl_test_MACHINE.erl b/lib/ssl/test/ssl_test_MACHINE.erl deleted file mode 100644 index e0ffa15d80..0000000000 --- a/lib/ssl/test/ssl_test_MACHINE.erl +++ /dev/null @@ -1,940 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2010. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(ssl_test_MACHINE). - --export([many_conns/0, mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). - --export([process_init/3, do_start/1]). - - --include("test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - --define(WAIT_TIMEOUT, 10000). --define(CLOSE_WAIT, 1000). - -%% -%% many_conns() -> ManyConnections -%% -%% Choose a suitable number of "many connections" depending on platform -%% and current limit for file descriptors. -%% -many_conns() -> - case os:type() of - {unix,_} -> many_conns_1(); - _ -> 10 - end. - -many_conns_1() -> - N0 = os:cmd("ulimit -n"), - N1 = lists:reverse(N0), - N2 = lists:dropwhile(fun($\r) -> true; - ($\n) -> true; - (_) -> false - end, N1), - N = list_to_integer(lists:reverse(N2)), - lists:min([(N - 10) div 2, 501]). - -%% -%% mk_ssl_cert_opts(Config) -> {ok, {COpts, SOpts}} -%% -%% -mk_ssl_cert_opts(_Config) -> - Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]), - COpts = [{ssl_imp, old}, - {cacertfile, filename:join([Dir, "client", "cacerts.pem"])}, - {certfile, filename:join([Dir, "client", "cert.pem"])}, - {keyfile, filename:join([Dir, "client", "key.pem"])}], - SOpts = [{ssl_imp, old}, - {cacertfile, filename:join([Dir, "server", "cacerts.pem"])}, - {certfile, filename:join([Dir, "server", "cert.pem"])}, - {keyfile, filename:join([Dir, "server", "key.pem"])}], - {ok, {COpts, SOpts}}. - -%% -%% Cmds: -%% {protomod, gen_tcp | ssl} default = ssl -%% {serialize_accept, true | false} default = false -%% {timeout, Timeout} -%% {sockopts, Opts} -%% {sslopts, Opts} -%% {protocols, Protocols} [sslv2|sslv3|tlsv1] -%% {listen, Port} -%% {lsock, LSock} listen socket for acceptor -%% peercert -%% accept -%% {connect, {Host, Port}} -%% {recv, N} -%% {send, N} -%% {echo, N} async echo back -%% close close connection socket -%% {close, Time} wait time and then close socket -%% lclose close listen socket -%% await_close wait for close -%% wait_sync listener's wait for sync from parent -%% connection_info -%% {exit, Reason} exit -%% -%% -%% We cannot have more than `backlog' acceptors at the same time. -%% - - -%% -%% test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, Suite, Config) -%% -%% Creates one client and one server node, and runs one listener on -%% the server node (according to LCmds), and creates NConns acceptors -%% on the server node, and the same number of connectors on the client -%% node. The acceptors and and connectors execute according to ACmds -%% and CCmds, respectively. -%% -%% It is a good idea to have the backlog size in LCmds set to -%% be at least as large as NConns. -%% -test_one_listener(NConns, LCmds0, ACmds0, CCmds0, Timeout, Suite, Config) -> - ProtoMod = get_protomod(Config), - SerializeAccept = get_serialize_accept(Config), - ?line {ok, {CNode, SNode}} = start_client_server_nodes(Suite), - case ProtoMod of - ssl -> - ?line ok = start_ssl([CNode, SNode], Config); - gen_tcp -> - ok - end, - LCmds = [{protomod, ProtoMod}| LCmds0], - ACmds = [{protomod, ProtoMod}, {serialize_accept, SerializeAccept}| - ACmds0], - CCmds = [{protomod, ProtoMod}| CCmds0], - - ?line {ok, Listener} = start_process(SNode, self(), LCmds, listener), - ?line {ok, LSock} = wait_lsock(Listener, ?WAIT_TIMEOUT), - ?line {ok, Accs0} = start_processes(NConns, SNode, self(), - [{lsock, LSock}| ACmds], acceptor), - Accs = case ProtoMod of - gen_tcp -> - [Acc1| Accs1] = Accs0, - Acc1 ! {continue_accept, self()}, - Accs1; - ssl -> - Accs0 - end, - ?line {ok, Conns} = start_processes(NConns, CNode, self(), - CCmds, connector), - ?line case wait_ack(Accs, Accs0 ++ Conns, Timeout) of - ok -> - ?line sync([Listener]), - ?line wait_ack([], [Listener], ?WAIT_TIMEOUT); - {error, Reason} -> - ?line stop_node(SNode), - ?line stop_node(CNode), - exit(Reason) - end, - ?line stop_node(SNode), - ?line stop_node(CNode), - ok. - -%% -%% test_server_only(NConns, LCmds, ACmds, Timeout, Suite, Config) -%% -%% Creates only one server node, and runs one listener on -%% the server node (according to LCmds), and creates NConns acceptors -%% on the server node. The acceptors execute according to ACmds. -%% There are no connectors. -%% -test_server_only(NConns, LCmds0, ACmds0, Timeout, Suite, Config) -> - ProtoMod = get_protomod(Config), - ?line {ok, SNode} = start_server_node(Suite), - case ProtoMod of - ssl -> - ?line ok = start_ssl([SNode], Config); - gen_tcp -> - ok - end, - LCmds = [{protomod, ProtoMod}| LCmds0], - ACmds = [{protomod, ProtoMod}| ACmds0], - ?line {ok, Listener} = start_process(SNode, self(), LCmds, listener), - ?line {ok, LSock} = wait_lsock(Listener, ?WAIT_TIMEOUT), - ?line {ok, Accs0} = start_processes(NConns, SNode, self(), - [{lsock, LSock}| ACmds], acceptor), - Accs = case ProtoMod of - gen_tcp -> - [Acc1| Accs1] = Accs0, - Acc1 ! {continue_accept, self()}, - Accs1; - ssl -> - Accs0 - end, - ?line case wait_ack(Accs, Accs0, Timeout) of - ok -> - ?line sync([Listener]), - ?line wait_ack([], [Listener], ?WAIT_TIMEOUT); - {error, Reason} -> - ?line stop_node(SNode), - exit(Reason) - end, - ?line stop_node(SNode), - ok. - -%% -%% start_client_server_nodes(Suite) -> {ok, {CNode, SNode}} -%% -start_client_server_nodes(Suite) -> - {ok, CNode} = start_client_node(Suite), - {ok, SNode} = start_server_node(Suite), - {ok, {CNode, SNode}}. - -start_client_node(Suite) -> - start_node(lists:concat([Suite, "_client"])). - -start_server_node(Suite) -> - start_node(lists:concat([Suite, "_server"])). - -%% -%% start_ssl(Nodes, Config) -%% -start_ssl(Nodes, Config) -> - Env0 = lists:flatten([Env00 || {env, Env00} <- Config]), - Env1 = case os:getenv("SSL_DEBUG") of - false -> - []; - _ -> - Dir = ?config(priv_dir, Config), - [{debug, true}, {debugdir, Dir}] - end, - Env = Env0 ++ Env1, - lists:foreach( - fun(Node) -> rpc:call(Node, ?MODULE, do_start, [Env]) end, Nodes), - ok. - -do_start(Env) -> - application:start(crypto), - application:start(public_key), - application:load(ssl), - lists:foreach( - fun({Par, Val}) -> application:set_env(ssl, Par, Val) end, Env), - application:start(ssl). - - -%% -%% start_node(Name) -> {ok, Node} -%% start_node(Name, ExtraParams) -> {ok, Node} -%% -start_node(Name) -> - start_node(Name, []). -start_node(Name, ExtraParams) -> - Params = "-pa " ++ filename:dirname(code:which(?MODULE)) ++ " " ++ - ExtraParams, - test_server:start_node(Name, slave, [{args, Params}]). - -stop_node(Node) -> - test_server:stop_node(Node). - -%% -%% start_processes(N, Node, Parent, Cmds, Type) -> {ok, Pids} -%% -start_processes(M, Node, Parent, Cmds, Type) -> - start_processes1(0, M, Node, Parent, Cmds, Type, []). -start_processes1(M, M, _, _, _, _, Pids) -> - {ok, lists:reverse(Pids)}; -start_processes1(N, M, Node, Parent, Cmds, Type, Pids) -> - {ok, Pid} = start_process(Node, Parent, Cmds, {Type, N + 1}), - start_processes1(N + 1, M, Node, Parent, Cmds, Type, [Pid| Pids]). - -%% -%% start_process(Node, Parent, Cmds, Type) -> {ok, Pid} -%% -start_process(Node, Parent, Cmds0, Type) -> - Cmds = case os:type() of - {win32, _} -> - lists:map(fun(close) -> {close, ?CLOSE_WAIT}; - (Term) -> Term end, Cmds0); - _ -> - Cmds0 - end, - Pid = spawn_link(Node, ?MODULE, process_init, [Parent, Cmds, Type]), - {ok, Pid}. - -process_init(Parent, Cmds, Type) -> - ?debug("#### ~w start~n", [{Type, self()}]), - pre_main_loop(Cmds, #st{parent = Parent, type = Type}). - -%% -%% pre_main_loop -%% -pre_main_loop([], St) -> - ?debug("#### ~w end~n", [{St#st.type, self()}]), - main_loop([], St); -pre_main_loop(Cmds, St) -> - ?debug("#### ~w -> ~w~n", - [{St#st.type, self(), St#st.sock, St#st.port, - St#st.peer, St#st.active}, hd(Cmds)]), - main_loop(Cmds, St). - -%% -%% main_loop(Cmds, St) -%% -main_loop([{protomod, ProtoMod}| Cmds], St) -> - pre_main_loop(Cmds, St#st{protomod = ProtoMod}); - -main_loop([{serialize_accept, Bool}| Cmds], St) -> - pre_main_loop(Cmds, St#st{serialize_accept = Bool}); - -main_loop([{sockopts, Opts}| Cmds], St) -> - pre_main_loop(Cmds, St#st{sockopts = Opts}); - -main_loop([{sslopts, Opts}| Cmds], St) -> - pre_main_loop(Cmds, St#st{sslopts = Opts}); - -main_loop([{protocols, Protocols}| Cmds], St) -> - pre_main_loop(Cmds, St#st{protocols = Protocols}); - -main_loop([{timeout, T}| Cmds], St) -> - pre_main_loop(Cmds, St#st{timeout = T}); - -main_loop([{lsock, LSock}| Cmds], St) -> - pre_main_loop(Cmds, St#st{lsock = LSock}); - -main_loop([{seed, Data}| Cmds], St) -> - case ssl:seed("tjosan") of - ok -> - pre_main_loop(Cmds, St); - {error, Reason} -> - ?error("#### ~w(~w) in seed: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([{listen, Port}| Cmds], St) -> - case listen(St, Port) of - {ok, LSock} -> - ack_lsock(St#st.parent, LSock), - NSt = get_active(St#st{port = Port, sock = LSock, lsock = LSock}), - pre_main_loop(Cmds, St); - {error, Reason} -> - ?error("#### ~w(~w) in listen: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([accept| Cmds], St) -> - case St#st.serialize_accept of - true -> - Parent = St#st.parent, - receive - {continue_accept, Parent} -> - ok - end; - false -> - ok - end, - case accept(St) of - {ok, Sock, Port, Peer} -> - case St#st.serialize_accept of - true -> - St#st.parent ! {one_accept_done, self()}; - false -> - ok - end, - NSt = get_active(St#st{sock = Sock, port = Port, peer = Peer}), - pre_main_loop(Cmds, NSt); - {error, Reason} -> - ?error("#### ~w(~w) in accept: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([accept_timeout| Cmds], St) -> - case accept(St) of - {error, timeout} -> - pre_main_loop(Cmds, St); - {error, Reason} -> - ?error("#### ~w(~w) in accept_timeout: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - - -main_loop([{connect, {Host, Port}}| Cmds], St) -> - case connect(St, Host, Port) of - {ok, Sock, LPort, Peer} -> - NSt = get_active(St#st{sock = Sock, port = LPort, peer = Peer}), - pre_main_loop(Cmds, NSt); - {error, Reason} -> - ?error("#### ~w(~w) in connect: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([connection_info| Cmds], St) -> - case connection_info(St) of - {ok, ProtoInfo} -> - io:fwrite("Got connection_info:~n~p~n", [ProtoInfo]), - pre_main_loop(Cmds, St); - {error, Reason} -> - ?error("#### ~w(~w) in connection_info: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([peercert| Cmds], St) -> - case peercert(St) of - {ok, Cert} -> - io:fwrite("Got cert:~n~p~n", [Cert]), - pre_main_loop(Cmds, St); - {error, Reason} -> - ?error("#### ~w(~w) in peercert: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([nopeercert| Cmds], St) -> - case peercert(St) of - {error, Reason} -> - io:fwrite("Got no cert as expected. reason:~n~p~n", [Reason]), - pre_main_loop(Cmds, St); - {ok, Cert} -> - ?error("#### ~w(~w) in peercert: error: got cert: ~p~n", - [St#st.type, self(), Cert]), - exit(peercert) - end; - -main_loop([{recv, N}| Cmds], St) -> - recv_loop([{recv, N}| Cmds], fun recv/1, St); % Returns to main_loop/2. - -main_loop([{send, N}| Cmds], St) -> - Msg = mk_msg(N), - case send(St, Msg) of - ok -> - pre_main_loop(Cmds, St); - {error, Reason} -> - ?error("#### ~w(~w) in send: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([{echo, N}| Cmds], St) -> - recv_loop([{echo, N}| Cmds], fun echo/1, St); % Returns to main_loop/2. - -main_loop([{close, WaitTime}| Cmds], St) -> - wait(WaitTime), - pre_main_loop([close| Cmds], St); - -main_loop([close| Cmds], St) -> - case close(St) of - ok -> - pre_main_loop(Cmds, St#st{sock = nil}); - {error, Reason} -> - ?error("#### ~w(~w) in close: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([lclose| Cmds], St) -> - case lclose(St) of - ok -> - pre_main_loop(Cmds, St#st{lsock = nil}); - {error, Reason} -> - ?error("#### ~w(~w) in lclose: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([await_close| Cmds], St) -> - case await_close(St) of - ok -> - pre_main_loop(Cmds, St#st{sock = nil}); - {error, Reason} -> - ?error("#### ~w(~w) in await_close: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([wait_sync| Cmds], St) -> - wait_sync(St), - pre_main_loop(Cmds, St); - -main_loop({exit, Reason}, _St) -> - exit(Reason); - -main_loop([], _St) -> - ok. - -%% -%% recv_loop(Cmds, F, St) -%% -%% F = recv/1 | echo/1 -%% -recv_loop([{_Tag, 0}| Cmds], _, St) -> - pre_main_loop(Cmds, St); -recv_loop([{_Tag, N}| _Cmds], _, St) when N < 0 -> - ?error("#### ~w(~w) in recv_loop: error: too much: ~w~n", - [St#st.type, self(), N]), - exit(toomuch); % XXX or {error, Reason}? -recv_loop([{Tag, N}| Cmds], F, St) -> - case F(St) of - {ok, Len} -> - NSt = St#st{active = new_active(St#st.active)}, - if - Len == N -> - pre_main_loop(Cmds, NSt); - true -> - ?debug("#### ~w -> ~w~n", - [{NSt#st.type, self(), NSt#st.sock, NSt#st.port, - NSt#st.peer, NSt#st.active}, {Tag, N - Len}]), - recv_loop([{Tag, N - Len}| Cmds], F, NSt) - end; - {error, Reason} -> - ?error("#### ~w(~w) in recv_loop: error: ~w, ~w bytes remain~n", - [St#st.type, self(), Reason, N]), - exit(Reason) - end. - -new_active(once) -> - false; -new_active(A) -> - A. - -get_active(St) -> - A = case proplists:get_value(active, St#st.sockopts, undefined) of - undefined -> - Mod = case St#st.protomod of - ssl -> - ssl; - gen_tcp -> - inet - end, - {ok, [{active, Ax}]} = Mod:getopts(St#st.sock, [active]), - Ax; - Ay -> - Ay - end, - ?debug("#### ~w(~w) get_active: ~p\n", [St#st.type, self(), A]), - St#st{active = A}. - - -%% -%% SOCKET FUNCTIONS -%% - -%% -%% ssl -%% - -%% -%% listen(St, LPort) -> {ok, LSock} | {error, Reason} -%% -listen(St, LPort) -> - case St#st.protomod of - ssl -> - ssl:listen(LPort, [{ssl_imp, old} | St#st.sockopts ++ St#st.sslopts]); - gen_tcp -> - gen_tcp:listen(LPort, St#st.sockopts) - end. - -%% -%% accept(St) -> {ok, Sock} | {error, Reason} -%% -accept(St) -> - case St#st.protomod of - ssl -> - case ssl:transport_accept(St#st.lsock, St#st.timeout) of - {ok, Sock} -> - case ssl:ssl_accept(Sock, St#st.timeout) of - ok -> - {ok, Port} = ssl:sockname(Sock), - {ok, Peer} = ssl:peername(Sock), - {ok, Sock, Port, Peer}; - Other -> - Other - end; - Other -> - Other - end; - gen_tcp -> - case gen_tcp:accept(St#st.lsock, St#st.timeout) of - {ok, Sock} -> - {ok, Port} = inet:port(Sock), - {ok, Peer} = inet:peername(Sock), - {ok, Sock, Port, Peer}; - Other -> - Other - end - end. - -%% -%% connect(St, Host, Port) -> {ok, Sock} | {error, Reason} -%% -connect(St, Host, Port) -> - - case St#st.protomod of - ssl -> - case ssl:connect(Host, Port, - [{ssl_imp, old} | St#st.sockopts ++ St#st.sslopts], - St#st.timeout) of - {ok, Sock} -> - {ok, LPort} = ssl:sockname(Sock), - {ok, Peer} = ssl:peername(Sock), - {ok, Sock, LPort, Peer}; - Other -> - Other - end; - gen_tcp -> - case gen_tcp:connect(Host, Port, St#st.sockopts, St#st.timeout) of - {ok, Sock} -> - {ok, LPort} = inet:port(Sock), - {ok, Peer} = inet:peername(Sock), - {ok, Sock, LPort, Peer}; - Other -> - Other - end - end. - -%% -%% peercert(St) -> {ok, Cert} | {error, Reason} -%% -peercert(St) -> - case St#st.protomod of - ssl -> - ssl:peercert(St#st.sock, [ssl]); - gen_tcp -> - {ok, <<>>} - end. - -%% -%% connection_info(St) -> {ok, ProtoInfo} | {error, Reason} -%% -connection_info(St) -> - case St#st.protomod of - ssl -> - case ssl:connection_info(St#st.sock) of - Res = {ok, {Proto, _}} -> - case St#st.protocols of - [] -> - Res; - Protocols -> - case lists:member(Proto, Protocols) of - true -> - Res; - false -> - {error, Proto} - end - end; - Error -> - Error - end; - gen_tcp -> - {ok, <<>>} - end. - -%% -%% close(St) -> ok | {error, Reason} -%% - -close(St) -> - Mod = St#st.protomod, - case St#st.sock of - nil -> - ok; - _ -> - Mod:close(St#st.sock) - end. - -%% -%% lclose(St) -> ok | {error, Reason} -%% -lclose(St) -> - Mod = St#st.protomod, - case St#st.lsock of - nil -> - ok; - _ -> - Mod:close(St#st.lsock) - end. - -%% -%% recv(St) = {ok, Len} | {error, Reason} -%% -recv(St) -> - case do_recv(St) of - {ok, Msg} -> - {ok, length(Msg)}; - {error, Reason} -> - {error, Reason} - end. - -do_recv(St) when St#st.active == false -> - %% First check that we do *not* have any ssl/gen_tcp messages in the - %% message queue, then call the receive function. - Sock = St#st.sock, - case St#st.protomod of - ssl -> - receive - M = {ssl, Sock, _Msg} -> - {error, {unexpected_messagex, M}}; - M = {ssl_closed, Sock} -> - {error, {unexpected_message, M}}; - M = {ssl_error, Sock, _Reason} -> - {error, {unexpected_message, M}} - after 0 -> - ssl:recv(St#st.sock, 0, St#st.timeout) - end; - gen_tcp -> - receive - M = {tcp, Sock, _Msg} -> - {error, {unexpected_message, M}}; - M = {tcp_closed, Sock} -> - {error, {unexpected_message, M}}; - M = {tcp_error, Sock, _Reason} -> - {error, {unexpected_message, M}} - after 0 -> - gen_tcp:recv(St#st.sock, 0, St#st.timeout) - end - end; -do_recv(St) -> - Sock = St#st.sock, - Timeout = St#st.timeout, - case St#st.protomod of - ssl -> - receive - {ssl, Sock, Msg} -> - {ok, Msg}; - {ssl_closed, Sock} -> - {error, closed}; - {ssl_error, Sock, Reason} -> - {error, Reason} - after Timeout -> - {error, timeout} - end; - gen_tcp -> - receive - {tcp, Sock, Msg} -> - {ok, Msg}; - {tcp_closed, Sock} -> - {error, closed}; - {tcp_error, Sock, Reason} -> - {error, Reason} - after Timeout -> - {error, timeout} - end - end. - -%% -%% echo(St) = {ok, Len} | {error, Reason} -%% -echo(St) -> - Sock = St#st.sock, - case do_recv(St) of - {ok, Msg} -> - Mod = St#st.protomod, - case Mod:send(Sock, Msg) of - ok -> - {ok, length(Msg)}; - {error, Reason} -> - {error, Reason} - end; - {error, Reason} -> - {error, Reason} - end. - -%% -%% send(St, Msg) -> ok | {error, Reason} -%% -send(St, Msg) -> - Mod = St#st.protomod, - Mod:send(St#st.sock, Msg). - -%% -%% await_close(St) -> ok | {error, Reason} -%% -await_close(St) when St#st.active == false -> - %% First check that we do *not* have any ssl/gen_tcp messages in the - %% message queue, then call the receive function. - Sock = St#st.sock, - Res = case St#st.protomod of - ssl -> - receive - M = {ssl, Sock, _Msg0} -> - {error, {unexpected_message, M}}; - M = {ssl_closed, Sock} -> - {error, {unexpected_message, M}}; - M = {ssl_error, Sock, _Reason} -> - {error, {unexpected_message, M}} - after 0 -> - ok - end; - gen_tcp -> - receive - M = {tcp, Sock, _Msg0} -> - {error, {unexpected_message, M}}; - M = {tcp_closed, Sock} -> - {error, {unexpected_message, M}}; - M = {tcp_error, Sock, _Reason} -> - {error, {unexpected_message, M}} - after 0 -> - ok - end - end, - case Res of - ok -> - Mod = St#st.protomod, - case Mod:recv(St#st.sock, 0, St#st.timeout) of - {ok, _Msg} -> - {error, toomuch}; - {error, _} -> - ok - end; - _ -> - Res - end; -await_close(St) -> - Sock = St#st.sock, - Timeout = St#st.timeout, - case St#st.protomod of - ssl -> - receive - {ssl, Sock, _Msg} -> - {error, toomuch}; - {ssl_closed, Sock} -> - ok; - {ssl_error, Sock, Reason} -> - {error, Reason} - after Timeout -> - {error, timeout} - end; - gen_tcp -> - receive - {tcp, Sock, _Msg} -> - {error, toomuch}; - {tcp_closed, Sock} -> - ok; - {tcp_error, Sock, Reason} -> - {error, Reason} - after Timeout -> - {error, timeout} - end - end. - - -%% -%% HELP FUNCTIONS -%% - -wait_ack(_, [], _) -> - ok; -wait_ack(AccPids0, Pids, Timeout) -> - ?debug("#### CONTROLLER: waiting for ~w~n", [Pids]), - receive - {one_accept_done, Pid} -> - case lists:delete(Pid, AccPids0) of - [] -> - wait_ack([], Pids, Timeout); - [AccPid| AccPids1] -> - AccPid ! {continue_accept, self()}, - wait_ack(AccPids1, Pids, Timeout) - end; - {'EXIT', Pid, normal} -> - wait_ack(AccPids0, lists:delete(Pid, Pids), Timeout); - {'EXIT', Pid, Reason} -> - ?error("#### CONTROLLER got abnormal exit: ~w, ~w~n", - [Pid, Reason]), - {error, Reason} - after Timeout -> - ?error("#### CONTROLLER exiting because of timeout = ~w~n", - [Timeout]), - {error, Timeout} - end. - - -%% -%% ack_lsock(Pid, LSock) -%% -ack_lsock(Pid, LSock) -> - Pid ! {lsock, self(), LSock}. - -wait_lsock(Pid, Timeout) -> - receive - {lsock, Pid, LSock} -> - {ok, LSock} - after Timeout -> - exit(timeout) - end. - -%% -%% sync(Pids) -%% -sync(Pids) -> - lists:foreach(fun (Pid) -> Pid ! {self(), sync} end, Pids). - -%% -%% wait_sync(St) -%% -wait_sync(St) -> - Pid = St#st.parent, - receive - {Pid, sync} -> - ok - end. - -%% -%% wait(Time) -%% -wait(Time) -> - receive - after Time -> - ok - end. - -%% -%% mk_msg(Size) -%% -mk_msg(Size) -> - mk_msg(0, Size, []). - -mk_msg(_, 0, Acc) -> - Acc; -mk_msg(Pos, Size, Acc) -> - C = (((Pos + Size) rem 256) - 1) band 255, - mk_msg(Pos, Size - 1, [C| Acc]). - -%% -%% get_protomod(Config) -%% -get_protomod(Config) -> - case lists:keysearch(protomod, 1, Config) of - {value, {_, ProtoMod}} -> - ProtoMod; - false -> - ssl - end. - -%% -%% get_serialize_accept(Config) -%% -get_serialize_accept(Config) -> - case lists:keysearch(serialize_accept, 1, Config) of - {value, {_, Val}} -> - Val; - false -> - false - end. - diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index b7916b96eb..46a8112a41 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -22,6 +22,7 @@ -include("test_server.hrl"). -include("test_server_line.hrl"). +-include_lib("public_key/include/public_key.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). @@ -673,3 +674,16 @@ cipher_result(Socket, Result) -> session_info_result(Socket) -> ssl:session_info(Socket). + + +public_key(#'PrivateKeyInfo'{privateKeyAlgorithm = + #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?rsaEncryption}, + privateKey = Key}) -> + public_key:der_decode('RSAPrivateKey', iolist_to_binary(Key)); + +public_key(#'PrivateKeyInfo'{privateKeyAlgorithm = + #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'id-dsa'}, + privateKey = Key}) -> + public_key:der_decode('DSAPrivateKey', iolist_to_binary(Key)); +public_key(Key) -> + Key. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 64a6a9eaf8..8ccbb3ffa1 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -109,6 +109,9 @@ special_init(TestCase, Config) TestCase == erlang_server_openssl_client_no_wrap_sequence_number -> check_sane_openssl_renegotaite(Config); +special_init(ssl2_erlang_server_openssl_client, Config) -> + check_sane_openssl_sslv2(Config); + special_init(_, Config) -> Config. @@ -1433,3 +1436,11 @@ check_sane_openssl_renegotaite(Config) -> _ -> Config end. + +check_sane_openssl_sslv2(Config) -> + case os:cmd("openssl version") of + "OpenSSL 1.0.0e" ++ _ -> + {skip, "Known option bug"}; + _ -> + Config + end. diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 8286201df4..2255798f1d 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 4.1.6 +SSL_VSN = 5.0 diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml index 6f3ed7af98..7042c84437 100644 --- a/lib/stdlib/doc/src/lists.xml +++ b/lib/stdlib/doc/src/lists.xml @@ -240,7 +240,7 @@ flatmap(Fun, List1) -> <func> <name name="keydelete" arity="3"/> <fsummary>Delete an element from a list of tuples</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns a copy of <c><anno>TupleList1</anno></c> where the first occurrence of a tuple whose <c><anno>N</anno></c>th element compares equal to @@ -266,7 +266,7 @@ flatmap(Fun, List1) -> <func> <name name="keymap" arity="3"/> <fsummary>Map a function over a list of tuples</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns a list of tuples where, for each tuple in <c><anno>TupleList1</anno></c>, the <c><anno>N</anno></c>th element <c><anno>Term1</anno></c> of the tuple @@ -298,7 +298,7 @@ flatmap(Fun, List1) -> <func> <name name="keymerge" arity="3"/> <fsummary>Merge two key-sorted lists of tuples</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns the sorted list formed by merging <c><anno>TupleList1</anno></c> and <c><anno>TupleList2</anno></c>. The merge is performed on @@ -312,7 +312,7 @@ flatmap(Fun, List1) -> <func> <name name="keyreplace" arity="4"/> <fsummary>Replace an element in a list of tuples</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns a copy of <c><anno>TupleList1</anno></c> where the first occurrence of a <c>T</c> tuple whose <c><anno>N</anno></c>th element @@ -342,7 +342,7 @@ flatmap(Fun, List1) -> <func> <name name="keysort" arity="2"/> <fsummary>Sort a list of tuples</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns a list containing the sorted elements of the list <c><anno>TupleList1</anno></c>. Sorting is performed on the <c><anno>N</anno></c>th @@ -352,7 +352,7 @@ flatmap(Fun, List1) -> <func> <name name="keystore" arity="4"/> <fsummary>Store an element in a list of tuples</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns a copy of <c><anno>TupleList1</anno></c> where the first occurrence of a tuple <c>T</c> whose <c><anno>N</anno></c>th element @@ -366,7 +366,7 @@ flatmap(Fun, List1) -> <func> <name name="keytake" arity="3"/> <fsummary>Extract an element from a list of tuples</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Searches the list of tuples <c><anno>TupleList1</anno></c> for a tuple whose <c><anno>N</anno></c>th element compares equal to <c><anno>Key</anno></c>. @@ -500,7 +500,7 @@ flatmap(Fun, List1) -> <func> <name name="nth" arity="2"/> <fsummary>Return the Nth element of a list</fsummary> - <type_desc variable="N">1..length(List)</type_desc> + <type_desc variable="N">1..length(<anno>List</anno>)</type_desc> <desc> <p>Returns the <c><anno>N</anno></c>th element of <c><anno>List</anno></c>. For example:</p> <pre> @@ -511,7 +511,7 @@ c</pre> <func> <name name="nthtail" arity="2"/> <fsummary>Return the Nth tail of a list</fsummary> - <type_desc variable="N">0..length(List)</type_desc> + <type_desc variable="N">0..length(<anno>List</anno>)</type_desc> <desc> <p>Returns the <c><anno>N</anno></c>th tail of <c><anno>List</anno></c>, that is, the sublist of <c><anno>List</anno></c> starting at <c><anno>N</anno>+1</c> and continuing up to @@ -630,7 +630,7 @@ length(lists:seq(From, To, Incr)) == (To-From+Incr) div Incr</code> <func> <name name="split" arity="2"/> <fsummary>Split a list into two lists</fsummary> - <type_desc variable="N">0..length(List1)</type_desc> + <type_desc variable="N">0..length(<anno>List1</anno>)</type_desc> <desc> <p>Splits <c><anno>List1</anno></c> into <c><anno>List2</anno></c> and <c><anno>List3</anno></c>. <c><anno>List2</anno></c> contains the first <c><anno>N</anno></c> elements and @@ -670,7 +670,7 @@ splitwith(Pred, List) -> <func> <name name="sublist" arity="3"/> <fsummary>Return a sub-list starting at a given position and with a given number of elements</fsummary> - <type_desc variable="Start">1..(length(List1)+1)</type_desc> + <type_desc variable="Start">1..(length(<anno>List1</anno>)+1)</type_desc> <desc> <p>Returns the sub-list of <c><anno>List1</anno></c> starting at <c><anno>Start</anno></c> and with (max) <c><anno>Len</anno></c> elements. It is not an error for @@ -732,7 +732,7 @@ splitwith(Pred, List) -> <func> <name name="ukeymerge" arity="3"/> <fsummary>Merge two key-sorted lists of tuples, removing duplicates</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns the sorted list formed by merging <c><anno>TupleList1</anno></c> and <c><anno>TupleList2</anno></c>. The merge is performed on the @@ -746,7 +746,7 @@ splitwith(Pred, List) -> <func> <name name="ukeysort" arity="2"/> <fsummary>Sort a list of tuples, removing duplicates</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns a list containing the sorted elements of the list <c><anno>TupleList1</anno></c> where all but the first tuple of the diff --git a/lib/stdlib/doc/src/make.dep b/lib/stdlib/doc/src/make.dep deleted file mode 100644 index 48ee6209ef..0000000000 --- a/lib/stdlib/doc/src/make.dep +++ /dev/null @@ -1,40 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: array.tex base64.tex beam_lib.tex book.tex \ - c.tex calendar.tex dets.tex dict.tex digraph.tex \ - digraph_utils.tex epp.tex erl_eval.tex erl_expand_records.tex \ - erl_id_trans.tex erl_internal.tex erl_lint.tex \ - erl_parse.tex erl_pp.tex erl_scan.tex erl_tar.tex \ - ets.tex file_sorter.tex filelib.tex filename.tex \ - gb_sets.tex gb_trees.tex gen_event.tex gen_fsm.tex \ - gen_server.tex io.tex io_lib.tex io_protocol.tex \ - lib.tex lists.tex log_mf_h.tex math.tex ms_transform.tex \ - orddict.tex ordsets.tex part.tex pg.tex pool.tex \ - proc_lib.tex proplists.tex qlc.tex queue.tex \ - random.tex re.tex ref_man.tex regexp.tex sets.tex \ - shell.tex shell_default.tex slave.tex sofs.tex \ - stdlib_app.tex string.tex supervisor.tex supervisor_bridge.tex \ - sys.tex timer.tex unicode.tex unicode_usage.tex \ - win32reg.tex zip.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: ushell1.ps - diff --git a/lib/stdlib/doc/src/random.xml b/lib/stdlib/doc/src/random.xml index 93affc3191..1b8fa44883 100644 --- a/lib/stdlib/doc/src/random.xml +++ b/lib/stdlib/doc/src/random.xml @@ -136,6 +136,11 @@ <c>random_seed</c> to remember the current seed.</p> <p>If a process calls <c>uniform/0</c> or <c>uniform/1</c> without setting a seed first, <c>seed/0</c> is called automatically.</p> + <p>The implementation changed in R15. Upgrading to R15 will break + applications that expect a specific output for a given seed. The output + is still deterministic number series, but different compared to releases + older than R15. The seed <c>{0,0,0}</c> will for example no longer + produce a flawed series of only zeros.</p> </section> </erlref> diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index ec607d6e4c..30514dfee9 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -93,6 +93,10 @@ instead the child specification identifier is used, <c>terminate_child/2</c> will return <c>{error,simple_one_for_one}</c>.</p> + <p>Because a <c>simple_one_for_one</c> supervisor could have many + children, it shuts them all down at same time. So, order in which they + are stopped is not defined. For the same reason, it could have an + overhead with regards to the <c>Shutdown</c> strategy.</p> </item> </list> <p>To prevent a supervisor from getting into an infinite loop of @@ -169,7 +173,15 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} <c>exit(Child,kill)</c>.</p> <p>If the child process is another supervisor, <c>Shutdown</c> should be set to <c>infinity</c> to give the subtree ample - time to shutdown.</p> + time to shutdown. It is also allowed to set it to <c>infinity</c>, + if the child process is a worker.</p> + <warning> + <p>Be careful by setting the <c>Shutdown</c> strategy to + <c>infinity</c> when the child process is a worker. Because, in this + situation, the termination of the supervision tree depends on the + child process, it must be implemented in a safe way and its cleanup + procedure must always return.</p> + </warning> <p><em>Important note on simple-one-for-one supervisors:</em> The dynamically created child processes of a simple-one-for-one supervisor are not explicitly killed, diff --git a/lib/stdlib/doc/src/unicode.xml b/lib/stdlib/doc/src/unicode.xml index d02763f75c..1001ebbae4 100644 --- a/lib/stdlib/doc/src/unicode.xml +++ b/lib/stdlib/doc/src/unicode.xml @@ -203,8 +203,7 @@ <item>greater than <c>16#10FFFF</c> (the maximum unicode character),</item> <item>in the range <c>16#D800</c> to <c>16#DFFF</c> - (invalid unicode range)</item> - <item>or equal to 16#FFFE or 16#FFFF (non characters)</item> + (invalid range reserved for UTF-16 surrogate pairs)</item> </list> is found. </item> diff --git a/lib/stdlib/examples/erl_id_trans.erl b/lib/stdlib/examples/erl_id_trans.erl index b63acdd40a..72e41d6473 100644 --- a/lib/stdlib/examples/erl_id_trans.erl +++ b/lib/stdlib/examples/erl_id_trans.erl @@ -419,7 +419,14 @@ expr({'fun',Line,Body}) -> {'fun',Line,{clauses,Cs1}}; {function,F,A} -> {'fun',Line,{function,F,A}}; - {function,M,F,A} -> %R10B-6: fun M:F/A. + {function,M,F,A} when is_atom(M), is_atom(F), is_integer(A) -> + %% R10B-6: fun M:F/A. (Backward compatibility) + {'fun',Line,{function,M,F,A}}; + {function,M0,F0,A0} -> + %% R15: fun M:F/A with variables. + M = expr(M0), + F = expr(F0), + A = expr(A0), {'fun',Line,{function,M,F,A}} end; expr({call,Line,F0,As0}) -> diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index fdfbb2e998..e9a5e6831e 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -224,7 +224,7 @@ version(File) -> MD5 :: binary(). md5(File) -> - case catch read_significant_chunks(File) of + case catch read_significant_chunks(File, md5_chunks()) of {ok, {Module, Chunks0}} -> Chunks = filter_funtab(Chunks0), {ok, {Module, erlang:md5([C || {_Id, C} <- Chunks])}}; @@ -395,7 +395,7 @@ strip_fils(Files) -> %% -> {ok, {Mod, FileName}} | {ok, {Mod, binary()}} | throw(Error) strip_file(File) -> - {ok, {Mod, Chunks}} = read_significant_chunks(File), + {ok, {Mod, Chunks}} = read_significant_chunks(File, significant_chunks()), {ok, Stripped0} = build_module(Chunks), Stripped = compress(Stripped0), case File of @@ -453,8 +453,8 @@ is_useless_chunk("CInf") -> true; is_useless_chunk(_) -> false. %% -> {ok, {Module, Chunks}} | throw(Error) -read_significant_chunks(File) -> - case read_chunk_data(File, significant_chunks(), [allow_missing_chunks]) of +read_significant_chunks(File, ChunkList) -> + case read_chunk_data(File, ChunkList, [allow_missing_chunks]) of {ok, {Module, Chunks0}} -> Mandatory = mandatory_chunks(), Chunks = filter_significant_chunks(Chunks0, Mandatory, File, Module), @@ -835,12 +835,15 @@ file_error(FileName, {error, Reason}) -> error(Reason) -> throw({error, ?MODULE, Reason}). - -%% The following chunks are significant when calculating the MD5 for a module, -%% and also the modules that must be retained when stripping a file. -%% They are listed in the order that they should be MD5:ed. +%% The following chunks must be kept when stripping a BEAM file. significant_chunks() -> + ["Line" | md5_chunks()]. + +%% The following chunks are significant when calculating the MD5 +%% for a module. They are listed in the order that they should be MD5:ed. + +md5_chunks() -> ["Atom", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT"]. %% The following chunks are mandatory in every Beam file. diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index febfdd6285..a920921a5e 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -797,7 +797,7 @@ appcall(App, M, F, Args) -> catch error:undef -> case erlang:get_stacktrace() of - [{M,F,Args}|_] -> + [{M,F,Args,_}|_] -> Arity = length(Args), io:format("Call to ~w:~w/~w in application ~w failed.\n", [M,F,Arity,App]); diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index fa0641ffd9..c0f9ce34b0 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1754,17 +1754,6 @@ system_code_change(State, _Module, _OldVsn, _Extra) -> %%% Internal functions %%%---------------------------------------------------------------------- -constants(FH, FileName) -> - Version = FH#fileheader.version, - if - Version =< 8 -> - dets_v8:constants(); - Version =:= 9 -> - dets_v9:constants(); - true -> - throw({error, {not_a_dets_file, FileName}}) - end. - %% -> {ok, Fd, fileheader()} | throw(Error) read_file_header(FileName, Access, RamFile) -> BF = if @@ -1842,7 +1831,11 @@ do_bchunk_init(Head, Tab) -> {H2, {error, old_version}}; Parms -> L = dets_utils:all_allocated(H2), - C0 = #dets_cont{no_objs = default, bin = <<>>, alloc = L}, + Bin = if + L =:= <<>> -> eof; + true -> <<>> + end, + C0 = #dets_cont{no_objs = default, bin = Bin, alloc = L}, BinParms = term_to_binary(Parms), {H2, {C0#dets_cont{tab = Tab, proc = self(),what = bchunk}, [BinParms]}} @@ -2475,10 +2468,23 @@ fopen2(Fname, Tab) -> %% Fd is not always closed upon error, but exit is soon called. {ok, Fd, FH} = read_file_header(Fname, Acc, Ram), Mod = FH#fileheader.mod, - case Mod:check_file_header(FH, Fd) of - {error, not_closed} -> - io:format(user,"dets: file ~p not properly closed, " - "repairing ...~n", [Fname]), + Do = case Mod:check_file_header(FH, Fd) of + {ok, Head1, ExtraInfo} -> + Head2 = Head1#head{filename = Fname}, + try {ok, Mod:init_freelist(Head2, ExtraInfo)} + catch + throw:_ -> + {repair, " has bad free lists, repairing ..."} + end; + {error, not_closed} -> + M = " not properly closed, repairing ...", + {repair, M}; + Else -> + Else + end, + case Do of + {repair, Mess} -> + io:format(user, "dets: file ~p~s~n", [Fname, Mess]), Version = default, case fsck(Fd, Tab, Fname, FH, default, default, Version) of ok -> @@ -2486,9 +2492,9 @@ fopen2(Fname, Tab) -> Error -> throw(Error) end; - {ok, Head, ExtraInfo} -> + {ok, Head} -> open_final(Head, Fname, Acc, Ram, ?DEFAULT_CACHE, - Tab, ExtraInfo, false); + Tab, false); {error, Reason} -> throw({error, {Reason, Fname}}) end; @@ -2520,12 +2526,13 @@ fopen_existing_file(Tab, OpenArgs) -> V9 = (Version =:= 9) or (Version =:= default), MinF = (MinSlots =:= default) or (MinSlots =:= FH#fileheader.min_no_slots), MaxF = (MaxSlots =:= default) or (MaxSlots =:= FH#fileheader.max_no_slots), - Do = case (FH#fileheader.mod):check_file_header(FH, Fd) of + Mod = (FH#fileheader.mod), + Wh = case Mod:check_file_header(FH, Fd) of {ok, Head, true} when Rep =:= force, Acc =:= read_write, FH#fileheader.version =:= 9, FH#fileheader.no_colls =/= undefined, MinF, MaxF, V9 -> - {compact, Head}; + {compact, Head, true}; {ok, _Head, _Extra} when Rep =:= force, Acc =:= read -> throw({error, {access_mode, Fname}}); {ok, Head, need_compacting} when Acc =:= read -> @@ -2555,6 +2562,17 @@ fopen_existing_file(Tab, OpenArgs) -> {error, Reason} -> throw({error, {Reason, Fname}}) end, + Do = case Wh of + {Tag, Hd, Extra} when Tag =:= final; Tag =:= compact -> + Hd1 = Hd#head{filename = Fname}, + try {Tag, Mod:init_freelist(Hd1, Extra)} + catch + throw:_ -> + {repair, " has bad free lists, repairing ..."} + end; + Else -> + Else + end, case Do of _ when FH#fileheader.type =/= Type -> throw({error, {type_mismatch, Fname}}); @@ -2563,8 +2581,7 @@ fopen_existing_file(Tab, OpenArgs) -> {compact, SourceHead} -> io:format(user, "dets: file ~p is now compacted ...~n", [Fname]), {ok, NewSourceHead} = open_final(SourceHead, Fname, read, false, - ?DEFAULT_CACHE, Tab, true, - Debug), + ?DEFAULT_CACHE, Tab, Debug), case catch compact(NewSourceHead) of ok -> erlang:garbage_collect(), @@ -2584,9 +2601,9 @@ fopen_existing_file(Tab, OpenArgs) -> Version, OpenArgs); _ when FH#fileheader.version =/= Version, Version =/= default -> throw({error, {version_mismatch, Fname}}); - {final, H, EI} -> + {final, H} -> H1 = H#head{auto_save = Auto}, - open_final(H1, Fname, Acc, Ram, CacheSz, Tab, EI, Debug) + open_final(H1, Fname, Acc, Ram, CacheSz, Tab, Debug) end. do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) -> @@ -2600,19 +2617,16 @@ do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) -> end. %% -> {ok, head()} | throw(Error) -open_final(Head, Fname, Acc, Ram, CacheSz, Tab, ExtraInfo, Debug) -> +open_final(Head, Fname, Acc, Ram, CacheSz, Tab, Debug) -> Head1 = Head#head{access = Acc, ram_file = Ram, filename = Fname, name = Tab, cache = dets_utils:new_cache(CacheSz)}, init_disk_map(Head1#head.version, Tab, Debug), - Mod = Head#head.mod, - Mod:cache_segps(Head1#head.fptr, Fname, Head1#head.next), - Ftab = Mod:init_freelist(Head1, ExtraInfo), + (Head1#head.mod):cache_segps(Head1#head.fptr, Fname, Head1#head.next), check_growth(Head1), - NewHead = Head1#head{freelists = Ftab}, - {ok, NewHead}. + {ok, Head1}. %% -> {ok, head()} | throw(Error) fopen_init_file(Tab, OpenArgs) -> @@ -3139,8 +3153,12 @@ init_scan(Head, NoObjs) -> check_safe_fixtable(Head), FreeLists = dets_utils:get_freelists(Head), Base = Head#head.base, - {From, To} = dets_utils:find_next_allocated(FreeLists, Base, Base), - #dets_cont{no_objs = NoObjs, bin = <<>>, alloc = {From, To, <<>>}}. + case dets_utils:find_next_allocated(FreeLists, Base, Base) of + {From, To} -> + #dets_cont{no_objs = NoObjs, bin = <<>>, alloc = {From,To,<<>>}}; + none -> + #dets_cont{no_objs = NoObjs, bin = eof, alloc = <<>>} + end. check_safe_fixtable(Head) -> case (Head#head.fixed =:= false) andalso @@ -3241,18 +3259,20 @@ view(FileName) -> case catch read_file_header(FileName, read, false) of {ok, Fd, FH} -> Mod = FH#fileheader.mod, - case Mod:check_file_header(FH, Fd) of - {ok, H0, ExtraInfo} -> - Ftab = Mod:init_freelist(H0, ExtraInfo), - {_Bump, Base} = constants(FH, FileName), - H = H0#head{freelists=Ftab, base = Base}, - v_free_list(H), - Mod:v_segments(H), - file:close(Fd); - X -> - file:close(Fd), - X - end; + try Mod:check_file_header(FH, Fd) of + {ok, H0, ExtraInfo} -> + Mod = FH#fileheader.mod, + case Mod:check_file_header(FH, Fd) of + {ok, H0, ExtraInfo} -> + H = Mod:init_freelist(H0, ExtraInfo), + v_free_list(H), + Mod:v_segments(H), + ok; + X -> + X + end + after file:close(Fd) + end; X -> X end. diff --git a/lib/stdlib/src/dets.hrl b/lib/stdlib/src/dets.hrl index fbffc9d008..a3f99357a2 100644 --- a/lib/stdlib/src/dets.hrl +++ b/lib/stdlib/src/dets.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-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 @@ -92,6 +92,7 @@ %% Info extracted from the file header. -record(fileheader, { freelist, + fl_base, cookie, closed_properly, type, diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl index cdd38d5604..3e962a1c8b 100644 --- a/lib/stdlib/src/dets_v8.erl +++ b/lib/stdlib/src/dets_v8.erl @@ -21,7 +21,7 @@ %% Dets files, implementation part. This module handles versions up to %% and including 8(c). To be called from dets.erl only. --export([constants/0, mark_dirty/1, read_file_header/2, +-export([mark_dirty/1, read_file_header/2, check_file_header/2, do_perform_save/1, initiate_file/11, init_freelist/2, fsck_input/4, bulk_input/3, output_objs/4, write_cache/1, may_grow/3, @@ -196,10 +196,6 @@ %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). -%% {Bump} -constants() -> - {?BUMP, ?BASE}. - %% -> ok | throw({NewHead,Error}) mark_dirty(Head) -> Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}], @@ -308,8 +304,9 @@ init_freelist(Head, {convert_freelist,_Version}) -> Pos = Head#head.freelists_p, case catch prterm(Head, Pos, ?OHDSZ) of {0, _Sz, Term} -> - FreeList = lists:reverse(Term), - dets_utils:init_slots_from_old_file(FreeList, Ftab); + FreeList1 = lists:reverse(Term), + FreeList = dets_utils:init_slots_from_old_file(FreeList1, Ftab), + Head#head{freelists = FreeList, base = ?BASE}; _ -> throw({error, {bad_freelists, Head#head.filename}}) end; @@ -318,7 +315,7 @@ init_freelist(Head, _) -> Pos = Head#head.freelists_p, case catch prterm(Head, Pos, ?OHDSZ) of {0, _Sz, Term} -> - Term; + Head#head{freelists = Term, base = ?BASE}; _ -> throw({error, {bad_freelists, Head#head.filename}}) end. @@ -331,6 +328,7 @@ read_file_header(Fd, FileName) -> {ok, EOF} = dets_utils:position_close(Fd, FileName, eof), {ok, <<FileSize:32>>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4), FH = #fileheader{freelist = Freelist, + fl_base = ?BASE, cookie = Cookie, closed_properly = CP, type = dets_utils:code_to_type(Type2), @@ -413,7 +411,7 @@ check_file_header(FH, Fd) -> version = ?FILE_FORMAT_VERSION, mod = ?MODULE, bump = ?BUMP, - base = ?BASE}, + base = FH#fileheader.fl_base}, {ok, H, ExtraInfo}; Error -> Error diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl index 132af01f79..f577b4410f 100644 --- a/lib/stdlib/src/dets_v9.erl +++ b/lib/stdlib/src/dets_v9.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-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 @@ -21,7 +21,7 @@ %% Dets files, implementation part. This module handles version 9. %% To be called from dets.erl only. --export([constants/0, mark_dirty/1, read_file_header/2, +-export([mark_dirty/1, read_file_header/2, check_file_header/2, do_perform_save/1, initiate_file/11, prep_table_copy/9, init_freelist/2, fsck_input/4, bulk_input/3, output_objs/4, bchunk_init/2, @@ -70,6 +70,17 @@ %% 16 MD5-sum for the 44 plus 112 bytes before the MD5-sum. %% (FreelistsPointer, Cookie and ClosedProperly are not digested.) %% 128 Reserved for future versions. Initially zeros. +%% Version 9(d), introduced in R15A, has instead: +%% 112 28 counters for the buddy system sizes (as for 9(b)). +%% 16 MD5-sum for the 44 plus 112 bytes before the MD5-sum. +%% (FreelistsPointer, Cookie and ClosedProperly are not digested.) +%% 4 Base of the buddy system. +%% 0 (zero) if the base is equal to ?BASE. Compatible with R14B. +%% File size at the end of the file is RealFileSize - Base. +%% The reason for modifying file size is that when a file created +%% by R15 is read by R14 a repair takes place immediately, which +%% is acceptable when downgrading. +%% 124 Reserved for future versions. Initially zeros. %% --- %% ------------------ end of file header %% 4*256 SegmentArray Pointers. @@ -86,7 +97,7 @@ %% ----------------------------- %% ??? Free lists %% ----------------------------- -%% 4 File size, in bytes. +%% 4 File size, in bytes. See 9(d) obove. %% Before we can find an object we must find the slot where the %% object resides. Each slot is a (possibly empty) list (or chain) of @@ -177,14 +188,14 @@ %%% File header %%% --define(RESERVED, 128). % Reserved for future use. +-define(RESERVED, 124). % Reserved for future use. -define(COLL_CNTRS, (28*4)). % Counters for the buddy system. -define(MD5SZ, 16). +-define(FL_BASE, 4). --define(HEADSZ, - 56+?COLL_CNTRS+?MD5SZ). % The size of the file header, in bytes, - % not including the reserved part. +-define(HEADSZ, 56+?COLL_CNTRS % The size of the file header, in bytes, + +?MD5SZ+?FL_BASE). % not including the reserved part. -define(HEADEND, (?HEADSZ+?RESERVED)). % End of header and reserved area. -define(SEGSZ, 512). % Size of a segment, in words. SZOBJP*SEGSZP. @@ -270,10 +281,6 @@ %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). -%% {Bump} -constants() -> - {?BUMP, ?BASE}. - %% -> ok | throw({NewHead,Error}) mark_dirty(Head) -> Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}], @@ -356,7 +363,7 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz, cache = dets_utils:new_cache(CacheSz), version = ?FILE_FORMAT_VERSION, bump = ?BUMP, - base = ?BASE, + base = ?BASE, % to be overwritten mod = ?MODULE }, @@ -378,13 +385,20 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz, {Head1, Ws1} = init_parts(Head0, 0, no_parts(Next), Zero, []), NoSegs = no_segs(Next), - {Head, WsI, WsP} = init_segments(Head1, 0, NoSegs, Zero, [], []), + {Head2, WsI, WsP} = init_segments(Head1, 0, NoSegs, Zero, [], []), Ws2 = if DoInitSegments -> WsP ++ WsI; true -> WsP end, dets_utils:pwrite(Fd, Fname, [W0 | lists:append(Ws1) ++ Ws2]), - true = hash_invars(Head), + true = hash_invars(Head2), + %% The allocations that have been made so far (parts, segments) + %% are permanent; the table will never shrink. Therefore the base + %% of the Buddy system can be set to the first free object. + %% This is used in allocate_all(), see below. + {_, Where, _} = dets_utils:alloc(Head2, ?BUMP), + NewFtab = dets_utils:init_alloc(Where), + Head = Head2#head{freelists = NewFtab, base = Where}, {ok, Head}. %% Returns a power of two not less than 256. @@ -451,8 +465,9 @@ read_file_header(Fd, FileName) -> Version:32, M:32, Next:32, Kp:32, NoObjects:32, NoKeys:32, MinNoSlots:32, MaxNoSlots:32, HashMethod:32, N:32, NoCollsB:?COLL_CNTRS/binary, - MD5:?MD5SZ/binary>> = Bin, - <<_:12/binary,MD5DigestedPart:(?HEADSZ-?MD5SZ-12)/binary,_/binary>> = Bin, + MD5:?MD5SZ/binary, FlBase:32>> = Bin, + <<_:12/binary,MD5DigestedPart:(?HEADSZ-?MD5SZ-?FL_BASE-12)/binary, + _/binary>> = Bin, {ok, EOF} = dets_utils:position_close(Fd, FileName, eof), {ok, <<FileSize:32>>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4), {CL, <<>>} = lists:foldl(fun(LSz, {Acc,<<NN:32,R/binary>>}) -> @@ -468,8 +483,12 @@ read_file_header(Fd, FileName) -> true -> lists:reverse(CL) end, - + Base = case FlBase of + 0 -> ?BASE; + _ -> FlBase + end, FH = #fileheader{freelist = FreeList, + fl_base = Base, cookie = Cookie, closed_properly = CP, type = dets_utils:code_to_type(Type2), @@ -486,7 +505,7 @@ read_file_header(Fd, FileName) -> read_md5 = MD5, has_md5 = <<0:?MD5SZ/unit:8>> =/= MD5, md5 = erlang:md5(MD5DigestedPart), - trailer = FileSize, + trailer = FileSize + FlBase, eof = EOF, n = N, mod = ?MODULE}, @@ -544,7 +563,7 @@ check_file_header(FH, Fd) -> version = ?FILE_FORMAT_VERSION, mod = ?MODULE, bump = ?BUMP, - base = ?BASE}, + base = FH#fileheader.fl_base}, {ok, H, ExtraInfo}; Error -> Error @@ -1185,41 +1204,25 @@ write_loop(Head, BytesToWrite, Bin) -> write_loop(Head, BytesToWrite, SmallBin). %% By allocating bigger objects before smaller ones, holes in the -%% buddy system memory map are avoided. Unfortunately, the segments -%% are always allocated first, so if there are objects bigger than a -%% segment, there is a hole to handle. (Haven't considered placing the -%% segments among other objects of the same size.) +%% buddy system memory map are avoided. allocate_all_objects(Head, SizeT) -> DTL = lists:reverse(lists:keysort(1, ets:tab2list(SizeT))), MaxSz = element(1, hd(DTL)), - SegSize = ?ACTUAL_SEG_SIZE, - {Head1, HSz, HN, HA} = alloc_hole(MaxSz, Head, SegSize), - {Head2, NL} = allocate_all(Head1, DTL, []), + {Head1, NL} = allocate_all(Head, DTL, []), %% Find the position that will be the end of the file by allocating %% a minimal object. - {_Head, EndOfFile, _} = dets_utils:alloc(Head2, ?BUMP), - Head3 = free_hole(Head2, HSz, HN, HA), - NewHead = Head3#head{maxobjsize = max_objsize(Head3#head.no_collections)}, + {_Head, EndOfFile, _} = dets_utils:alloc(Head1, ?BUMP), + NewHead = Head1#head{maxobjsize = max_objsize(Head1#head.no_collections)}, {NewHead, NL, MaxSz, EndOfFile}. -alloc_hole(LSize, Head, SegSz) when ?POW(LSize-1) > SegSz -> - Size = ?POW(LSize-1), - {_, SegAddr, _} = dets_utils:alloc(Head, adjsz(SegSz)), - {_, Addr, _} = dets_utils:alloc(Head, adjsz(Size)), - N = (Addr - SegAddr) div SegSz, - Head1 = dets_utils:alloc_many(Head, SegSz, N, SegAddr), - {Head1, SegSz, N, SegAddr}; -alloc_hole(_MaxSz, Head, _SegSz) -> - {Head, 0, 0, 0}. - -free_hole(Head, _Size, 0, _Addr) -> - Head; -free_hole(Head, Size, N, Addr) -> - {Head1, _} = dets_utils:free(Head, Addr, adjsz(Size)), - free_hole(Head1, Size, N-1, Addr+Size). - %% One (temporary) file for each buddy size, write all objects of that %% size to the file. +%% +%% Before R15 a "hole" was needed before the first bucket if the size +%% of the biggest bucket was greater than the size of a segment. The +%% hole proved to be a problem with almost full tables with huge +%% buckets. Since R15 the hole is no longer needed due to the fact +%% that the base of the Buddy system is flexible. allocate_all(Head, [{?FSCK_SEGMENT,_,Data,_}], L) -> %% And one file for the segments... %% Note that space for the array parts and the segments has @@ -1593,23 +1596,28 @@ do_perform_save(H) -> H1 = H#head{freelists_p = FreeListsPointer}, {FLW, FLSize} = free_lists_to_file(H1), FileSize = FreeListsPointer + FLSize + 4, - ok = dets_utils:write(H1, [FLW | <<FileSize:32>>]), + AdjustedFileSize = case H#head.base of + ?BASE -> FileSize; + Base -> FileSize - Base + end, + ok = dets_utils:write(H1, [FLW | <<AdjustedFileSize:32>>]), FileHeader = file_header(H1, FreeListsPointer, ?CLOSED_PROPERLY), case dets_utils:debug_mode() of true -> - TmpHead = H1#head{freelists = init_freelist(H1, true), - fixed = false}, + TmpHead0 = init_freelist(H1#head{fixed = false}, true), + TmpHead = TmpHead0#head{base = H1#head.base}, case catch dets_utils:all_allocated_as_list(TmpHead) =:= dets_utils:all_allocated_as_list(H1) - of + of true -> dets_utils:pwrite(H1, [{0, FileHeader}]); _ -> + throw( dets_utils:corrupt_reason(H1, {failed_to_save_free_lists, FreeListsPointer, TmpHead#head.freelists, - H1#head.freelists}) + H1#head.freelists})) end; false -> dets_utils:pwrite(H1, [{0, FileHeader}]) @@ -1648,7 +1656,11 @@ file_header(Head, FreeListsPointer, ClosedProperly, NoColls) -> true -> erlang:md5(DigH); false -> <<0:?MD5SZ/unit:8>> end, - [H1, DigH, MD5 | <<0:?RESERVED/unit:8>>]. + Base = case Head#head.base of + ?BASE -> <<0:32>>; + FlBase -> <<FlBase:32>> + end, + [H1, DigH, MD5, Base | <<0:?RESERVED/unit:8>>]. %% Going through some trouble to avoid creating one single binary for %% the free lists. If the free lists are huge, binary_to_term and @@ -1695,8 +1707,8 @@ free_lists_from_file(H, Pos) -> case catch bin_to_tree([], H, start, FL, -1, []) of {'EXIT', _} -> throw({error, {bad_freelists, H#head.filename}}); - Reply -> - Reply + Ftab -> + H#head{freelists = Ftab, base = ?BASE} end. bin_to_tree(Bin, H, LastPos, Ftab, A0, L) -> diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index d804c1dee5..ccc14610d7 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -267,8 +267,10 @@ init_server(Pid, Name, File, AtLocation, Path, Pdm, Pre) -> case user_predef(Pdm, Ms0) of {ok,Ms1} -> epp_reply(Pid, {ok,self()}), + %% ensure directory of current source file is first in path + Path1 = [filename:dirname(Name) | Path], St = #epp{file=File, location=AtLocation, delta=0, name=Name, - name2=Name, path=Path, macs=Ms1, pre_opened = Pre}, + name2=Name, path=Path1, macs=Ms1, pre_opened = Pre}, From = wait_request(St), enter_file_reply(From, Name, AtLocation, AtLocation), wait_req_scan(St); @@ -360,18 +362,18 @@ wait_req_skip(St, Sis) -> From = wait_request(St), skip_toks(From, St, Sis). -%% enter_file(Path, FileName, IncludeToken, From, EppState) +%% enter_file(FileName, IncludeToken, From, EppState) %% leave_file(From, EppState) %% Handle entering and leaving included files. Notify caller when the %% current file is changed. Note it is an error to exit a file if we are %% in a conditional. These functions never return. -enter_file(_Path, _NewName, Inc, From, St) +enter_file(_NewName, Inc, From, St) when length(St#epp.sstk) >= 8 -> epp_reply(From, {error,{abs_loc(Inc),epp,{depth,"include"}}}), wait_req_scan(St); -enter_file(Path, NewName, Inc, From, St) -> - case file:path_open(Path, NewName, [read]) of +enter_file(NewName, Inc, From, St) -> + case file:path_open(St#epp.path, NewName, [read]) of {ok,NewF,Pname} -> Loc = start_loc(St#epp.location), wait_req_scan(enter_file2(NewF, Pname, From, St, Loc)); @@ -384,13 +386,16 @@ enter_file(Path, NewName, Inc, From, St) -> %% Set epp to use this file and "enter" it. enter_file2(NewF, Pname, From, St, AtLocation) -> - enter_file2(NewF, Pname, From, St, AtLocation, []). - -enter_file2(NewF, Pname, From, St, AtLocation, ExtraPath) -> Loc = start_loc(AtLocation), enter_file_reply(From, Pname, Loc, AtLocation), Ms = dict:store({atom,'FILE'}, {none,[{string,Loc,Pname}]}, St#epp.macs), - Path = St#epp.path ++ ExtraPath, + %% update the head of the include path to be the directory of the new + %% source file, so that an included file can always include other files + %% relative to its current location (this is also how C does it); note + %% that the directory of the parent source file (the previous head of + %% the path) must be dropped, otherwise the path used within the current + %% file will depend on the order of file inclusions in the parent files + Path = [filename:dirname(Pname) | tl(St#epp.path)], #epp{file=NewF,location=Loc,name=Pname,delta=0, sstk=[St|St#epp.sstk],path=Path,macs=Ms}. @@ -655,7 +660,7 @@ scan_undef(_Toks, Undef, From, St) -> scan_include([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc, From, St) -> NewName = expand_var(NewName0), - enter_file(St#epp.path, NewName, Inc, From, St); + enter_file(NewName, Inc, From, St); scan_include(_Toks, Inc, From, St) -> epp_reply(From, {error,{abs_loc(Inc),epp,{bad,include}}}), wait_req_scan(St). @@ -684,12 +689,11 @@ scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], {error,_E1} -> case catch find_lib_dir(NewName) of {LibDir, Rest} when is_list(LibDir) -> - LibName = filename:join([LibDir | Rest]), + LibName = fname_join([LibDir | Rest]), case file:open(LibName, [read]) of {ok,NewF} -> - ExtraPath = [filename:dirname(LibName)], wait_req_scan(enter_file2(NewF, LibName, From, - St, Loc, ExtraPath)); + St, Loc)); {error,_E2} -> epp_reply(From, {error,{abs_loc(Inc),epp, @@ -1154,7 +1158,12 @@ expand_var1(NewName) -> [[$$ | Var] | Rest] = filename:split(NewName), Value = os:getenv(Var), true = Value =/= false, - {ok, filename:join([Value | Rest])}. + {ok, fname_join([Value | Rest])}. + +fname_join(["." | [_|_]=Rest]) -> + fname_join(Rest); +fname_join(Components) -> + filename:join(Components). %% The line only. (Other tokens may have the column and text as well...) loc_attr(Line) when is_integer(Line) -> diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 515ea2ebb7..88a0094d57 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -256,7 +256,8 @@ expr({'receive',_,Cs}, Bs, Lf, Ef, RBs) -> expr({'receive',_, Cs, E, TB}, Bs0, Lf, Ef, RBs) -> {value,T,Bs} = expr(E, Bs0, Lf, Ef, none), receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, [], RBs); -expr({'fun',_Line,{function,Mod,Name,Arity}}, Bs, _Lf, _Ef, RBs) -> +expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) -> + {[Mod,Name,Arity],Bs} = expr_list([Mod0,Name0,Arity0], Bs0, Lf, Ef), F = erlang:make_fun(Mod, Name, Arity), ret_expr(F, Bs, RBs); expr({'fun',_Line,{function,Name,Arity}}, _Bs0, _Lf, _Ef, _RBs) -> % R8 @@ -621,7 +622,7 @@ eval_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) -> erlang:raise(error, {bad_generator,Term}, stacktrace()). eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) -> - Mfun = fun(L, R, Bs) -> match1(L, R, Bs, Bs0) end, + Mfun = match_fun(Bs0), Efun = fun(Exp, Bs) -> expr(Exp, Bs, Lf, Ef, none) end, case eval_bits:bin_gen(P, Bin, new_bindings(), Bs0, Mfun, Efun) of {match, Rest, Bs1} -> @@ -1024,7 +1025,7 @@ match1({tuple,_,_}, _, _Bs, _BBs) -> throw(nomatch); match1({bin, _, Fs}, <<_/bitstring>>=B, Bs0, BBs) -> eval_bits:match_bits(Fs, B, Bs0, BBs, - fun(L, R, Bs) -> match1(L, R, Bs, BBs) end, + match_fun(BBs), fun(E, Bs) -> expr(E, Bs, none, none, none) end); match1({bin,_,_}, _, _Bs, _BBs) -> throw(nomatch); @@ -1053,6 +1054,12 @@ match1({op,Line,Op,L,R}, Term, Bs, BBs) -> match1(_, _, _Bs, _BBs) -> throw(invalid). +match_fun(BBs) -> + fun(match, {L,R,Bs}) -> match1(L, R, Bs, BBs); + (binding, {Name,Bs}) -> binding(Name, Bs); + (add_binding, {Name,Val,Bs}) -> add_binding(Name, Val, Bs) + end. + match_tuple([E|Es], Tuple, I, Bs0, BBs) -> {match,Bs} = match1(E, element(I, Tuple), Bs0, BBs), match_tuple(Es, Tuple, I+1, Bs, BBs); diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 3073fc0fb5..cd3b531d10 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -264,7 +264,6 @@ bif(bitstring_to_list, 1) -> true; bif(byte_size, 1) -> true; bif(check_old_code, 1) -> true; bif(check_process_code, 2) -> true; -bif(concat_binary, 1) -> true; bif(date, 0) -> true; bif(delete_module, 1) -> true; bif(demonitor, 1) -> true; @@ -406,7 +405,6 @@ old_bif(bit_size, 1) -> true; old_bif(bitstring_to_list, 1) -> true; old_bif(byte_size, 1) -> true; old_bif(check_process_code, 2) -> true; -old_bif(concat_binary, 1) -> true; old_bif(date, 0) -> true; old_bif(delete_module, 1) -> true; old_bif(disconnect_node, 1) -> true; diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index dd0b9bc2ab..5d45260fe9 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -123,6 +123,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> called= [] :: [{fa(),line()}], %Called functions usage = #usage{} :: #usage{}, specs = dict:new() :: dict(), %Type specifications + callbacks = dict:new() :: dict(), %Callback types types = dict:new() :: dict(), %Type definitions exp_types=gb_sets:empty():: gb_set() %Exported types }). @@ -310,8 +311,6 @@ format_error({conflicting_behaviours,{Name,Arity},B,FirstL,FirstB}) -> format_error({undefined_behaviour_func, {Func,Arity}, Behaviour}) -> io_lib:format("undefined callback function ~w/~w (behaviour '~w')", [Func,Arity,Behaviour]); -format_error({undefined_behaviour_func, {Func,Arity,_Spec}, Behaviour}) -> - format_error({undefined_behaviour_func, {Func,Arity}, Behaviour}); format_error({undefined_behaviour,Behaviour}) -> io_lib:format("behaviour ~w undefined", [Behaviour]); format_error({undefined_behaviour_callbacks,Behaviour}) -> @@ -320,6 +319,9 @@ format_error({undefined_behaviour_callbacks,Behaviour}) -> format_error({ill_defined_behaviour_callbacks,Behaviour}) -> io_lib:format("behaviour ~w callback functions erroneously defined", [Behaviour]); +format_error({behaviour_info, {_M,F,A}}) -> + io_lib:format("cannot define callback attibute for ~w/~w when " + "behaviour_info is defined",[F,A]); %% --- types and specs --- format_error({singleton_typevar, Name}) -> io_lib:format("type variable ~w is only used once (is unbound)", [Name]); @@ -348,12 +350,16 @@ format_error({type_syntax, Constr}) -> io_lib:format("bad ~w type", [Constr]); format_error({redefine_spec, {M, F, A}}) -> io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]); +format_error({redefine_callback, {M, F, A}}) -> + io_lib:format("callback ~w:~w/~w already defined", [M, F, A]); format_error({spec_fun_undefined, {M, F, A}}) -> io_lib:format("spec for undefined function ~w:~w/~w", [M, F, A]); format_error({missing_spec, {F,A}}) -> io_lib:format("missing specification for function ~w/~w", [F, A]); format_error(spec_wrong_arity) -> "spec has the wrong arity"; +format_error(callback_wrong_arity) -> + "callback has the wrong arity"; format_error({imported_predefined_type, Name}) -> io_lib:format("referring to built-in type ~w as a remote type; " "please take out the module name", [Name]); @@ -747,6 +753,8 @@ attribute_state({attribute,L,opaque,{TypeName,TypeDef,Args}}, St) -> type_def(opaque, L, TypeName, TypeDef, Args, St); attribute_state({attribute,L,spec,{Fun,Types}}, St) -> spec_decl(L, Fun, Types, St); +attribute_state({attribute,L,callback,{Fun,Types}}, St) -> + callback_decl(L, Fun, Types, St); attribute_state({attribute,L,on_load,Val}, St) -> on_load(L, Val, St); attribute_state({attribute,_L,_Other,_Val}, St) -> % Ignore others @@ -840,7 +848,8 @@ post_traversal_check(Forms, St0) -> StB = check_unused_types(Forms, StA), StC = check_untyped_records(Forms, StB), StD = check_on_load(StC), - check_unused_records(Forms, StD). + StE = check_unused_records(Forms, StD), + check_callback_information(StE). %% check_behaviour(State0) -> State %% Check that the behaviour attribute is valid. @@ -1139,6 +1148,23 @@ check_unused_records(Forms, St0) -> St0 end. +check_callback_information(#lint{callbacks = Callbacks, + defined = Defined} = State) -> + case gb_sets:is_member({behaviour_info,1}, Defined) of + false -> State; + true -> + case dict:size(Callbacks) of + 0 -> State; + _ -> + CallbacksList = dict:to_list(Callbacks), + FoldL = + fun({Fa,Line},St) -> + add_error(Line, {behaviour_info, Fa}, St) + end, + lists:foldl(FoldL, State, CallbacksList) + end + end. + %% For storing the import list we use the orddict module. %% We know an empty set is []. @@ -2101,8 +2127,13 @@ expr({'fun',Line,Body}, Vt, St) -> true -> {[],St}; false -> {[],call_function(Line, F, A, St)} end; - {function,_M,_F,_A} -> - {[],St} + {function,M,F,A} when is_atom(M), is_atom(F), is_integer(A) -> + %% Compatibility with pre-R15 abstract format. + {[],St}; + {function,M,F,A} -> + %% New in R15. + {Bvt, St1} = expr_list([M,F,A], Vt, St), + {vtupdate(Bvt, Vt),St1} end; expr({call,_Line,{atom,_Lr,is_record},[E,{atom,Ln,Name}]}, Vt, St0) -> {Rvt,St1} = expr(E, Vt, St0), @@ -2770,6 +2801,20 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) -> false -> check_specs(TypeSpecs, Arity, St1) end. +%% callback_decl(Line, Fun, Types, State) -> State. + +callback_decl(Line, MFA0, TypeSpecs, + St0 = #lint{callbacks = Callbacks, module = Mod}) -> + MFA = case MFA0 of + {F, Arity} -> {Mod, F, Arity}; + {_M, _F, Arity} -> MFA0 + end, + St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)}, + case dict:is_key(MFA, Callbacks) of + true -> add_error(Line, {redefine_callback, MFA}, St1); + false -> check_specs(TypeSpecs, Arity, St1) + end. + check_specs([FunType|Left], Arity, St0) -> {FunType1, CTypes} = case FunType of @@ -3275,6 +3320,8 @@ modify_line1({attribute,L,record,{Name,Fields}}, Mf) -> {attribute,Mf(L),record,{Name,modify_line1(Fields, Mf)}}; modify_line1({attribute,L,spec,{Fun,Types}}, Mf) -> {attribute,Mf(L),spec,{Fun,modify_line1(Types, Mf)}}; +modify_line1({attribute,L,callback,{Fun,Types}}, Mf) -> + {attribute,Mf(L),callback,{Fun,modify_line1(Types, Mf)}}; modify_line1({attribute,L,type,{TypeName,TypeDef,Args}}, Mf) -> {attribute,Mf(L),type,{TypeName,modify_line1(TypeDef, Mf), modify_line1(Args, Mf)}}; diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index bd5d65a1e1..928c10f7f2 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -35,7 +35,7 @@ tuple %struct record_expr record_tuple record_field record_fields if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr -fun_expr fun_clause fun_clauses +fun_expr fun_clause fun_clauses atom_or_var integer_or_var try_expr try_catch try_clause try_clauses query_expr function_call argument_list exprs guard @@ -62,7 +62,7 @@ char integer float atom string var '==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<=' '<<' '>>' '!' '=' '::' '..' '...' -'spec' % helper +'spec' 'callback' % helper dot. Expect 2. @@ -77,6 +77,7 @@ attribute -> '-' atom attr_val : build_attribute('$2', '$3'). attribute -> '-' atom typed_attr_val : build_typed_attribute('$2','$3'). attribute -> '-' atom '(' typed_attr_val ')' : build_typed_attribute('$2','$4'). attribute -> '-' 'spec' type_spec : build_type_spec('$2', '$3'). +attribute -> '-' 'callback' type_spec : build_type_spec('$2', '$3'). type_spec -> spec_fun type_sigs : {'$1', '$2'}. type_spec -> '(' spec_fun type_sigs ')' : {'$2', '$3'}. @@ -394,11 +395,17 @@ receive_expr -> 'receive' cr_clauses 'after' expr clause_body 'end' : fun_expr -> 'fun' atom '/' integer : {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4')}}. -fun_expr -> 'fun' atom ':' atom '/' integer : - {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4'),element(3,'$6')}}. +fun_expr -> 'fun' atom_or_var ':' atom_or_var '/' integer_or_var : + {'fun',?line('$1'),{function,'$2','$4','$6'}}. fun_expr -> 'fun' fun_clauses 'end' : build_fun(?line('$1'), '$2'). +atom_or_var -> atom : '$1'. +atom_or_var -> var : '$1'. + +integer_or_var -> integer : '$1'. +integer_or_var -> var : '$1'. + fun_clauses -> fun_clause : ['$1']. fun_clauses -> fun_clause ';' fun_clauses : ['$1' | '$3']. @@ -549,6 +556,8 @@ Erlang code. ErrorInfo :: error_info(). parse_form([{'-',L1},{atom,L2,spec}|Tokens]) -> parse([{'-',L1},{'spec',L2}|Tokens]); +parse_form([{'-',L1},{atom,L2,callback}|Tokens]) -> + parse([{'-',L1},{'callback',L2}|Tokens]); parse_form(Tokens) -> parse(Tokens). @@ -603,7 +612,8 @@ build_typed_attribute({atom,La,Attr},_) -> _ -> ret_err(La, "bad attribute") end. -build_type_spec({spec,La}, {SpecFun, TypeSpecs}) -> +build_type_spec({Kind,La}, {SpecFun, TypeSpecs}) + when (Kind =:= spec) or (Kind =:= callback) -> NewSpecFun = case SpecFun of {atom, _, Fun} -> @@ -617,7 +627,7 @@ build_type_spec({spec,La}, {SpecFun, TypeSpecs}) -> %% Old style spec. Allow this for now. {Mod,Fun,Arity} end, - {attribute,La,spec,{NewSpecFun, TypeSpecs}}. + {attribute,La,Kind,{NewSpecFun, TypeSpecs}}. find_arity_from_specs([Spec|_]) -> %% Use the first spec to find the arity. If all are not the same, diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 7dc19f2e9b..6b5aa951cf 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -457,8 +457,16 @@ lexpr({'fun',_,{function,F,A}}, _Prec, _Hook) -> leaf(format("fun ~w/~w", [F,A])); lexpr({'fun',_,{function,F,A},Extra}, _Prec, _Hook) -> {force_nl,fun_info(Extra),leaf(format("fun ~w/~w", [F,A]))}; -lexpr({'fun',_,{function,M,F,A}}, _Prec, _Hook) -> +lexpr({'fun',_,{function,M,F,A}}, _Prec, _Hook) + when is_atom(M), is_atom(F), is_integer(A) -> + %% For backward compatibility with pre-R15 abstract format. leaf(format("fun ~w:~w/~w", [M,F,A])); +lexpr({'fun',_,{function,M,F,A}}, _Prec, Hook) -> + %% New format in R15. + NameItem = lexpr(M, Hook), + CallItem = lexpr(F, Hook), + ArityItem = lexpr(A, Hook), + ["fun ",NameItem,$:,CallItem,$/,ArityItem]; lexpr({'fun',_,{clauses,Cs}}, _Prec, Hook) -> {list,[{first,'fun',fun_clauses(Cs, Hook)},'end']}; lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Hook) -> diff --git a/lib/stdlib/src/error_logger_tty_h.erl b/lib/stdlib/src/error_logger_tty_h.erl index 435e57aa0e..fa13fbb2bd 100644 --- a/lib/stdlib/src/error_logger_tty_h.erl +++ b/lib/stdlib/src/error_logger_tty_h.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -34,10 +34,12 @@ handle_event/2, handle_call/2, handle_info/2, terminate/2, code_change/3]). +-export([write_event/2]). + %% This one is used when we takeover from the simple error_logger. init({[], {error_logger, Buf}}) -> User = set_group_leader(), - write_events(Buf), + write_events(Buf,io), {ok, {User, error_logger}}; %% This one is used if someone took over from us, and now wants to %% go back. @@ -52,7 +54,7 @@ init([]) -> handle_event({_Type, GL, _Msg}, State) when node(GL) =/= node() -> {ok, State}; handle_event(Event, State) -> - write_event(tag_event(Event)), + write_event(tag_event(Event),io), {ok, State}. handle_info({'EXIT', User, _Reason}, {User, PrevHandler}) -> @@ -64,10 +66,10 @@ handle_info({'EXIT', User, _Reason}, {User, PrevHandler}) -> PrevHandler, go_back} end; handle_info({emulator, GL, Chars}, State) when node(GL) == node() -> - write_event(tag_event({emulator, GL, Chars})), + write_event(tag_event({emulator, GL, Chars}),io), {ok, State}; handle_info({emulator, noproc, Chars}, State) -> - write_event(tag_event({emulator, noproc, Chars})), + write_event(tag_event({emulator, noproc, Chars}),io), {ok, State}; handle_info(_, State) -> {ok, State}. @@ -97,65 +99,65 @@ set_group_leader() -> tag_event(Event) -> {erlang:localtime(), Event}. -write_events(Events) -> write_events1(lists:reverse(Events)). +write_events(Events,IOMod) -> write_events1(lists:reverse(Events),IOMod). -write_events1([Event|Es]) -> - write_event(Event), - write_events1(Es); -write_events1([]) -> +write_events1([Event|Es],IOMod) -> + write_event(Event,IOMod), + write_events1(Es,IOMod); +write_events1([],_IOMod) -> ok. -write_event({Time, {error, _GL, {Pid, Format, Args}}}) -> +write_event({Time, {error, _GL, {Pid, Format, Args}}},IOMod) -> T = write_time(maybe_utc(Time)), case catch io_lib:format(add_node(Format,Pid), Args) of S when is_list(S) -> - format(T ++ S); + format(IOMod, T ++ S); _ -> F = add_node("ERROR: ~p - ~p~n", Pid), - format(T ++ F, [Format,Args]) + format(IOMod, T ++ F, [Format,Args]) end; -write_event({Time, {emulator, _GL, Chars}}) -> +write_event({Time, {emulator, _GL, Chars}},IOMod) -> T = write_time(maybe_utc(Time)), case catch io_lib:format(Chars, []) of S when is_list(S) -> - format(T ++ S); + format(IOMod, T ++ S); _ -> - format(T ++ "ERROR: ~p ~n", [Chars]) + format(IOMod, T ++ "ERROR: ~p ~n", [Chars]) end; -write_event({Time, {info, _GL, {Pid, Info, _}}}) -> +write_event({Time, {info, _GL, {Pid, Info, _}}},IOMod) -> T = write_time(maybe_utc(Time)), - format(T ++ add_node("~p~n",Pid),[Info]); -write_event({Time, {error_report, _GL, {Pid, std_error, Rep}}}) -> + format(IOMod, T ++ add_node("~p~n",Pid),[Info]); +write_event({Time, {error_report, _GL, {Pid, std_error, Rep}}},IOMod) -> T = write_time(maybe_utc(Time)), S = format_report(Rep), - format(T ++ S ++ add_node("", Pid)); -write_event({Time, {info_report, _GL, {Pid, std_info, Rep}}}) -> + format(IOMod, T ++ S ++ add_node("", Pid)); +write_event({Time, {info_report, _GL, {Pid, std_info, Rep}}},IOMod) -> T = write_time(maybe_utc(Time), "INFO REPORT"), S = format_report(Rep), - format(T ++ S ++ add_node("", Pid)); -write_event({Time, {info_msg, _GL, {Pid, Format, Args}}}) -> + format(IOMod, T ++ S ++ add_node("", Pid)); +write_event({Time, {info_msg, _GL, {Pid, Format, Args}}},IOMod) -> T = write_time(maybe_utc(Time), "INFO REPORT"), case catch io_lib:format(add_node(Format,Pid), Args) of S when is_list(S) -> - format(T ++ S); + format(IOMod, T ++ S); _ -> F = add_node("ERROR: ~p - ~p~n", Pid), - format(T ++ F, [Format,Args]) + format(IOMod, T ++ F, [Format,Args]) end; -write_event({Time, {warning_report, _GL, {Pid, std_warning, Rep}}}) -> +write_event({Time, {warning_report, _GL, {Pid, std_warning, Rep}}},IOMod) -> T = write_time(maybe_utc(Time), "WARNING REPORT"), S = format_report(Rep), - format(T ++ S ++ add_node("", Pid)); -write_event({Time, {warning_msg, _GL, {Pid, Format, Args}}}) -> + format(IOMod, T ++ S ++ add_node("", Pid)); +write_event({Time, {warning_msg, _GL, {Pid, Format, Args}}},IOMod) -> T = write_time(maybe_utc(Time), "WARNING REPORT"), case catch io_lib:format(add_node(Format,Pid), Args) of S when is_list(S) -> - format(T ++ S); + format(IOMod, T ++ S); _ -> F = add_node("ERROR: ~p - ~p~n", Pid), - format(T ++ F, [Format,Args]) + format(IOMod, T ++ F, [Format,Args]) end; -write_event({_Time, _Error}) -> +write_event({_Time, _Error},_IOMod) -> ok. maybe_utc(Time) -> @@ -178,8 +180,9 @@ maybe_utc(Time) -> Time end. -format(String) -> io:format(user, String, []). -format(String, Args) -> io:format(user, String, Args). +format(IOMod, String) -> format(IOMod, String, []). +format(io_lib, String, Args) -> io_lib:format(String, Args); +format(io, String, Args) -> io:format(user, String, Args). format_report(Rep) when is_list(Rep) -> case string_p(Rep) of diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index cd1bacd2f5..ad49d89908 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -866,7 +866,7 @@ hidden_apply(App, M, F, Args) -> catch error:undef -> case erlang:get_stacktrace() of - [{M,F,Args} | _] -> + [{M,F,Args,_} | _] -> Arity = length(Args), Text = io_lib:format("Call to ~w:~w/~w in application ~w failed.\n", [M, F, Arity, App]), diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl index 1ffa6ea328..f40904df1c 100644 --- a/lib/stdlib/src/eval_bits.erl +++ b/lib/stdlib/src/eval_bits.erl @@ -31,8 +31,9 @@ %% @type evalfun(). A closure which evaluates an expression given an %% environment %% -%% @type matchfun(). A closure which performs a match given a value, a -%% pattern and an environment +%% @type matchfun(). A closure which depending on its first argument +%% can perform a match (given a value, a pattern and an environment), +%% lookup a variable in the bindings, or add a new binding %% %% @type field(). Represents a field in a "bin". @@ -144,7 +145,8 @@ eval_exp_field(Val, Size, Unit, binary, _, _) -> bin_gen({bin,_,Fs}, Bin, Bs0, BBs0, Mfun, Efun) -> bin_gen(Fs, Bin, Bs0, BBs0, Mfun, Efun, true). -bin_gen([F|Fs], Bin, Bs0, BBs0, Mfun, Efun, Flag) -> +bin_gen([F|Fs], Bin, Bs0, BBs0, Mfun, Efun, Flag) + when is_function(Mfun, 2), is_function(Efun, 2) -> case bin_gen_field(F, Bin, Bs0, BBs0, Mfun, Efun) of {match,Bs,BBs,Rest} -> bin_gen(Fs, Rest, Bs, BBs, Mfun, Efun, Flag); @@ -175,14 +177,14 @@ bin_gen_field({bin_element,Line,VE,Size0,Options0}, {Size1, [Type,{unit,Unit},Sign,Endian]} = make_bit_type(Line, Size0, Options0), V = erl_eval:partial_eval(VE), - match_check_size(Size1, BBs0), + match_check_size(Mfun, Size1, BBs0), {value, Size, _BBs} = Efun(Size1, BBs0), case catch get_value(Bin, Type, Size, Unit, Sign, Endian) of {Val,<<_/bitstring>>=Rest} -> NewV = coerce_to_float(V, Type), - case catch Mfun(NewV, Val, Bs0) of + case catch Mfun(match, {NewV,Val,Bs0}) of {match,Bs} -> - BBs = add_bin_binding(NewV, Bs, BBs0), + BBs = add_bin_binding(Mfun, NewV, Bs, BBs0), {match,Bs,BBs,Rest}; _ -> {nomatch,Rest} @@ -205,7 +207,8 @@ bin_gen_field({bin_element,Line,VE,Size0,Options0}, match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun, _) -> match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun). -match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun) -> +match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun) + when is_function(Mfun, 2), is_function(Efun, 2) -> case catch match_bits_1(Fs, Bin, Bs0, BBs, Mfun, Efun) of {match,Bs} -> {match,Bs}; invalid -> throw(invalid); @@ -230,12 +233,12 @@ match_field_1({bin_element,Line,VE,Size0,Options0}, make_bit_type(Line, Size0, Options0), V = erl_eval:partial_eval(VE), Size2 = erl_eval:partial_eval(Size1), - match_check_size(Size2, BBs0), + match_check_size(Mfun, Size2, BBs0), {value, Size, _BBs} = Efun(Size2, BBs0), {Val,Rest} = get_value(Bin, Type, Size, Unit, Sign, Endian), NewV = coerce_to_float(V, Type), - {match,Bs} = Mfun(NewV, Val, Bs0), - BBs = add_bin_binding(NewV, Bs, BBs0), + {match,Bs} = Mfun(match, {NewV,Val,Bs0}), + BBs = add_bin_binding(Mfun, NewV, Bs, BBs0), {Bs,BBs,Rest}. %% Almost identical to the one in sys_pre_expand. @@ -249,12 +252,12 @@ coerce_to_float({integer,L,I}=E, float) -> coerce_to_float(E, _Type) -> E. -add_bin_binding({var,_,'_'}, _Bs, BBs) -> +add_bin_binding(_, {var,_,'_'}, _Bs, BBs) -> BBs; -add_bin_binding({var,_,Name}, Bs, BBs) -> - {value,Value} = erl_eval:binding(Name, Bs), - erl_eval:add_binding(Name, Value, BBs); -add_bin_binding(_, _Bs, BBs) -> +add_bin_binding(Mfun, {var,_,Name}, Bs, BBs) -> + {value,Value} = Mfun(binding, {Name,Bs}), + Mfun(add_binding, {Name,Value,BBs}); +add_bin_binding(_, _, _Bs, BBs) -> BBs. get_value(Bin, integer, Size, Unit, Sign, Endian) -> @@ -327,20 +330,20 @@ make_bit_type(_Line, Size, Type0) -> %Size evaluates to an integer or 'all' {error,Reason} -> error(Reason) end. -match_check_size({var,_,V}, Bs) -> - case erl_eval:binding(V, Bs) of +match_check_size(Mfun, {var,_,V}, Bs) -> + case Mfun(binding, {V,Bs}) of {value,_} -> ok; unbound -> throw(invalid) % or, rather, error({unbound,V}) end; -match_check_size({atom,_,all}, _Bs) -> +match_check_size(_, {atom,_,all}, _Bs) -> ok; -match_check_size({atom,_,undefined}, _Bs) -> +match_check_size(_, {atom,_,undefined}, _Bs) -> ok; -match_check_size({integer,_,_}, _Bs) -> +match_check_size(_, {integer,_,_}, _Bs) -> ok; -match_check_size({value,_,_}, _Bs) -> +match_check_size(_, {value,_,_}, _Bs) -> ok; %From the debugger. -match_check_size(_, _Bs) -> +match_check_size(_, _, _Bs) -> throw(invalid). %% error(Reason) -> exception thrown diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index 1cb9e4a25e..2fc9128e4e 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -147,9 +147,10 @@ basename(Name) when is_binary(Name) -> end; basename(Name0) -> - Name = flatten(Name0), + Name1 = flatten(Name0), {DirSep2, DrvSep} = separators(), - basename1(skip_prefix(Name, DrvSep), [], DirSep2). + Name = skip_prefix(Name1, DrvSep), + basename1(Name, Name, DirSep2). win_basenameb(<<Letter,$:,Rest/binary>>) when ?IS_DRIVELETTER(Letter) -> basenameb(Rest,[<<"/">>,<<"\\">>]); @@ -167,16 +168,18 @@ basenameb(Bin,Sep) -> -basename1([$/|[]], Tail, DirSep2) -> - basename1([], Tail, DirSep2); +basename1([$/], Tail0, _DirSep2) -> + %% End of filename -- must get rid of trailing directory separator. + [_|Tail] = lists:reverse(Tail0), + lists:reverse(Tail); basename1([$/|Rest], _Tail, DirSep2) -> - basename1(Rest, [], DirSep2); + basename1(Rest, Rest, DirSep2); basename1([DirSep2|Rest], Tail, DirSep2) when is_integer(DirSep2) -> basename1([$/|Rest], Tail, DirSep2); basename1([Char|Rest], Tail, DirSep2) when is_integer(Char) -> - basename1(Rest, [Char|Tail], DirSep2); + basename1(Rest, Tail, DirSep2); basename1([], Tail, _DirSep2) -> - lists:reverse(Tail). + Tail. skip_prefix(Name, false) -> Name; @@ -369,8 +372,8 @@ extension(Name0) -> Name = flatten(Name0), extension(Name, [], major_os_type()). -extension([$.|Rest], _Result, OsType) -> - extension(Rest, [$.], OsType); +extension([$.|Rest]=Result, _Result, OsType) -> + extension(Rest, Result, OsType); extension([Char|Rest], [], OsType) when is_integer(Char) -> extension(Rest, [], OsType); extension([$/|Rest], _Result, OsType) -> @@ -378,9 +381,9 @@ extension([$/|Rest], _Result, OsType) -> extension([$\\|Rest], _Result, win32) -> extension(Rest, [], win32); extension([Char|Rest], Result, OsType) when is_integer(Char) -> - extension(Rest, [Char|Result], OsType); + extension(Rest, Result, OsType); extension([], Result, _OsType) -> - lists:reverse(Result). + Result. %% Joins a list of filenames with directory separators. diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 1c4a73680b..9879b76391 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -36,8 +36,6 @@ add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3, swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/4]). --export([behaviour_info/1]). - -export([init_it/6, system_continue/3, system_terminate/4, @@ -60,14 +58,6 @@ %%% API %%%========================================================================= --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1},{handle_event,2},{handle_call,2},{handle_info,2}, - {terminate,2},{code_change,3}]; -behaviour_info(_Other) -> - undefined. - %% gen_event:start(Handler) -> {ok, Pid} | {error, What} %% gen_event:add_handler(Handler, Mod, Args) -> ok | Other %% gen_event:notify(Handler, Event) -> ok @@ -78,41 +68,36 @@ behaviour_info(_Other) -> %% gen_event:which_handler(Handler) -> [Mod] %% gen_event:stop(Handler) -> ok - -%% handlers must export -%% Mod:init(Args) -> {ok, State} | Other -%% Mod:handle_event(Event, State) -> -%% {ok, State'} | remove_handler | {swap_handler,Args1,State1,Mod2,Args2} -%% Mod:handle_info(Info, State) -> -%% {ok, State'} | remove_handler | {swap_handler,Args1,State1,Mod2,Args2} -%% Mod:handle_call(Query, State) -> -%% {ok, Reply, State'} | {remove_handler, Reply} | -%% {swap_handler, Reply, Args1,State1,Mod2,Args2} -%% Mod:terminate(Args, State) -> Val - - -%% add_handler(H, Mod, Args) -> ok | Other -%% Mod:init(Args) -> {ok, State} | Other - -%% delete_handler(H, Mod, Args) -> Val -%% Mod:terminate(Args, State) -> Val - -%% notify(H, Event) -%% Mod:handle_event(Event, State) -> -%% {ok, State1} -%% remove_handler -%% Mod:terminate(remove_handler, State) is called -%% the return value is ignored -%% {swap_handler, Args1, State1, Mod2, Args2} -%% State2 = Mod:terminate(Args1, State1) is called -%% the return value is chained into the new module and -%% Mod2:init({Args2, State2}) is called -%% Other -%% Mod:terminate({error, Other}, State) is called -%% The return value is ignored -%% call(H, Mod, Query) -> Val -%% call(H, Mod, Query, Timeout) -> Val -%% Mod:handle_call(Query, State) -> as above +-callback init(InitArgs :: term()) -> + {ok, State :: term()} | + {ok, State :: term(), hibernate}. +-callback handle_event(Event :: term(), State :: term()) -> + {ok, NewState :: term()} | + {ok, NewState :: term(), hibernate} | + {swap_handler, Args1 :: term(), NewState :: term(), + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + remove_handler. +-callback handle_call(Request :: term(), State :: term()) -> + {ok, Reply :: term(), NewState :: term()} | + {ok, Reply :: term(), NewState :: term(), hibernate} | + {swap_handler, Reply :: term(), Args1 :: term(), NewState :: term(), + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + {remove_handler, Reply :: term()}. +-callback handle_info(Info :: term(), State :: term()) -> + {ok, NewState :: term()} | + {ok, NewState :: term(), hibernate} | + {swap_handler, Args1 :: term(), NewState :: term(), + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + remove_handler. +-callback terminate(Args :: (term() | {stop, Reason :: term()} | + stop | remove_handler | + {error, {'EXIT', Reason :: term()}} | + {error, term()}), + State :: term()) -> + term(). +-callback code_change(OldVsn :: (term() | {down, term()}), + State :: term(), Extra :: term()) -> + {ok, NewState :: term()}. %%--------------------------------------------------------------------------- @@ -667,16 +652,16 @@ report_error(_Handler, {swapped,_,_}, _, _, _) -> ok; report_error(Handler, Reason, State, LastIn, SName) -> Reason1 = case Reason of - {'EXIT',{undef,[{M,F,A}|MFAs]}} -> + {'EXIT',{undef,[{M,F,A,L}|MFAs]}} -> case code:is_loaded(M) of false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; + {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> - {undef,[{M,F,A}|MFAs]}; + {undef,[{M,F,A,L}|MFAs]}; false -> - {'function not exported',[{M,F,A}|MFAs]} + {'function not exported',[{M,F,A,L}|MFAs]} end end; {'EXIT',Why} -> diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index f2f1365d3d..3db8c9f4f2 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -113,8 +113,6 @@ start_timer/2,send_event_after/2,cancel_timer/1, enter_loop/4, enter_loop/5, enter_loop/6, wake_hib/6]). --export([behaviour_info/1]). - %% Internal exports -export([init_it/6, system_continue/3, @@ -128,13 +126,38 @@ %%% Interface functions. %%% --------------------------------------------------- --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1},{handle_event,3},{handle_sync_event,4},{handle_info,3}, - {terminate,3},{code_change,4}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, StateName :: atom(), StateData :: term()} | + {ok, StateName :: atom(), StateData :: term(), timeout() | hibernate} | + {stop, Reason :: term()} | ignore. +-callback handle_event(Event :: term(), StateName :: atom(), + StateData :: term()) -> + {next_state, NextStateName :: atom(), NewStateData :: term()} | + {next_state, NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {stop, Reason :: term(), NewStateData :: term()}. +-callback handle_sync_event(Event :: term(), From :: {pid(), Tag :: term()}, + StateName :: atom(), StateData :: term()) -> + {reply, Reply :: term(), NextStateName :: atom(), NewStateData :: term()} | + {reply, Reply :: term(), NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {next_state, NextStateName :: atom(), NewStateData :: term()} | + {next_state, NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewStateData :: term()} | + {stop, Reason :: term(), NewStateData :: term()}. +-callback handle_info(Info :: term(), StateName :: atom(), + StateData :: term()) -> + {next_state, NextStateName :: atom(), NewStateData :: term()} | + {next_state, NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {stop, Reason :: normal | term(), NewStateData :: term()}. +-callback terminate(Reason :: normal | shutdown | {shutdown, term()} + | term(), StateName :: atom(), StateData :: term()) -> + term(). +-callback code_change(OldVsn :: term() | {down, term()}, StateName :: atom(), + StateData :: term(), Extra :: term()) -> + {ok, NextStateName :: atom(), NewStateData :: term()}. %%% --------------------------------------------------- %%% Starts a generic state machine. @@ -561,16 +584,16 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> error_info(Reason, Name, Msg, StateName, StateData, Debug) -> Reason1 = case Reason of - {undef,[{M,F,A}|MFAs]} -> + {undef,[{M,F,A,L}|MFAs]} -> case code:is_loaded(M) of false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; + {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> Reason; false -> - {'function not exported',[{M,F,A}|MFAs]} + {'function not exported',[{M,F,A,L}|MFAs]} end end; _ -> diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 09d94a9c40..dd0ef74f30 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -94,8 +94,6 @@ multi_call/2, multi_call/3, multi_call/4, enter_loop/3, enter_loop/4, enter_loop/5, wake_hib/5]). --export([behaviour_info/1]). - %% System exports -export([system_continue/3, system_terminate/4, @@ -111,13 +109,32 @@ %%% API %%%========================================================================= --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1},{handle_call,3},{handle_cast,2},{handle_info,2}, - {terminate,2},{code_change,3}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | + {stop, Reason :: term()} | ignore. +-callback handle_call(Request :: term(), From :: {pid(), Tag :: term()}, + State :: term()) -> + {reply, Reply :: term(), NewState :: term()} | + {reply, Reply :: term(), NewState :: term(), timeout() | hibernate} | + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewState :: term()} | + {stop, Reason :: term(), NewState :: term()}. +-callback handle_cast(Request :: term(), State :: term()) -> + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), NewState :: term()}. +-callback handle_info(Info :: timeout() | term(), State :: term()) -> + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), NewState :: term()}. +-callback terminate(Reason :: (normal | shutdown | {shutdown, term()} | + term()), + State :: term()) -> + term(). +-callback code_change(OldVsn :: (term() | {down, term()}), State :: term(), + Extra :: term()) -> + {ok, NewState :: term()}. %%% ----------------------------------------------------------------- %%% Starts a generic server. @@ -729,16 +746,16 @@ error_info(_Reason, application_controller, _Msg, _State, _Debug) -> error_info(Reason, Name, Msg, State, Debug) -> Reason1 = case Reason of - {undef,[{M,F,A}|MFAs]} -> + {undef,[{M,F,A,L}|MFAs]} -> case code:is_loaded(M) of false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; + {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> Reason; false -> - {'function not exported',[{M,F,A}|MFAs]} + {'function not exported',[{M,F,A,L}|MFAs]} end end; _ -> diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/lib.erl index c303ae60b5..314fd60903 100644 --- a/lib/stdlib/src/lib.erl +++ b/lib/stdlib/src/lib.erl @@ -173,12 +173,12 @@ format_fun(Fun) when is_function(Fun) -> analyze_exception(error, Term, Stack) -> case {is_stacktrace(Stack), Stack, Term} of - {true, [{_M,_F,As}=MFA|MFAs], function_clause} when is_list(As) -> - {Term,[MFA],MFAs}; - {true, [{shell,F,A}], function_clause} when is_integer(A) -> + {true, [{_,_,As,_}=MFAL|MFAs], function_clause} when is_list(As) -> + {Term,[MFAL],MFAs}; + {true, [{shell,F,A,_}], function_clause} when is_integer(A) -> {Term, [{F,A}], []}; - {true, [{_M,_F,_AorAs}=MFA|MFAs], undef} -> - {Term,[MFA],MFAs}; + {true, [{_,_,_,_}=MFAL|MFAs], undef} -> + {Term,[MFAL],MFAs}; {true, _, _} -> {Term,[],Stack}; {false, _, _} -> @@ -194,9 +194,11 @@ analyze_exception(_Class, Term, Stack) -> is_stacktrace([]) -> true; -is_stacktrace([{M,F,A}|Fs]) when is_atom(M), is_atom(F), is_integer(A) -> +is_stacktrace([{M,F,A,I}|Fs]) + when is_atom(M), is_atom(F), is_integer(A), is_list(I) -> is_stacktrace(Fs); -is_stacktrace([{M,F,As}|Fs]) when is_atom(M), is_atom(F), length(As) >= 0 -> +is_stacktrace([{M,F,As,I}|Fs]) + when is_atom(M), is_atom(F), length(As) >= 0, is_list(I) -> is_stacktrace(Fs); is_stacktrace(_) -> false. @@ -225,9 +227,9 @@ explain_reason(function_clause, error, [{F,A}], _PF, _S) -> %% Shell commands FAs = io_lib:fwrite(<<"~w/~w">>, [F, A]), [<<"no function clause matching call to ">> | FAs]; -explain_reason(function_clause, error=Cl, [{M,F,As}], PF, S) -> +explain_reason(function_clause, error=Cl, [{M,F,As,Loc}], PF, S) -> Str = <<"no function clause matching ">>, - format_errstr_call(Str, Cl, {M,F}, As, PF, S); + [format_errstr_call(Str, Cl, {M,F}, As, PF, S),$\s|location(Loc)]; explain_reason(if_clause, error, [], _PF, _S) -> <<"no true branch found when evaluating an if expression">>; explain_reason(noproc, error, [], _PF, _S) -> @@ -242,11 +244,11 @@ explain_reason({try_clause,V}, error=Cl, [], PF, S) -> %% "there is no try clause with a true guard sequence and a %% pattern matching..." format_value(V, <<"no try clause matching ">>, Cl, PF, S); -explain_reason(undef, error, [{M,F,A}], _PF, _S) -> +explain_reason(undef, error, [{M,F,A,_}], _PF, _S) -> %% Only the arity is displayed, not the arguments, if there are any. io_lib:fwrite(<<"undefined function ~s">>, [mfa_to_string(M, F, n_args(A))]); -explain_reason({shell_undef,F,A}, error, [], _PF, _S) -> +explain_reason({shell_undef,F,A,_}, error, [], _PF, _S) -> %% Give nicer reports for undefined shell functions %% (but not when the user actively calls shell_default:F(...)). io_lib:fwrite(<<"undefined shell command ~s/~w">>, [F, n_args(A)]); @@ -292,17 +294,19 @@ argss(I) -> io_lib:fwrite(<<"~w arguments">>, [I]). format_stacktrace1(S0, Stack0, PF, SF) -> - Stack1 = lists:dropwhile(fun({M,F,A}) -> SF(M, F, A) + Stack1 = lists:dropwhile(fun({M,F,A,_}) -> SF(M, F, A) end, lists:reverse(Stack0)), S = [" " | S0], Stack = lists:reverse(Stack1), format_stacktrace2(S, Stack, 1, PF). -format_stacktrace2(S, [{M,F,A}|Fs], N, PF) when is_integer(A) -> - [io_lib:fwrite(<<"~s~s ~s">>, - [sep(N, S), origin(N, M, F, A), mfa_to_string(M, F, A)]) +format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF) when is_integer(A) -> + [io_lib:fwrite(<<"~s~s ~s ~s">>, + [sep(N, S), origin(N, M, F, A), + mfa_to_string(M, F, A), + location(L)]) | format_stacktrace2(S, Fs, N + 1, PF)]; -format_stacktrace2(S, [{M,F,As}|Fs], N, PF) when is_list(As) -> +format_stacktrace2(S, [{M,F,As,_}|Fs], N, PF) when is_list(As) -> A = length(As), CalledAs = [S,<<" called as ">>], C = format_call("", CalledAs, {M,F}, As, PF), @@ -313,6 +317,16 @@ format_stacktrace2(S, [{M,F,As}|Fs], N, PF) when is_list(As) -> format_stacktrace2(_S, [], _N, _PF) -> "". +location(L) -> + File = proplists:get_value(file, L), + Line = proplists:get_value(line, L), + if + File =/= undefined, Line =/= undefined -> + io_lib:format("(~s, line ~w)", [File, Line]); + true -> + "" + end. + sep(1, S) -> S; sep(_, S) -> [$\n | S]. diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index bba46e4cb6..e73c087753 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -628,9 +628,10 @@ keydelete3(_, _, []) -> []. -spec keyreplace(Key, N, TupleList1, NewTuple) -> TupleList2 when Key :: term(), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple()], - NewTuple :: tuple(). + TupleList1 :: [Tuple], + TupleList2 :: [Tuple], + NewTuple :: Tuple, + Tuple :: tuple(). keyreplace(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) -> keyreplace3(K, N, L, New). @@ -660,9 +661,10 @@ keytake(_K, _N, [], _L) -> false. -spec keystore(Key, N, TupleList1, NewTuple) -> TupleList2 when Key :: term(), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple(), ...], - NewTuple :: tuple(). + TupleList1 :: [Tuple], + TupleList2 :: [Tuple, ...], + NewTuple :: Tuple, + Tuple :: tuple(). keystore(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) -> keystore2(K, N, L, New). @@ -740,8 +742,9 @@ keysort_1(_I, X, _EX, [], R) -> TupleList1 :: [T1], TupleList2 :: [T2], TupleList3 :: [(T1 | T2)], - T1 :: tuple(), - T2 :: tuple(). + T1 :: Tuple, + T2 :: Tuple, + Tuple :: tuple(). keymerge(Index, T1, L2) when is_integer(Index), Index > 0 -> case L2 of @@ -842,8 +845,9 @@ ukeysort_1(_I, X, _EX, []) -> TupleList1 :: [T1], TupleList2 :: [T2], TupleList3 :: [(T1 | T2)], - T1 :: tuple(), - T2 :: tuple(). + T1 :: Tuple, + T2 :: Tuple, + Tuple :: tuple(). ukeymerge(Index, L1, T2) when is_integer(Index), Index > 0 -> case L1 of @@ -873,8 +877,9 @@ rukeymerge(Index, T1, L2) when is_integer(Index), Index > 0 -> -spec keymap(Fun, N, TupleList1) -> TupleList2 when Fun :: fun((Term1 :: term()) -> Term2 :: term()), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple()]. + TupleList1 :: [Tuple], + TupleList2 :: [Tuple], + Tuple :: tuple(). keymap(Fun, Index, [Tup|Tail]) -> [setelement(Index, Tup, Fun(element(Index, Tup)))|keymap(Fun, Index, Tail)]; diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 48e22e53fa..63b397f3a5 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -333,17 +333,18 @@ form({function,Line,Name0,Arity0,Clauses0}) -> form(AnyOther) -> AnyOther. function(Name, Arity, Clauses0) -> - {Clauses1,_} = clauses(Clauses0,gb_sets:new()), + Clauses1 = clauses(Clauses0), {Name,Arity,Clauses1}. -clauses([C0|Cs],Bound) -> - {C1,Bound1} = clause(C0,Bound), - {C2,Bound2} = clauses(Cs,Bound1), - {[C1|C2],Bound2}; -clauses([],Bound) -> {[],Bound}. +clauses([C0|Cs]) -> + C1 = clause(C0,gb_sets:new()), + C2 = clauses(Cs), + [C1|C2]; +clauses([]) -> []. + clause({clause,Line,H0,G0,B0},Bound) -> {H1,Bound1} = copy(H0,Bound), - {B1,Bound2} = copy(B0,Bound1), - {{clause,Line,H1,G0,B1},Bound2}. + {B1,_Bound2} = copy(B0,Bound1), + {clause,Line,H1,G0,B1}. copy({call,Line,{remote,_Line2,{atom,_Line3,ets},{atom,_Line4,fun2ms}}, As0},Bound) -> diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 5129ba5074..c1285dab60 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -330,22 +330,22 @@ obsolete_1(erlang, fault, 2) -> obsolete_1(file, rawopen, 2) -> {removed, "deprecated (will be removed in R13B); use file:open/2 with the raw option"}; -obsolete_1(http, request, 1) -> {deprecated,{httpc,request,1},"R15B"}; -obsolete_1(http, request, 2) -> {deprecated,{httpc,request,2},"R15B"}; -obsolete_1(http, request, 4) -> {deprecated,{httpc,request,4},"R15B"}; -obsolete_1(http, request, 5) -> {deprecated,{httpc,request,5},"R15B"}; -obsolete_1(http, cancel_request, 1) -> {deprecated,{httpc,cancel_request,1},"R15B"}; -obsolete_1(http, cancel_request, 2) -> {deprecated,{httpc,cancel_request,2},"R15B"}; -obsolete_1(http, set_option, 2) -> {deprecated,{httpc,set_option,2},"R15B"}; -obsolete_1(http, set_option, 3) -> {deprecated,{httpc,set_option,3},"R15B"}; -obsolete_1(http, set_options, 1) -> {deprecated,{httpc,set_options,1},"R15B"}; -obsolete_1(http, set_options, 2) -> {deprecated,{httpc,set_options,2},"R15B"}; -obsolete_1(http, verify_cookies, 2) -> {deprecated,{httpc,verify_cookies,2},"R15B"}; -obsolete_1(http, verify_cookies, 3) -> {deprecated,{httpc,verify_cookies,3},"R15B"}; -obsolete_1(http, cookie_header, 1) -> {deprecated,{httpc,cookie_header,1},"R15B"}; -obsolete_1(http, cookie_header, 2) -> {deprecated,{httpc,cookie_header,2},"R15B"}; -obsolete_1(http, stream_next, 1) -> {deprecated,{httpc,stream_next,1},"R15B"}; -obsolete_1(http, default_profile, 0) -> {deprecated,{httpc,default_profile,0},"R15B"}; +obsolete_1(http, request, 1) -> {removed,{httpc,request,1},"R15B"}; +obsolete_1(http, request, 2) -> {removed,{httpc,request,2},"R15B"}; +obsolete_1(http, request, 4) -> {removed,{httpc,request,4},"R15B"}; +obsolete_1(http, request, 5) -> {removed,{httpc,request,5},"R15B"}; +obsolete_1(http, cancel_request, 1) -> {removed,{httpc,cancel_request,1},"R15B"}; +obsolete_1(http, cancel_request, 2) -> {removed,{httpc,cancel_request,2},"R15B"}; +obsolete_1(http, set_option, 2) -> {removed,{httpc,set_option,2},"R15B"}; +obsolete_1(http, set_option, 3) -> {removed,{httpc,set_option,3},"R15B"}; +obsolete_1(http, set_options, 1) -> {removed,{httpc,set_options,1},"R15B"}; +obsolete_1(http, set_options, 2) -> {removed,{httpc,set_options,2},"R15B"}; +obsolete_1(http, verify_cookies, 2) -> {removed,{httpc,store_cookies,2},"R15B"}; +obsolete_1(http, verify_cookies, 3) -> {removed,{httpc,store_cookies,3},"R15B"}; +obsolete_1(http, cookie_header, 1) -> {removed,{httpc,cookie_header,1},"R15B"}; +obsolete_1(http, cookie_header, 2) -> {removed,{httpc,cookie_header,2},"R15B"}; +obsolete_1(http, stream_next, 1) -> {removed,{httpc,stream_next,1},"R15B"}; +obsolete_1(http, default_profile, 0) -> {removed,{httpc,default_profile,0},"R15B"}; obsolete_1(httpd, start, 0) -> {removed,{inets,start,[2,3]},"R14B"}; obsolete_1(httpd, start, 1) -> {removed,{inets,start,[2,3]},"R14B"}; @@ -449,7 +449,7 @@ obsolete_1(ssl_pkix, decode_cert, A) when A =:= 1; A =:= 2 -> %% Added in R13B04. obsolete_1(erlang, concat_binary, 1) -> - {deprecated,{erlang,list_to_binary,1},"R15B"}; + {removed,{erlang,list_to_binary,1},"R15B"}; %% Added in R14A. obsolete_1(ssl, peercert, 2) -> @@ -469,6 +469,10 @@ obsolete_1(docb_transform, _, _) -> obsolete_1(docb_xml_check, _, _) -> {deprecated,"the DocBuilder application is deprecated (will be removed in R15B)"}; +%% Added in R15B +obsolete_1(asn1rt, F, _) when F == load_driver; F == unload_driver -> + {deprecated,"deprecated (will be removed in R16A); has no effect as drivers are no longer used."}; + obsolete_1(_, _, _) -> no. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 5ca04ff023..2b691e6abf 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -123,7 +123,7 @@ -record(setup, {parent}). --define(THROWN_ERROR, {?MODULE, throw_error, _}). +-define(THROWN_ERROR, {?MODULE, throw_error, _, _}). -export_type([query_handle/0]). @@ -1272,7 +1272,10 @@ abstr_term(Fun, Line) when is_function(Fun) -> case erlang:fun_info(Fun, type) of {type, external} -> {module, Module} = erlang:fun_info(Fun, module), - {'fun', Line, {function,Module,Name,Arity}}; + {'fun', Line, {function, + {atom,Line,Module}, + {atom,Line,Name}, + {integer,Line,Arity}}}; {type, local} -> {'fun', Line, {function,Name,Arity}} end @@ -3701,7 +3704,8 @@ lookup_join(F1, C1, LuF, C2, Rev) -> maybe_error_logger(allowed, _) -> ok; maybe_error_logger(Name, Why) -> - [_, _, {?MODULE,maybe_error_logger,_} | Stacktrace] = expand_stacktrace(), + [_, _, {?MODULE,maybe_error_logger,_,_} | Stacktrace] = + expand_stacktrace(), 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), @@ -3720,7 +3724,7 @@ expand_stacktrace() -> expand_stacktrace(D) -> _ = erlang:system_flag(backtrace_depth, D), {'EXIT', {foo, Stacktrace}} = (catch erlang:error(foo)), - L = lists:takewhile(fun({M,_,_}) -> M =/= ?MODULE + L = lists:takewhile(fun({M,_,_,_}) -> M =/= ?MODULE end, lists:reverse(Stacktrace)), if length(L) < 3 andalso length(Stacktrace) =:= D -> diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl index dbb524cc74..d7b51a151c 100644 --- a/lib/stdlib/src/random.erl +++ b/lib/stdlib/src/random.erl @@ -26,6 +26,10 @@ -export([seed/0, seed/1, seed/3, uniform/0, uniform/1, uniform_s/1, uniform_s/2, seed0/0]). +-define(PRIME1, 30269). +-define(PRIME2, 30307). +-define(PRIME3, 30323). + %%----------------------------------------------------------------------- %% The type of the state @@ -44,7 +48,11 @@ seed0() -> -spec seed() -> ran(). seed() -> - reseed(seed0()). + case seed_put(seed0()) of + undefined -> seed0(); + {_,_,_} = Tuple -> Tuple + end. + %% seed({A1, A2, A3}) %% Seed random number generation @@ -66,17 +74,15 @@ seed({A1, A2, A3}) -> A3 :: integer(). seed(A1, A2, A3) -> - put(random_seed, - {abs(A1) rem 30269, abs(A2) rem 30307, abs(A3) rem 30323}). + seed_put({(abs(A1) rem (?PRIME1-1)) + 1, % Avoid seed numbers that are + (abs(A2) rem (?PRIME2-1)) + 1, % even divisors of the + (abs(A3) rem (?PRIME3-1)) + 1}). % corresponding primes. --spec reseed(ran()) -> ran(). - -reseed({A1, A2, A3}) -> - case seed(A1, A2, A3) of - undefined -> seed0(); - {_,_,_} = Tuple -> Tuple - end. +-spec seed_put(ran()) -> 'undefined' | ran(). + +seed_put(Seed) -> + put(random_seed, Seed). %% uniform() %% Returns a random float between 0 and 1. @@ -88,11 +94,11 @@ uniform() -> undefined -> seed0(); Tuple -> Tuple end, - B1 = (A1*171) rem 30269, - B2 = (A2*172) rem 30307, - B3 = (A3*170) rem 30323, + B1 = (A1*171) rem ?PRIME1, + B2 = (A2*172) rem ?PRIME2, + B3 = (A3*170) rem ?PRIME3, put(random_seed, {B1,B2,B3}), - R = A1/30269 + A2/30307 + A3/30323, + R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3, R - trunc(R). %% uniform(N) -> I @@ -116,10 +122,10 @@ uniform(N) when is_integer(N), N >= 1 -> State1 :: ran(). uniform_s({A1, A2, A3}) -> - B1 = (A1*171) rem 30269, - B2 = (A2*172) rem 30307, - B3 = (A3*170) rem 30323, - R = A1/30269 + A2/30307 + A3/30323, + B1 = (A1*171) rem ?PRIME1, + B2 = (A2*172) rem ?PRIME2, + B3 = (A3*170) rem ?PRIME3, + R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3, {R - trunc(R), {B1,B2,B3}}. %% uniform_s(N, State) -> {I, NewState} diff --git a/lib/stdlib/src/re.erl b/lib/stdlib/src/re.erl index e08258a535..246d535943 100644 --- a/lib/stdlib/src/re.erl +++ b/lib/stdlib/src/re.erl @@ -48,7 +48,7 @@ split(Subject,RE) -> Subject :: iodata() | unicode:charlist(), RE :: mp() | iodata() | unicode:charlist(), Options :: [ Option ], - Option :: anchored | global | notbol | noteol | notempty + Option :: anchored | notbol | noteol | notempty | {offset, non_neg_integer()} | {newline, nl_spec()} | bsr_anycrlf | bsr_unicode | {return, ReturnType} | {parts, NumParts} | group | trim | CompileOpt, @@ -573,10 +573,10 @@ ucompile(RE,Options) -> re:compile(unicode:characters_to_binary(RE,unicode),Options) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [RE,Options])), - erlang:raise(error,AnyError,[{Mod,compile,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,compile,L,Loc}|Rest]) end. @@ -585,10 +585,10 @@ urun(Subject,RE,Options) -> urun2(Subject,RE,Options) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [Subject,RE,Options])), - erlang:raise(error,AnyError,[{Mod,run,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,run,L,Loc}|Rest]) end. urun2(Subject0,RE0,Options0) -> @@ -625,20 +625,20 @@ grun(Subject,RE,{Options,NeedClean}) -> grun2(Subject,RE,{Options,NeedClean}) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [Subject,RE,Options])), - erlang:raise(error,AnyError,[{Mod,run,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,run,L,Loc}|Rest]) end; grun(Subject,RE,{Options,NeedClean,OrigRE}) -> try grun2(Subject,RE,{Options,NeedClean}) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [Subject,OrigRE,Options])), - erlang:raise(error,AnyError,[{Mod,run,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,run,L,Loc}|Rest]) end. grun2(Subject,RE,{Options,NeedClean}) -> diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index e3e23e09bc..964697cae6 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1088,7 +1088,7 @@ shell_default(F,As,Bs) -> end. shell_undef(F,A) -> - erlang:error({shell_undef,F,A}). + erlang:error({shell_undef,F,A,[]}). local_func_handler(Shell, RT, Ef) -> H = fun(Lf) -> diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index dc31647eb5..2dd5ccce7a 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -27,8 +27,6 @@ which_children/1, count_children/1, check_childspecs/1]). --export([behaviour_info/1]). - %% Internal exports -export([init/1, handle_call/3, handle_info/2, terminate/2, code_change/3]). -export([handle_cast/2]). @@ -90,14 +88,12 @@ -define(is_simple(State), State#state.strategy =:= simple_one_for_one). -%%-------------------------------------------------------------------------- - --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, {{RestartStrategy :: strategy(), + MaxR :: non_neg_integer(), + MaxT :: non_neg_integer()}, + [ChildSpec :: child_spec()]}} + | ignore. %%% --------------------------------------------------- %%% This is a general process supervisor built upon gen_server.erl. @@ -519,9 +515,12 @@ handle_info(Msg, State) -> %% -spec terminate(term(), state()) -> 'ok'. +terminate(_Reason, #state{children=[Child]} = State) when ?is_simple(State) -> + terminate_dynamic_children(Child, dynamics_db(Child#child.restart_type, + State#state.dynamics), + State#state.name); terminate(_Reason, State) -> - terminate_children(State#state.children, State#state.name), - ok. + terminate_children(State#state.children, State#state.name). %% %% Change code for the supervisor. @@ -661,6 +660,9 @@ do_restart(_, normal, Child, State) -> do_restart(_, shutdown, Child, State) -> NState = state_del_child(Child, State), {ok, NState}; +do_restart(_, {shutdown, _Term}, Child, State) -> + NState = state_del_child(Child, State), + {ok, NState}; do_restart(transient, Reason, Child, State) -> report_error(child_terminated, Reason, Child, State#state.name), restart(Child, State); @@ -831,8 +833,109 @@ monitor_child(Pid) -> %% that will be handled in shutdown/2. ok end. - - + + +%%----------------------------------------------------------------- +%% Func: terminate_dynamic_children/3 +%% Args: Child = child_rec() +%% Dynamics = ?DICT() | ?SET() +%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod} +%% Returns: ok +%% +%% +%% Shutdown all dynamic children. This happens when the supervisor is +%% stopped. Because the supervisor can have millions of dynamic children, we +%% can have an significative overhead here. +%%----------------------------------------------------------------- +terminate_dynamic_children(Child, Dynamics, SupName) -> + {Pids, EStack0} = monitor_dynamic_children(Child, Dynamics), + Sz = ?SETS:size(Pids), + EStack = case Child#child.shutdown of + brutal_kill -> + ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + wait_dynamic_children(Child, Pids, Sz, undefined, EStack0); + infinity -> + ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + wait_dynamic_children(Child, Pids, Sz, undefined, EStack0); + Time -> + ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + TRef = erlang:start_timer(Time, self(), kill), + wait_dynamic_children(Child, Pids, Sz, TRef, EStack0) + end, + %% Unrool stacked errors and report them + ?DICT:fold(fun(Reason, Ls, _) -> + report_error(shutdown_error, Reason, + Child#child{pid=Ls}, SupName) + end, ok, EStack). + + +monitor_dynamic_children(#child{restart_type=temporary}, Dynamics) -> + ?SETS:fold(fun(P, {Pids, EStack}) -> + case monitor_child(P) of + ok -> + {?SETS:add_element(P, Pids), EStack}; + {error, normal} -> + {Pids, EStack}; + {error, Reason} -> + {Pids, ?DICT:append(Reason, P, EStack)} + end + end, {?SETS:new(), ?DICT:new()}, Dynamics); +monitor_dynamic_children(#child{restart_type=RType}, Dynamics) -> + ?DICT:fold(fun(P, _, {Pids, EStack}) -> + case monitor_child(P) of + ok -> + {?SETS:add_element(P, Pids), EStack}; + {error, normal} when RType =/= permanent -> + {Pids, EStack}; + {error, Reason} -> + {Pids, ?DICT:append(Reason, P, EStack)} + end + end, {?SETS:new(), ?DICT:new()}, Dynamics). + + +wait_dynamic_children(_Child, _Pids, 0, undefined, EStack) -> + EStack; +wait_dynamic_children(_Child, _Pids, 0, TRef, EStack) -> + %% If the timer has expired before its cancellation, we must empty the + %% mail-box of the 'timeout'-message. + erlang:cancel_timer(TRef), + receive + {timeout, TRef, kill} -> + EStack + after 0 -> + EStack + end; +wait_dynamic_children(#child{shutdown=brutal_kill} = Child, Pids, Sz, + TRef, EStack) -> + receive + {'DOWN', _MRef, process, Pid, killed} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); + + {'DOWN', _MRef, process, Pid, Reason} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, ?DICT:append(Reason, Pid, EStack)) + end; +wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz, + TRef, EStack) -> + receive + {'DOWN', _MRef, process, Pid, shutdown} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); + + {'DOWN', _MRef, process, Pid, normal} when RType =/= permanent -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); + + {'DOWN', _MRef, process, Pid, Reason} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, ?DICT:append(Reason, Pid, EStack)); + + {timeout, TRef, kill} -> + ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + wait_dynamic_children(Child, Pids, Sz-1, undefined, EStack) + end. + %%----------------------------------------------------------------- %% Child/State manipulating functions. %%----------------------------------------------------------------- @@ -1054,7 +1157,7 @@ validRestartType(RestartType) -> throw({invalid_restart_type, RestartType}). validShutdown(Shutdown, _) when is_integer(Shutdown), Shutdown > 0 -> true; -validShutdown(infinity, supervisor) -> true; +validShutdown(infinity, _) -> true; validShutdown(brutal_kill, _) -> true; validShutdown(Shutdown, _) -> throw({invalid_shutdown, Shutdown}). @@ -1135,6 +1238,13 @@ report_error(Error, Reason, Child, SupName) -> error_logger:error_report(supervisor_report, ErrorMsg). +extract_child(Child) when is_list(Child#child.pid) -> + [{nb_children, length(Child#child.pid)}, + {name, Child#child.name}, + {mfargs, Child#child.mfargs}, + {restart_type, Child#child.restart_type}, + {shutdown, Child#child.shutdown}, + {child_type, Child#child.child_type}]; extract_child(Child) -> [{pid, Child#child.pid}, {name, Child#child.name}, diff --git a/lib/stdlib/src/supervisor_bridge.erl b/lib/stdlib/src/supervisor_bridge.erl index 555cb5a66f..e8405ab9a4 100644 --- a/lib/stdlib/src/supervisor_bridge.erl +++ b/lib/stdlib/src/supervisor_bridge.erl @@ -22,15 +22,14 @@ %% External exports -export([start_link/2, start_link/3]). --export([behaviour_info/1]). %% Internal exports -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2]). -export([code_change/3]). -behaviour_info(callbacks) -> - [{init,1},{terminate,2}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, Pid :: pid(), State :: term()} | ignore | {error, Error :: term()}. +-callback terminate(Reason :: (shutdown | term()), State :: term()) -> + Ignored :: term(). %%%----------------------------------------------------------------- %%% This is a rewrite of supervisor_bridge from BS.3. diff --git a/lib/stdlib/src/unicode.erl b/lib/stdlib/src/unicode.erl index a5d9965ca2..e9b90befe6 100644 --- a/lib/stdlib/src/unicode.erl +++ b/lib/stdlib/src/unicode.erl @@ -73,7 +73,7 @@ characters_to_list_int(ML, Encoding) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,Encoding])), erlang:raise(error,TheError,[{Mod,characters_to_list,L}|Rest]) @@ -109,7 +109,7 @@ characters_to_binary(ML) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML])), erlang:raise(error,TheError,[{Mod,characters_to_binary,L}|Rest]) @@ -127,7 +127,7 @@ characters_to_binary_int(ML,InEncoding) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,InEncoding])), erlang:raise(error,TheError,[{Mod,characters_to_binary,L}|Rest]) @@ -159,7 +159,7 @@ characters_to_binary(ML, latin1, Uni) when is_binary(ML) and ((Uni =:= utf8) or _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,latin1,Uni])), erlang:raise(error,TheError, @@ -181,7 +181,7 @@ characters_to_binary(ML,Uni,latin1) when is_binary(ML) and ((Uni =:= utf8) or _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,Uni,latin1])), erlang:raise(error,TheError, @@ -200,7 +200,7 @@ characters_to_binary(ML, InEncoding, OutEncoding) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,InEncoding,OutEncoding])), erlang:raise(error,TheError,[{Mod,characters_to_binary,L}|Rest]) diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 5502c69fa5..aa6a660c34 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -65,6 +65,7 @@ MODULES= \ stdlib_SUITE \ string_SUITE \ supervisor_1 \ + supervisor_2 \ naughty_child \ shell_SUITE \ supervisor_SUITE \ diff --git a/lib/stdlib/test/beam_lib_SUITE.erl b/lib/stdlib/test/beam_lib_SUITE.erl index 27520a5c88..5df19ca7f1 100644 --- a/lib/stdlib/test/beam_lib_SUITE.erl +++ b/lib/stdlib/test/beam_lib_SUITE.erl @@ -181,7 +181,8 @@ error(Conf) when is_list(Conf) -> ?line verify(not_a_beam_file, beam_lib:info(<<"short">>)), ?line {Binary1, _} = split_binary(Binary, byte_size(Binary)-10), - ?line verify(chunk_too_big, beam_lib:chunks(Binary1, ["Abst"])), + LastChunk = last_chunk(Binary), + ?line verify(chunk_too_big, beam_lib:chunks(Binary1, [LastChunk])), ?line Chunks = chunk_info(Binary), ?line {value, {_, AbstractStart, _}} = lists:keysearch("Abst", 1, Chunks), ?line {Binary2, _} = split_binary(Binary, AbstractStart), @@ -205,6 +206,12 @@ error(Conf) when is_list(Conf) -> ?line file:delete(ACopy), ok. +last_chunk(Bin) -> + L = beam_lib:info(Bin), + {chunks,Chunks} = lists:keyfind(chunks, 1, L), + {Last,_,_} = lists:last(Chunks), + Last. + do_error(BeamFile, ACopy) -> % evil tests ?line Chunks = chunk_info(BeamFile), @@ -330,6 +337,7 @@ strip(Conf) when is_list(Conf) -> ?line {Source2D1, BeamFile2D1} = make_beam(PrivDir, simple2, concat), ?line {Source3D1, BeamFile3D1} = make_beam(PrivDir, make_fun, make_fun), ?line {Source4D1, BeamFile4D1} = make_beam(PrivDir, constant, constant), + ?line {Source5D1, BeamFile5D1} = make_beam(PrivDir, lines, lines), ?line NoOfTables = length(ets:all()), ?line P0 = pps(), @@ -360,13 +368,25 @@ strip(Conf) when is_list(Conf) -> ?line {module, make_fun} = code:load_abs(filename:rootname(BeamFile3D1)), ?line {module, constant} = code:load_abs(filename:rootname(BeamFile4D1)), + %% check that line number information is still present after stripping + ?line {module, lines} = code:load_abs(filename:rootname(BeamFile5D1)), + ?line {'EXIT',{badarith,[{lines,t,1,Info}|_]}} = + (catch lines:t(atom)), + ?line true = code:delete(lines), + ?line false = code:purge(lines), + ?line {ok, {lines,BeamFile5D1}} = beam_lib:strip(BeamFile5D1), + ?line {module, lines} = code:load_abs(filename:rootname(BeamFile5D1)), + ?line {'EXIT',{badarith,[{lines,t,1,Info}|_]}} = + (catch lines:t(atom)), + ?line true = (P0 == pps()), ?line NoOfTables = length(ets:all()), ?line delete_files([SourceD1, BeamFileD1, Source2D1, BeamFile2D1, Source3D1, BeamFile3D1, - Source4D1, BeamFile4D1]), + Source4D1, BeamFile4D1, + Source5D1, BeamFile5D1]), ok. @@ -783,6 +803,12 @@ simple_file(File, Module, constant2) -> "t(A) -> " " {a,b,[2,3],x,y}. "]), ok = file:write_file(File, B); +simple_file(File, Module, lines) -> + B = list_to_binary(["-module(", atom_to_list(Module), ").\n" + "-export([t/1]).\n" + "t(A) ->\n" + " A+1.\n"]), + ok = file:write_file(File, B); simple_file(File, Module, F) -> B = list_to_binary(["-module(", atom_to_list(Module), "). " "-export([t/0]). " diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index 22a9d4a7ff..6f77cff2b9 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -34,6 +34,8 @@ -define(datadir(Conf), ?config(data_dir, Conf)). -endif. +-compile(r13). % OTP-9607 + -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, not_run/1, newly_started/1, basic_v8/1, basic_v9/1, @@ -53,7 +55,7 @@ simultaneous_open/1, insert_new/1, repair_continuation/1, otp_5487/1, otp_6206/1, otp_6359/1, otp_4738/1, otp_7146/1, otp_8070/1, otp_8856/1, otp_8898/1, otp_8899/1, otp_8903/1, - otp_8923/1, otp_9282/1]). + otp_8923/1, otp_9282/1, otp_9607/1]). -export([dets_dirty_loop/0]). @@ -112,7 +114,7 @@ all() -> many_clients, otp_4906, otp_5402, simultaneous_open, insert_new, repair_continuation, otp_5487, otp_6206, otp_6359, otp_4738, otp_7146, otp_8070, otp_8856, otp_8898, - otp_8899, otp_8903, otp_8923, otp_9282] + otp_8899, otp_8903, otp_8923, otp_9282, otp_9607] end. groups() -> @@ -554,7 +556,11 @@ dets_dirty_loop() -> {From, [write, Name, Value]} -> Ret = dets:insert(Name, Value), From ! {self(), Ret}, - dets_dirty_loop() + dets_dirty_loop(); + {From, [close, Name]} -> + Ret = dets:close(Name), + From ! {self(), Ret}, + dets_dirty_loop() end. @@ -1568,8 +1574,10 @@ repair(Config, V) -> ?line FileSize = dets:info(TabRef, memory), ?line ok = dets:close(TabRef), crash(Fname, FileSize+20), - ?line {error, {bad_freelists, Fname}} = + %% Used to return bad_freelists, but that changed in OTP-9622 + ?line {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]), + ?line ok = dets:close(TabRef), ?line file:delete(Fname), %% File not closed, opening with read and read_write access tried. @@ -1857,10 +1865,10 @@ fixtable(Config, Version) when is_list(Config) -> ?line {ok, _} = dets:open_file(T, Args), %% badarg - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:safe_fixtable(no_table,true)), - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[T,undefined]}|_]}} = - (catch dets:safe_fixtable(T,undefined)), + ?line check_badarg(catch dets:safe_fixtable(no_table,true), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:safe_fixtable(T,undefined), + dets, safe_fixtable, [T,undefined]), %% The table is not allowed to grow while the elements are inserted: @@ -1940,22 +1948,22 @@ match(Config, Version) -> %% match, badarg MSpec = [{'_',[],['$_']}], - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:match(no_table, '_')), - ?line {'EXIT', {badarg, [{dets,match,[T,'_',not_a_number]}|_]}} = - (catch dets:match(T, '_', not_a_number)), + ?line check_badarg(catch dets:match(no_table, '_'), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:match(T, '_', not_a_number), + dets, match, [T,'_',not_a_number]), ?line {EC1, _} = dets:select(T, MSpec, 1), - ?line {'EXIT', {badarg, [{dets,match,[EC1]}|_]}} = - (catch dets:match(EC1)), + ?line check_badarg(catch dets:match(EC1), + dets, match, [EC1]), %% match_object, badarg - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:match_object(no_table, '_')), - ?line {'EXIT', {badarg, [{dets,match_object,[T,'_',not_a_number]}|_]}} = - (catch dets:match_object(T, '_', not_a_number)), + ?line check_badarg(catch dets:match_object(no_table, '_'), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:match_object(T, '_', not_a_number), + dets, match_object, [T,'_',not_a_number]), ?line {EC2, _} = dets:select(T, MSpec, 1), - ?line {'EXIT', {badarg, [{dets,match_object,[EC2]}|_]}} = - (catch dets:match_object(EC2)), + ?line check_badarg(catch dets:match_object(EC2), + dets, match_object, [EC2]), dets:safe_fixtable(T, true), ?line {[_, _], C1} = dets:match_object(T, '_', 2), @@ -2118,17 +2126,17 @@ select(Config, Version) -> %% badarg MSpec = [{'_',[],['$_']}], - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:select(no_table, MSpec)), - ?line {'EXIT', {badarg, [{dets,select,[T,<<17>>]}|_]}} = - (catch dets:select(T, <<17>>)), - ?line {'EXIT', {badarg, [{dets,select,[T,[]]}|_]}} = - (catch dets:select(T, [])), - ?line {'EXIT', {badarg, [{dets,select,[T,MSpec,not_a_number]}|_]}} = - (catch dets:select(T, MSpec, not_a_number)), + ?line check_badarg(catch dets:select(no_table, MSpec), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:select(T, <<17>>), + dets, select, [T,<<17>>]), + ?line check_badarg(catch dets:select(T, []), + dets, select, [T,[]]), + ?line check_badarg(catch dets:select(T, MSpec, not_a_number), + dets, select, [T,MSpec,not_a_number]), ?line {EC, _} = dets:match(T, '_', 1), - ?line {'EXIT', {badarg, [{dets,select,[EC]}|_]}} = - (catch dets:select(EC)), + ?line check_badarg(catch dets:select(EC), + dets, select, [EC]), AllSpec = [{'_',[],['$_']}], @@ -2210,8 +2218,8 @@ update_counter(Config) when is_list(Config) -> ?line file:delete(Fname), P0 = pps(), - ?line {'EXIT', {badarg, [{dets,update_counter,[no_table,1,1]}|_]}} = - (catch dets:update_counter(no_table, 1, 1)), + ?line check_badarg(catch dets:update_counter(no_table, 1, 1), + dets, update_counter, [no_table,1,1]), Args = [{file,Fname},{keypos,2}], ?line {ok, _} = dets:open_file(T, [{type,set} | Args]), @@ -2254,66 +2262,66 @@ badarg(Config) when is_list(Config) -> %% badargs are tested in match, select and fixtable too. %% open - ?line {'EXIT', {badarg, [{dets,open_file,[{a,tuple},[]]}|_]}} = - (catch dets:open_file({a,tuple},[])), - ?line {'EXIT', {badarg, [{dets,open_file,[{a,tuple}]}|_]}} = - (catch dets:open_file({a,tuple})), - ?line {'EXIT', {badarg, [{dets,open_file,[file,[foo]]}|_]}} = - (catch dets:open_file(file,[foo])), - ?line {'EXIT', {badarg,[{dets,open_file,[{hej,san},[{type,set}|3]]}|_]}} = - (catch dets:open_file({hej,san},[{type,set}|3])), + ?line check_badarg(catch dets:open_file({a,tuple},[]), + dets, open_file, [{a,tuple},[]]), + ?line check_badarg(catch dets:open_file({a,tuple}), + dets, open_file,[{a,tuple}]), + ?line check_badarg(catch dets:open_file(file,[foo]), + dets, open_file, [file,[foo]]), + ?line check_badarg(catch dets:open_file({hej,san},[{type,set}|3]), + dets, open_file, [{hej,san},[{type,set}|3]]), %% insert - ?line {'EXIT', {badarg, [{dets,insert,[no_table,{1,2}]}|_]}} = - (catch dets:insert(no_table, {1,2})), - ?line {'EXIT', {badarg, [{dets,insert,[no_table,[{1,2}]]}|_]}} = - (catch dets:insert(no_table, [{1,2}])), - ?line {'EXIT', {badarg, [{dets,insert,[T,{1,2}]}|_]}} = - (catch dets:insert(T, {1,2})), - ?line {'EXIT', {badarg, [{dets,insert,[T,[{1,2}]]}|_]}} = - (catch dets:insert(T, [{1,2}])), - ?line {'EXIT', {badarg, [{dets,insert,[T,[{1,2,3}|3]]}|_]}} = - (catch dets:insert(T, [{1,2,3} | 3])), + ?line check_badarg(catch dets:insert(no_table, {1,2}), + dets, insert, [no_table,{1,2}]), + ?line check_badarg(catch dets:insert(no_table, [{1,2}]), + dets, insert, [no_table,[{1,2}]]), + ?line check_badarg(catch dets:insert(T, {1,2}), + dets, insert, [T,{1,2}]), + ?line check_badarg(catch dets:insert(T, [{1,2}]), + dets, insert, [T,[{1,2}]]), + ?line check_badarg(catch dets:insert(T, [{1,2,3} | 3]), + dets, insert, [T,[{1,2,3}|3]]), %% lookup{_keys} - ?line {'EXIT', {badarg, [{dets,lookup_keys,[badarg,[]]}|_]}} = - (catch dets:lookup_keys(T, [])), - ?line {'EXIT', {badarg, [{dets,lookup,[no_table,1]}|_]}} = - (catch dets:lookup(no_table, 1)), - ?line {'EXIT', {badarg, [{dets,lookup_keys,[T,[1|2]]}|_]}} = - (catch dets:lookup_keys(T, [1 | 2])), + ?line check_badarg(catch dets:lookup_keys(T, []), + dets, lookup_keys, [badarg,[]]), + ?line check_badarg(catch dets:lookup(no_table, 1), + dets, lookup, [no_table,1]), + ?line check_badarg(catch dets:lookup_keys(T, [1 | 2]), + dets, lookup_keys, [T,[1|2]]), %% member - ?line {'EXIT', {badarg, [{dets,member,[no_table,1]}|_]}} = - (catch dets:member(no_table, 1)), + ?line check_badarg(catch dets:member(no_table, 1), + dets, member, [no_table,1]), %% sync - ?line {'EXIT', {badarg, [{dets,sync,[no_table]}|_]}} = - (catch dets:sync(no_table)), + ?line check_badarg(catch dets:sync(no_table), + dets, sync, [no_table]), %% delete{_keys} - ?line {'EXIT', {badarg, [{dets,delete,[no_table,1]}|_]}} = - (catch dets:delete(no_table, 1)), + ?line check_badarg(catch dets:delete(no_table, 1), + dets, delete, [no_table,1]), %% delete_object - ?line {'EXIT', {badarg, [{dets,delete_object,[no_table,{1,2,3}]}|_]}} = - (catch dets:delete_object(no_table, {1,2,3})), - ?line {'EXIT', {badarg, [{dets,delete_object,[T,{1,2}]}|_]}} = - (catch dets:delete_object(T, {1,2})), - ?line {'EXIT', {badarg, [{dets,delete_object,[no_table,[{1,2,3}]]}|_]}} = - (catch dets:delete_object(no_table, [{1,2,3}])), - ?line {'EXIT', {badarg, [{dets,delete_object,[T,[{1,2}]]}|_]}} = - (catch dets:delete_object(T, [{1,2}])), - ?line {'EXIT', {badarg, [{dets,delete_object,[T,[{1,2,3}|3]]}|_]}} = - (catch dets:delete_object(T, [{1,2,3} | 3])), + ?line check_badarg(catch dets:delete_object(no_table, {1,2,3}), + dets, delete_object, [no_table,{1,2,3}]), + ?line check_badarg(catch dets:delete_object(T, {1,2}), + dets, delete_object, [T,{1,2}]), + ?line check_badarg(catch dets:delete_object(no_table, [{1,2,3}]), + dets, delete_object, [no_table,[{1,2,3}]]), + ?line check_badarg(catch dets:delete_object(T, [{1,2}]), + dets, delete_object, [T,[{1,2}]]), + ?line check_badarg(catch dets:delete_object(T, [{1,2,3} | 3]), + dets, delete_object, [T,[{1,2,3}|3]]), %% first,next,slot - ?line {'EXIT', {badarg, [{dets,first,[no_table]}|_]}} = - (catch dets:first(no_table)), - ?line {'EXIT', {badarg, [{dets,next,[no_table,1]}|_]}} = - (catch dets:next(no_table, 1)), - ?line {'EXIT', {badarg, [{dets,slot,[no_table,0]}|_]}} = - (catch dets:slot(no_table, 0)), + ?line check_badarg(catch dets:first(no_table), + dets, first, [no_table]), + ?line check_badarg(catch dets:next(no_table, 1), + dets, next, [no_table,1]), + ?line check_badarg(catch dets:slot(no_table, 0), + dets, slot, [no_table,0]), %% info ?line undefined = dets:info(no_table), @@ -2321,27 +2329,27 @@ badarg(Config) when is_list(Config) -> ?line undefined = dets:info(T, foo), %% match_delete - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:match_delete(no_table, '_')), + ?line check_badarg(catch dets:match_delete(no_table, '_'), + dets, safe_fixtable, [no_table,true]), %% delete_all_objects - ?line {'EXIT', {badarg, [{dets,delete_all_objects,[no_table]}|_]}} = - (catch dets:delete_all_objects(no_table)), + ?line check_badarg(catch dets:delete_all_objects(no_table), + dets, delete_all_objects, [no_table]), %% select_delete MSpec = [{'_',[],['$_']}], - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:select_delete(no_table, MSpec)), - ?line {'EXIT', {badarg, [{dets,select_delete,[T, <<17>>]}|_]}} = - (catch dets:select_delete(T, <<17>>)), + ?line check_badarg(catch dets:select_delete(no_table, MSpec), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:select_delete(T, <<17>>), + dets, select_delete, [T, <<17>>]), %% traverse, fold - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:traverse(no_table, fun(_) -> continue end)), - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:foldl(fun(_, A) -> A end, [], no_table)), - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:foldr(fun(_, A) -> A end, [], no_table)), + ?line check_badarg(catch dets:traverse(no_table, fun(_) -> continue end), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:foldl(fun(_, A) -> A end, [], no_table), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:foldr(fun(_, A) -> A end, [], no_table), + dets, safe_fixtable, [no_table,true]), %% close ?line ok = dets:close(T), @@ -2349,15 +2357,16 @@ badarg(Config) when is_list(Config) -> ?line {error, not_owner} = dets:close(T), %% init_table - ?line {'EXIT', {badarg,[{dets,init_table,[no_table,_,[]]}|_]}} = - (catch dets:init_table(no_table, fun(X) -> X end)), - ?line {'EXIT', {badarg,[{dets,init_table,[no_table,_,[]]}|_]}} = - (catch dets:init_table(no_table, fun(X) -> X end, [])), + IF = fun(X) -> X end, + ?line check_badarg(catch dets:init_table(no_table, IF), + dets, init_table, [no_table,IF,[]]), + ?line check_badarg(catch dets:init_table(no_table, IF, []), + dets, init_table, [no_table,IF,[]]), %% from_ets Ets = ets:new(ets,[]), - ?line {'EXIT', {badarg,[{dets,from_ets,[no_table,_]}|_]}} = - (catch dets:from_ets(no_table, Ets)), + ?line check_badarg(catch dets:from_ets(no_table, Ets), + dets, from_ets, [no_table,Ets]), ets:delete(Ets), ?line {ok, T} = dets:open_file(T, Args), @@ -3879,10 +3888,91 @@ some_calls(Tab, Config) -> ?line ok = dets:close(T), file:delete(File). +otp_9607(doc) -> + ["OTP-9607. Test downgrading the slightly changed format."]; +otp_9607(suite) -> + []; +otp_9607(Config) when is_list(Config) -> + %% Note: the bug is about almost full tables. The fix of that + %% problem is *not* tested here. + Version = r13b, + case ?t:is_release_available(atom_to_list(Version)) of + true -> + T = otp_9607, + File = filename(T, Config), + Key = a, + Value = 1, + Args = [{file,File}], + ?line {ok, T} = dets:open_file(T, Args), + ?line ok = dets:insert(T, {Key, Value}), + ?line ok = dets:close(T), + + ?line Call = fun(P, A) -> + P ! {self(), A}, + receive + {P, Ans} -> + Ans + after 5000 -> + exit(other_process_dead) + end + end, + %% Create a file on the modified format, read the file + %% with an emulator that doesn't know about the modified + %% format. + ?line {ok, Node} = start_node_rel(Version, Version, slave), + ?line Pid = rpc:call(Node, erlang, spawn, + [?MODULE, dets_dirty_loop, []]), + ?line {error,{needs_repair, File}} = + Call(Pid, [open, T, Args++[{repair,false}]]), + io:format("Expect repair:~n"), + ?line {ok, T} = Call(Pid, [open, T, Args]), + ?line [{Key,Value}] = Call(Pid, [read, T, Key]), + ?line ok = Call(Pid, [close, T]), + file:delete(File), + + %% Create a file on the unmodified format. Modify the file + %% using an emulator that must not turn the file into the + %% modified format. Read the file and make sure it is not + %% repaired. + ?line {ok, T} = Call(Pid, [open, T, Args]), + ?line ok = Call(Pid, [write, T, {Key,Value}]), + ?line [{Key,Value}] = Call(Pid, [read, T, Key]), + ?line ok = Call(Pid, [close, T]), + + Key2 = b, + Value2 = 2, + + ?line {ok, T} = dets:open_file(T, Args), + ?line [{Key,Value}] = dets:lookup(T, Key), + ?line ok = dets:insert(T, {Key2,Value2}), + ?line ok = dets:close(T), + + ?line {ok, T} = Call(Pid, [open, T, Args++[{repair,false}]]), + ?line [{Key2,Value2}] = Call(Pid, [read, T, Key2]), + ?line ok = Call(Pid, [close, T]), + + ?t:stop_node(Node), + file:delete(File), + ok; + false -> + {skipped, "No support for old node"} + end. + + + %% %% Parts common to several test cases %% +start_node_rel(Name, Rel, How) -> + Release = [{release, atom_to_list(Rel)}], + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line test_server:start_node(Name, How, + [{args, + " -kernel net_setuptime 100 " + " -pa " ++ Pa}, + {erl, Release}]). + crash(File, Where) -> crash(File, Where, 10). @@ -4268,6 +4358,11 @@ bad_object({error,{{bad_object,_}, FileName}}, FileName) -> bad_object({error,{{{bad_object,_,_},_,_,_}, FileName}}, FileName) -> ok. % Debug. +check_badarg({'EXIT', {badarg, [{M,F,Args,_} | _]}}, M, F, Args) -> + true; +check_badarg({'EXIT', {badarg, [{M,F,A,_} | _]}}, M, F, Args) -> + true = test_server:is_native(M) andalso length(Args) =:= A. + check_pps(P0) -> case pps() of P0 -> diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 57f3f4eddb..f79414db49 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -20,7 +20,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). --export([rec_1/1, predef_mac/1, +-export([rec_1/1, include_local/1, predef_mac/1, upcase_mac_1/1, upcase_mac_2/1, variable_1/1, otp_4870/1, otp_4871/1, otp_5362/1, pmod/1, not_circular/1, skip_header/1, otp_6277/1, otp_7702/1, @@ -63,7 +63,7 @@ end_per_testcase(_, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [rec_1, {group, upcase_mac}, predef_mac, + [rec_1, {group, upcase_mac}, include_local, predef_mac, {group, variable}, otp_4870, otp_4871, otp_5362, pmod, not_circular, skip_header, otp_6277, otp_7702, otp_8130, overload_mac, otp_8388, otp_8470, otp_8503, otp_8562, @@ -97,6 +97,22 @@ rec_1(Config) when is_list(Config) -> ?line check_errors(List), ok. +include_local(doc) -> + []; +include_local(suite) -> + []; +include_local(Config) when is_list(Config) -> + ?line DataDir = ?config(data_dir, Config), + ?line File = filename:join(DataDir, "include_local.erl"), + %% include_local.erl includes include/foo.hrl which + %% includes bar.hrl (also in include/) without requiring + %% any additional include path, and overriding any file + %% of the same name that the path points to + ?line {ok, List} = epp:parse_file(File, [DataDir], []), + ?line {value, {attribute,_,a,{true,true}}} = + lists:keysearch(a,3,List), + ok. + %%% Here is a little reimplementation of epp:parse_file, which times out %%% after 4 seconds if the epp server doesn't respond. If we use the %%% regular epp:parse_file, the test case will time out, and then epp @@ -234,16 +250,23 @@ otp_4871(Config) when is_list(Config) -> %% so there are some sanity checks before killing. ?line {ok,Epp} = epp:open(File, []), timer:sleep(1), - ?line {current_function,{epp,_,_}} = process_info(Epp, current_function), + ?line true = current_module(Epp, epp), ?line {monitored_by,[Io]} = process_info(Epp, monitored_by), - ?line {current_function,{file_io_server,_,_}} = - process_info(Io, current_function), + ?line true = current_module(Io, file_io_server), ?line exit(Io, emulate_crash), timer:sleep(1), ?line {error,{_Line,epp,cannot_parse}} = otp_4871_parse_file(Epp), ?line epp:close(Epp), ok. +current_module(Pid, Mod) -> + case process_info(Pid, current_function) of + {current_function, undefined} -> + true = test_server:is_native(Mod); + {current_function, {Mod, _, _}} -> + true + end. + otp_4871_parse_file(Epp) -> case epp:parse_erl_form(Epp) of {ok,_} -> otp_4871_parse_file(Epp); diff --git a/lib/stdlib/test/epp_SUITE_data/bar.hrl b/lib/stdlib/test/epp_SUITE_data/bar.hrl new file mode 100644 index 0000000000..01c527d549 --- /dev/null +++ b/lib/stdlib/test/epp_SUITE_data/bar.hrl @@ -0,0 +1,4 @@ +%% should not be included from include/foo.hrl even though the +%% include path points here - include/bar.hrl overrides it + +-define(BAR_HRL, false). diff --git a/lib/stdlib/test/epp_SUITE_data/include/bar.hrl b/lib/stdlib/test/epp_SUITE_data/include/bar.hrl new file mode 100644 index 0000000000..038d3c900e --- /dev/null +++ b/lib/stdlib/test/epp_SUITE_data/include/bar.hrl @@ -0,0 +1,3 @@ +%% included from foo.hrl in same directory + +-define(BAR_HRL, true). diff --git a/lib/stdlib/test/epp_SUITE_data/include/foo.hrl b/lib/stdlib/test/epp_SUITE_data/include/foo.hrl new file mode 100644 index 0000000000..a6dfa3d18a --- /dev/null +++ b/lib/stdlib/test/epp_SUITE_data/include/foo.hrl @@ -0,0 +1,4 @@ +%% includes bar.hrl in same directory + +-define(FOO_HRL, true). +-include("bar.hrl"). diff --git a/lib/stdlib/test/epp_SUITE_data/include_local.erl b/lib/stdlib/test/epp_SUITE_data/include_local.erl new file mode 100644 index 0000000000..c8e155a064 --- /dev/null +++ b/lib/stdlib/test/epp_SUITE_data/include_local.erl @@ -0,0 +1,6 @@ + +-module(include_local). + +-include("include/foo.hrl"). + +-a({?FOO_HRL, ?BAR_HRL}). diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index 784c7cb86e..369d8b224e 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1036,6 +1036,12 @@ funs(Config) when is_list(Config) -> lists:usort([run_many_args(SAs) || SAs <- many_args(MaxArgs)]), ?line {'EXIT',{{argument_limit,_},_}} = (catch run_many_args(many_args1(MaxArgs+1))), + + ?line check(fun() -> M = lists, F = fun M:reverse/1, + [1,2] = F([2,1]), ok end, + "begin M = lists, F = fun M:reverse/1," + " [1,2] = F([2,1]), ok end.", + ok), ok. run_many_args({S, As}) -> diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 280c95b1aa..64853ca078 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -116,7 +116,6 @@ func(Config) when is_list(Config) -> {func_3, <<"t() -> fun t/0.">>}, {func_4, - %% Has already been expanded away in sys_pre_expand. <<"t() -> fun modul:foo/3.">>}, {func_5, % 'when' is moved down one line <<"tkjlksjflksdjflsdjlk() @@ -127,7 +126,9 @@ func(Config) when is_list(Config) -> <<"t() -> (fun() -> true - end)().">>} + end)().">>}, + {func_7, + <<"t(M, F, A) -> fun M:F/A.">>} ], ?line compile(Config, Ts), ok. diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 57df963ae2..0e8849b5b3 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -74,7 +74,7 @@ -export([bad_table/1, types/1]). -export([otp_9423/1]). --export([init_per_testcase/2, end_per_testcase/2]). +-export([init_per_testcase/2]). %% Convenience for manual testing -export([random_test/0]). @@ -176,6 +176,7 @@ groups() -> meta_newdel_unnamed, meta_newdel_named]}]. init_per_suite(Config) -> + erts_debug:set_internal_state(available_internal_state, true), Config. end_per_suite(_Config) -> @@ -304,7 +305,6 @@ t_match_spec_run(Config) when is_list(Config) -> end, repeat_for_permutations(F, N_MS) end, - test_terms(Fun, skip_refc_check), ?line verify_etsmem(EtsMem). @@ -324,7 +324,7 @@ t_match_spec_run_test(List, MS, Result) -> %% Check that tracing agree Self = self(), - {Tracee, MonRef} = spawn_monitor(fun() -> ms_tracee(Self, List) end), + {Tracee, MonRef} = my_spawn_monitor(fun() -> ms_tracee(Self, List) end), receive {Tracee, ready} -> ok end, MST = lists:map(fun(Clause) -> ms_clause_ets_to_trace(Clause) end, MS), @@ -585,7 +585,6 @@ select_fail_do(Opts) -> memory(doc) -> ["Whitebox test of ets:info(X,memory)"]; memory(suite) -> []; memory(Config) when is_list(Config) -> - ?line erts_debug:set_internal_state(available_internal_state, true), ?line ok = chk_normal_tab_struct_size(), repeat_for_opts(memory_do,[compressed]), ?line catch erts_debug:set_internal_state(available_internal_state, false). @@ -795,21 +794,26 @@ t_ets_dets(Config, Opts) -> ?line true = ets:from_dets(ETab,DTab), ?line 3000 = ets:info(ETab,size), ?line ets:delete(ETab), - ?line {'EXIT',{badarg,[{ets,to_dets,[ETab,DTab]}|_]}} = - (catch ets:to_dets(ETab,DTab)), - ?line {'EXIT',{badarg,[{ets,from_dets,[ETab,DTab]}|_]}} = - (catch ets:from_dets(ETab,DTab)), + ?line check_badarg(catch ets:to_dets(ETab,DTab), + ets, to_dets, [ETab,DTab]), + ?line check_badarg(catch ets:from_dets(ETab,DTab), + ets, from_dets, [ETab,DTab]), ?line ETab2 = ets_new(x,Opts), ?line filltabint(ETab2,3000), ?line dets:close(DTab), - ?line {'EXIT',{badarg,[{ets,to_dets,[ETab2,DTab]}|_]}} = - (catch ets:to_dets(ETab2,DTab)), - ?line {'EXIT',{badarg,[{ets,from_dets,[ETab2,DTab]}|_]}} = - (catch ets:from_dets(ETab2,DTab)), + ?line check_badarg(catch ets:to_dets(ETab2,DTab), + ets, to_dets, [ETab2,DTab]), + ?line check_badarg(catch ets:from_dets(ETab2,DTab), + ets, from_dets, [ETab2,DTab]), ?line ets:delete(ETab2), ?line (catch file:delete(Fname)), ok. +check_badarg({'EXIT', {badarg, [{M,F,Args,_} | _]}}, M, F, Args) -> + true; +check_badarg({'EXIT', {badarg, [{M,F,A,_} | _]}}, M, F, Args) -> + true = test_server:is_native(M) andalso length(Args) =:= A. + t_delete_all_objects(doc) -> ["Test ets:delete_all_objects/1"]; t_delete_all_objects(suite) -> @@ -1942,7 +1946,7 @@ evil_update_counter(Config) when is_list(Config) -> evil_update_counter_do(Opts) -> ?line EtsMem = etsmem(), ?line process_flag(trap_exit, true), - ?line Pids = [spawn_link(fun() -> evil_counter(I,Opts) end) || I <- lists:seq(1, 40)], + ?line Pids = [my_spawn_link(fun() -> evil_counter(I,Opts) end) || I <- lists:seq(1, 40)], ?line wait_for_all(gb_sets:from_list(Pids)), ?line verify_etsmem(EtsMem), ok. @@ -2148,24 +2152,24 @@ heir_do(Opts) -> Combos), %% No heir - {Founder1,MrefF1} = spawn_monitor(fun()->heir_founder(Master,foo_data,Opts)end), + {Founder1,MrefF1} = my_spawn_monitor(fun()->heir_founder(Master,foo_data,Opts)end), Founder1 ! {go, none}, ?line {"No heir",Founder1} = receive_any(), ?line {'DOWN', MrefF1, process, Founder1, normal} = receive_any(), ?line undefined = ets:info(foo), %% An already dead heir - {Heir2,MrefH2} = spawn_monitor(fun()->die end), + {Heir2,MrefH2} = my_spawn_monitor(fun()->die end), ?line {'DOWN', MrefH2, process, Heir2, normal} = receive_any(), - {Founder2,MrefF2} = spawn_monitor(fun()->heir_founder(Master,foo_data,Opts)end), + {Founder2,MrefF2} = my_spawn_monitor(fun()->heir_founder(Master,foo_data,Opts)end), Founder2 ! {go, Heir2}, ?line {"No heir",Founder2} = receive_any(), ?line {'DOWN', MrefF2, process, Founder2, normal} = receive_any(), ?line undefined = ets:info(foo), %% When heir dies before founder - {Founder3,MrefF3} = spawn_monitor(fun()->heir_founder(Master,"The dying heir",Opts)end), - {Heir3,MrefH3} = spawn_monitor(fun()->heir_heir(Founder3)end), + {Founder3,MrefF3} = my_spawn_monitor(fun()->heir_founder(Master,"The dying heir",Opts)end), + {Heir3,MrefH3} = my_spawn_monitor(fun()->heir_heir(Founder3)end), Founder3 ! {go, Heir3}, ?line {'DOWN', MrefH3, process, Heir3, normal} = receive_any(), Founder3 ! die_please, @@ -2173,14 +2177,12 @@ heir_do(Opts) -> ?line undefined = ets:info(foo), %% When heir dies and pid reused before founder dies - erts_debug:set_internal_state(available_internal_state,true), NextPidIx = erts_debug:get_internal_state(next_pid), - {Founder4,MrefF4} = spawn_monitor(fun()->heir_founder(Master,"The dying heir",Opts)end), - {Heir4,MrefH4} = spawn_monitor(fun()->heir_heir(Founder4)end), + {Founder4,MrefF4} = my_spawn_monitor(fun()->heir_founder(Master,"The dying heir",Opts)end), + {Heir4,MrefH4} = my_spawn_monitor(fun()->heir_heir(Founder4)end), Founder4 ! {go, Heir4}, ?line {'DOWN', MrefH4, process, Heir4, normal} = receive_any(), erts_debug:set_internal_state(next_pid, NextPidIx), - erts_debug:set_internal_state(available_internal_state,false), {Heir4,MrefH4_B} = spawn_monitor_with_pid(Heir4, fun()-> ?line die_please = receive_any() end), Founder4 ! die_please, @@ -2256,9 +2258,9 @@ heir_heir(Founder, Mode) -> heir_1(HeirData,Mode,Opts) -> io:format("test with heir_data = ~p\n", [HeirData]), Master = self(), - ?line Founder = spawn_link(fun() -> heir_founder(Master,HeirData,Opts) end), + ?line Founder = my_spawn_link(fun() -> heir_founder(Master,HeirData,Opts) end), io:format("founder spawned = ~p\n", [Founder]), - ?line {Heir,Mref} = spawn_monitor(fun() -> heir_heir(Founder,Mode) end), + ?line {Heir,Mref} = my_spawn_monitor(fun() -> heir_heir(Founder,Mode) end), io:format("heir spawned = ~p\n", [{Heir,Mref}]), ?line Founder ! {go, Heir}, ?line {'DOWN', Mref, process, Heir, normal} = receive_any(). @@ -2275,7 +2277,7 @@ give_away_do(Opts) -> Parent = self(), %% Give and then give back - ?line {Receiver,Mref} = spawn_monitor(fun()-> give_away_receiver(T,Parent) end), + ?line {Receiver,Mref} = my_spawn_monitor(fun()-> give_away_receiver(T,Parent) end), ?line give_me = receive_any(), ?line true = ets:give_away(T,Receiver,here_you_are), ?line {'EXIT',{badarg,_}} = (catch ets:lookup(T,key)), @@ -2286,7 +2288,7 @@ give_away_do(Opts) -> %% Give and then let receiver keep it ?line true = ets:insert(T,{key,1}), - ?line {Receiver3,Mref3} = spawn_monitor(fun()-> give_away_receiver(T,Parent) end), + ?line {Receiver3,Mref3} = my_spawn_monitor(fun()-> give_away_receiver(T,Parent) end), ?line give_me = receive_any(), ?line true = ets:give_away(T,Receiver3,here_you_are), ?line {'EXIT',{badarg,_}} = (catch ets:lookup(T,key)), @@ -2298,7 +2300,7 @@ give_away_do(Opts) -> ?line T2 = ets_new(foo,[private | Opts]), ?line true = ets:insert(T2,{key,1}), ?line ets:setopts(T2,{heir,self(),"Som en gummiboll..."}), - ?line {Receiver2,Mref2} = spawn_monitor(fun()-> give_away_receiver(T2,Parent) end), + ?line {Receiver2,Mref2} = my_spawn_monitor(fun()-> give_away_receiver(T2,Parent) end), ?line give_me = receive_any(), ?line true = ets:give_away(T2,Receiver2,here_you_are), ?line {'EXIT',{badarg,_}} = (catch ets:lookup(T2,key)), @@ -2313,12 +2315,12 @@ give_away_do(Opts) -> ?line {'EXIT',{badarg,_}} = (catch ets:give_away(T2,"not a pid","To wrong type")), ?line true = ets:delete(T2), - ?line {ReceiverNeg,MrefNeg} = spawn_monitor(fun()-> give_away_receiver(T2,Parent) end), + ?line {ReceiverNeg,MrefNeg} = my_spawn_monitor(fun()-> give_away_receiver(T2,Parent) end), ?line give_me = receive_any(), ?line {'EXIT',{badarg,_}} = (catch ets:give_away(T2,ReceiverNeg,"A deleted table")), ?line T3 = ets_new(foo,[public | Opts]), - spawn_link(fun()-> {'EXIT',{badarg,_}} = (catch ets:give_away(T3,ReceiverNeg,"From non owner")), + my_spawn_link(fun()-> {'EXIT',{badarg,_}} = (catch ets:give_away(T3,ReceiverNeg,"From non owner")), Parent ! done end), ?line done = receive_any(), @@ -2354,7 +2356,7 @@ setopts_do(Opts) -> Self = self(), ?line T = ets_new(foo,[named_table, private | Opts]), ?line none = ets:info(T,heir), - Heir = spawn_link(fun()->heir_heir(Self) end), + Heir = my_spawn_link(fun()->heir_heir(Self) end), ?line ets:setopts(T,{heir,Heir,"Data"}), ?line Heir = ets:info(T,heir), ?line ets:setopts(T,{heir,self(),"Data"}), @@ -2405,14 +2407,14 @@ bad_table(Config) when is_list(Config) -> bad_table_do(Opts, DummyFile) -> Parent = self(), - {Pid,Mref} = spawn_opt(fun()-> ets_new(priv,[private,named_table | Opts]), - Priv = ets_new(priv,[private | Opts]), - ets_new(prot,[protected,named_table | Opts]), - Prot = ets_new(prot,[protected | Opts]), - Parent ! {self(),Priv,Prot}, - die_please = receive_any() - end, - [link, monitor]), + {Pid,Mref} = my_spawn_opt(fun()-> ets_new(priv,[private,named_table | Opts]), + Priv = ets_new(priv,[private | Opts]), + ets_new(prot,[protected,named_table | Opts]), + Prot = ets_new(prot,[protected | Opts]), + Parent ! {self(),Priv,Prot}, + die_please = receive_any() + end, + [link, monitor]), {Pid,Priv,Prot} = receive_any(), MatchSpec = {{key,'_'}, [], ['$$']}, Fun = fun(X,_) -> X end, @@ -2652,7 +2654,7 @@ maybe_sort(L) when is_list(L) -> %maybe_sort({'EXIT',{Reason, [{Module, Function, _}|_]}}) -> % {'EXIT',{Reason, [{Module, Function, '_'}]}}; maybe_sort({'EXIT',{Reason, List}}) when is_list(List) -> - {'EXIT',{Reason, lists:map(fun({Module, Function, _}) -> + {'EXIT',{Reason, lists:map(fun({Module, Function, _, _}) -> {Module, Function, '_'} end, List)}}; @@ -3258,7 +3260,7 @@ delete_large_named_table_1(Name, Flags, Data, Fix) -> ?line lists:foreach(fun({K,_}) -> ets:delete(Tab, K) end, Data) end, Parent = self(), - Pid = spawn_link(fun() -> + Pid = my_spawn_link(fun() -> receive {trace,Parent,call,_} -> ets_new(Name, [named_table]) @@ -3620,7 +3622,7 @@ cycle(Tab, L) -> ets:insert(Tab,list_to_tuple(L)), cycle(Tab, tl(L)++[hd(L)]). -dynamic_go() -> spawn_link(fun dynamic_init/0). +dynamic_go() -> my_spawn_link(fun dynamic_init/0). dynamic_init() -> [dyn_lookup(?MODULE) || _ <- lists:seq(1, 10)]. @@ -3847,7 +3849,7 @@ safe_fixtable_do(Opts) -> Self = self(), ?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed), %% Test that an unjustified 'unfix' is a no-op. - {Pid,MRef} = spawn_monitor(fun() -> true = ets:safe_fixtable(Tab,false) end), + {Pid,MRef} = my_spawn_monitor(fun() -> true = ets:safe_fixtable(Tab,false) end), {'DOWN', MRef, process, Pid, normal} = receive M -> M end, ?line true = ets:info(Tab,fixed), ?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed), @@ -4251,7 +4253,7 @@ do_heavy_concurrent(Opts) -> ?line ok = fill_tab2(Tab, 0, Size), ?line Procs = lists:map( fun (N) -> - spawn_link( + my_spawn_link( fun () -> do_heavy_concurrent_proc(Tab, Size, N) end) @@ -4855,12 +4857,7 @@ otp_7665_act(Tab,Min,Max,DelNr) -> %% Whitebox testing of meta name table hashing. meta_wb(Config) when is_list(Config) -> ?line EtsMem = etsmem(), - ?line erts_debug:set_internal_state(available_internal_state, true), - try - repeat_for_opts(meta_wb_do) - after - erts_debug:set_internal_state(available_internal_state, false) - end, + repeat_for_opts(meta_wb_do), ?line verify_etsmem(EtsMem). @@ -4929,12 +4926,15 @@ colliding_names(Name) -> grow_shrink(Config) when is_list(Config) -> ?line EtsMem = etsmem(), - grow_shrink_0(lists:seq(3071, 5000), EtsMem). + ?line grow_shrink_0(lists:seq(3071, 5000), EtsMem), + ?line verify_etsmem(EtsMem). grow_shrink_0([N|Ns], EtsMem) -> ?line grow_shrink_1(N, [set]), ?line grow_shrink_1(N, [ordered_set]), - ?line verify_etsmem(EtsMem), + %% Verifying ets-memory here takes too long time, since + %% lock-free allocators were introduced... + %% ?line verify_etsmem(EtsMem), grow_shrink_0(Ns, EtsMem); grow_shrink_0([], _) -> ok. @@ -4981,13 +4981,13 @@ grow_pseudo_deleted_do(Type) -> ?line Left = ets:info(T,size), ?line Mult = get_kept_objects(T), filltabstr(T,Mult), - spawn_opt(fun()-> ?line true = ets:info(T,fixed), - Self ! start, - io:format("Starting to filltabstr... ~p\n",[now()]), - filltabstr(T,Mult,Mult+10000), - io:format("Done with filltabstr. ~p\n",[now()]), - Self ! done - end, [link, {scheduler,2}]), + my_spawn_opt(fun()-> ?line true = ets:info(T,fixed), + Self ! start, + io:format("Starting to filltabstr... ~p\n",[now()]), + filltabstr(T,Mult,Mult+10000), + io:format("Done with filltabstr. ~p\n",[now()]), + Self ! done + end, [link, {scheduler,2}]), ?line start = receive_any(), io:format("Unfixing table...~p nitems=~p\n",[now(),ets:info(T,size)]), ?line true = ets:safe_fixtable(T,false), @@ -5021,13 +5021,13 @@ shrink_pseudo_deleted_do(Type) -> [true]}]), ?line Half = ets:info(T,size), ?line Half = get_kept_objects(T), - spawn_opt(fun()-> ?line true = ets:info(T,fixed), - Self ! start, - io:format("Starting to delete... ~p\n",[now()]), - del_one_by_one_set(T,1,Half+1), - io:format("Done with delete. ~p\n",[now()]), - Self ! done - end, [link, {scheduler,2}]), + my_spawn_opt(fun()-> ?line true = ets:info(T,fixed), + Self ! start, + io:format("Starting to delete... ~p\n",[now()]), + del_one_by_one_set(T,1,Half+1), + io:format("Done with delete. ~p\n",[now()]), + Self ! done + end, [link, {scheduler,2}]), ?line start = receive_any(), io:format("Unfixing table...~p nitems=~p\n",[now(),ets:info(T,size)]), ?line true = ets:safe_fixtable(T,false), @@ -5184,24 +5184,24 @@ smp_unfix_fix_do() -> ?line Deleted = get_kept_objects(T), {Child, Mref} = - spawn_opt(fun()-> ?line true = ets:info(T,fixed), - Parent ! start, - io:format("Child waiting for table to be unfixed... now=~p mem=~p\n", - [now(),ets:info(T,memory)]), - repeat_while(fun()-> ets:info(T,fixed) end), - io:format("Table unfixed. Child Fixating! now=~p mem=~p\n", - [now(),ets:info(T,memory)]), - ?line true = ets:safe_fixtable(T,true), - repeat_while(fun(Key) when Key =< NumOfObjs -> - ets:delete(T,Key), {true,Key+1}; - (Key) -> {false,Key} - end, - Deleted), - ?line 0 = ets:info(T,size), - ?line true = get_kept_objects(T) >= Left, - ?line done = receive_any() - end, - [link, monitor, {scheduler,2}]), + my_spawn_opt(fun()-> ?line true = ets:info(T,fixed), + Parent ! start, + io:format("Child waiting for table to be unfixed... now=~p mem=~p\n", + [now(),ets:info(T,memory)]), + repeat_while(fun()-> ets:info(T,fixed) end), + io:format("Table unfixed. Child Fixating! now=~p mem=~p\n", + [now(),ets:info(T,memory)]), + ?line true = ets:safe_fixtable(T,true), + repeat_while(fun(Key) when Key =< NumOfObjs -> + ets:delete(T,Key), {true,Key+1}; + (Key) -> {false,Key} + end, + Deleted), + ?line 0 = ets:info(T,size), + ?line true = get_kept_objects(T) >= Left, + ?line done = receive_any() + end, + [link, monitor, {scheduler,2}]), ?line start = receive_any(), ?line true = ets:info(T,fixed), @@ -5232,11 +5232,11 @@ otp_8166_do(WC) -> Deleted = NumOfObjs div 2, filltabint(T,NumOfObjs), {ReaderPid, ReaderMref} = - spawn_opt(fun()-> otp_8166_reader(T,NumOfObjs) end, - [link, monitor, {scheduler,2}]), + my_spawn_opt(fun()-> otp_8166_reader(T,NumOfObjs) end, + [link, monitor, {scheduler,2}]), {ZombieCrPid, ZombieCrMref} = - spawn_opt(fun()-> otp_8166_zombie_creator(T,Deleted) end, - [link, monitor, {scheduler,3}]), + my_spawn_opt(fun()-> otp_8166_zombie_creator(T,Deleted) end, + [link, monitor, {scheduler,3}]), repeat(fun() -> ZombieCrPid ! {loop, self()}, zombies_created = receive_any(), @@ -5496,7 +5496,7 @@ run_workers_do(InitF,ExecF,FiniF,Laps, Exclude) -> io:format("smp starting ~p workers\n",[NumOfProcs]), Seeds = [{ProcN,random:uniform(9999)} || ProcN <- lists:seq(1,NumOfProcs)], Parent = self(), - Pids = [spawn_link(fun()-> worker(Seed,InitF,ExecF,FiniF,Laps,Parent,NumOfProcs) end) + Pids = [my_spawn_link(fun()-> worker(Seed,InitF,ExecF,FiniF,Laps,Parent,NumOfProcs) end) || Seed <- Seeds], case Laps of infinite -> Pids; @@ -5545,31 +5545,30 @@ my_tab_to_list(_Ts,'$end_of_table', Acc) -> lists:reverse(Acc); my_tab_to_list(Ts,Key, Acc) -> my_tab_to_list(Ts,ets:next(Ts,Key),[ets:lookup(Ts, Key)| Acc]). -wait_for_all_schedulers_online_to_execute() -> - PMs = lists:map(fun (Sched) -> - spawn_opt(fun () -> ok end, - [monitor, {scheduler, Sched}]) - end, - lists:seq(1,erlang:system_info(schedulers_online))), - lists:foreach(fun ({P, M}) -> - receive - {'DOWN', M, process, P, _} -> ok - end - end, - PMs), - ok. + +wait_for_memory_deallocations() -> + try + erts_debug:set_internal_state(wait, deallocations) + catch + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + wait_for_memory_deallocations() + end. + etsmem() -> - %% Wait until it is guaranteed that all already scheduled - %% deallocations of DbTable structures have completed. - wait_for_all_schedulers_online_to_execute(), + wait_for_memory_deallocations(), AllTabs = lists:map(fun(T) -> {T,ets:info(T,name),ets:info(T,size), ets:info(T,memory),ets:info(T,type)} end, ets:all()), + + EtsAllocInfo = erlang:system_info({allocator,ets_alloc}), + ErlangMemoryEts = try erlang:memory(ets) catch error:notsup -> notsup end, + Mem = - {try erlang:memory(ets) catch error:notsup -> notsup end, - case erlang:system_info({allocator,ets_alloc}) of + {ErlangMemoryEts, + case EtsAllocInfo of false -> undefined; MemInfo -> CS = lists:foldl( @@ -5646,6 +5645,7 @@ spawn_logger(Procs) -> true -> exit(Proc, kill); _ -> ok end, + erlang:display(process_info(Proc)), receive {'DOWN', Mon, _, _, _} -> ok @@ -5681,7 +5681,7 @@ wait_for_test_procs(Kill) -> ets_test_spawn_logger ! {sync_test_procs, Kill, self()}, receive test_procs_synced -> ok end. -log_test_proc(Proc) -> +log_test_proc(Proc) when is_pid(Proc) -> ets_test_spawn_logger ! {new_test_proc, Proc}, Proc. @@ -5693,9 +5693,17 @@ my_spawn_link(Fun) -> log_test_proc(spawn_link(Fun)). my_spawn_link(M,F,A) -> log_test_proc(spawn_link(M,F,A)). %%my_spawn_link(N,M,F,A) -> log_test_proc(spawn_link(N,M,F,A)). -my_spawn_opt(Fun,Opts) -> log_test_proc(spawn_opt(Fun,Opts)). -%%my_spawn_opt(M,F,A,Opts) -> log_test_proc(spawn_opt(M,F,A,Opts)). -%%my_spawn_opt(N,M,F,A,Opts) -> log_test_proc(spawn_opt(N,M,F,A,Opts)). +my_spawn_opt(Fun,Opts) -> + case spawn_opt(Fun,Opts) of + Pid when is_pid(Pid) -> log_test_proc(Pid); + {Pid, _} = Res when is_pid(Pid) -> log_test_proc(Pid), Res + end. + +my_spawn_monitor(Fun) -> + Res = spawn_monitor(Fun), + {Pid, _} = Res, + log_test_proc(Pid), + Res. repeat(_Fun, 0) -> ok; @@ -5758,11 +5766,11 @@ spawn_monitor_with_pid(Pid, Fun, N, M) when N > M*10 -> spawn_monitor_with_pid(Pid, Fun, N, M*10); spawn_monitor_with_pid(Pid, Fun, N, M) -> ?line false = is_process_alive(Pid), - case spawn(fun()-> case self() of - Pid -> Fun(); - _ -> die - end - end) of + case my_spawn(fun()-> case self() of + Pid -> Fun(); + _ -> die + end + end) of Pid -> {Pid, erlang:monitor(process, Pid)}; Other -> diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 3010f5e760..1de639a166 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -97,11 +97,12 @@ wildcard_errors(Config) when is_list(Config) -> wcc(Wc, Error) -> {'EXIT',{{badpattern,Error}, - [{filelib,compile_wildcard,1}|_]}} = (catch filelib:compile_wildcard(Wc)), + [{filelib,compile_wildcard,1,_}|_]}} = + (catch filelib:compile_wildcard(Wc)), {'EXIT',{{badpattern,Error}, - [{filelib,wildcard,1}|_]}} = (catch filelib:wildcard(Wc)), + [{filelib,wildcard,1,_}|_]}} = (catch filelib:wildcard(Wc)), {'EXIT',{{badpattern,Error}, - [{filelib,wildcard,2}|_]}} = (catch filelib:wildcard(Wc, ".")). + [{filelib,wildcard,2,_}|_]}} = (catch filelib:wildcard(Wc, ".")). do_wildcard_1(Dir, Wcf0) -> do_wildcard_2(Dir, Wcf0), diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl index 4e5df12798..c9688354b1 100644 --- a/lib/stdlib/test/ms_transform_SUITE.erl +++ b/lib/stdlib/test/ms_transform_SUITE.erl @@ -39,6 +39,7 @@ -export([float_1_function/1]). -export([action_function/1]). -export([warnings/1]). +-export([no_warnings/1]). -export([init_per_testcase/2, end_per_testcase/2]). init_per_testcase(_Func, Config) -> @@ -55,7 +56,7 @@ all() -> [from_shell, basic_ets, basic_dbg, records, record_index, multipass, bitsyntax, record_defaults, andalso_orelse, float_1_function, action_function, - warnings, top_match, old_guards, autoimported, + warnings, no_warnings, top_match, old_guards, autoimported, semicolon]. groups() -> @@ -155,6 +156,34 @@ warnings(Config) when is_list(Config) -> compile_ww(Prog7), ok. +no_warnings(suite) -> + []; +no_warnings(doc) -> + ["Check that variables bound in other function clauses don't generate " + "warning"]; +no_warnings(Config) when is_list(Config) -> + ?line setup(Config), + Prog = <<"tmp(X) when X > 100 ->\n", + " Y=X,\n" + " Y;\n" + "tmp(X) ->\n" + " ets:fun2ms(fun(Y) ->\n" + " {X, 3*Y}\n" + " end)">>, + ?line [] = compile_no_ww(Prog), + + Prog2 = <<"tmp(X) when X > 100 ->\n", + " Y=X,\n" + " Y;\n" + "tmp(X) when X < 200 ->\n" + " ok;\n" + "tmp(X) ->\n" + " ets:fun2ms(fun(Y) ->\n" + " {X, 3*Y}\n" + " end)">>, + ?line [] = compile_no_ww(Prog2), + ok. + andalso_orelse(suite) -> []; andalso_orelse(doc) -> @@ -842,6 +871,20 @@ compile_ww(Records,Expr) -> nowarn_unused_record]), Wlist. +compile_no_ww(Expr) -> + Prog = << + "-module(tmp).\n", + "-include_lib(\"stdlib/include/ms_transform.hrl\").\n", + "-export([tmp/1]).\n\n", + Expr/binary,".\n">>, + FN=temp_name(), + file:write_file(FN,Prog), + {ok,Forms} = epp:parse_file(FN,"",""), + {ok,tmp,_Bin,Wlist} = compile:forms(Forms,[return_warnings, + nowarn_unused_vars, + nowarn_unused_record]), + Wlist. + do_eval(String) -> {done,{ok,T,_},[]} = erl_scan:tokens( [], diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl index 1565aa9bba..c95089117c 100644 --- a/lib/stdlib/test/proc_lib_SUITE.erl +++ b/lib/stdlib/test/proc_lib_SUITE.erl @@ -328,7 +328,7 @@ otp_6345(doc) -> ["'monitor' spawn_opt option"]; otp_6345(Config) when is_list(Config) -> Opts = [link,monitor], - {'EXIT', {badarg,[{proc_lib,check_for_monitor,_}|_Stack]}} = + {'EXIT', {badarg,[{proc_lib,check_for_monitor,_,_}|_Stack]}} = (catch proc_lib:start(?MODULE, otp_6345_init, [self()], 1000, Opts)), ok. diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 98eeaee118..8a9d8f7883 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -6632,7 +6632,7 @@ otp_7232(Config) when is_list(Config) -> {call,_, {remote,_,{atom,_,qlc},{atom,_,sort}}, [{cons,_, - {'fun',_,{function,math,sqrt,_}}, + {'fun',_,{function,{atom,_,math},{atom,_,sqrt},_}}, {cons,_, {string,_,\"<0.4.1>\"}, % could use list_to_pid.. {cons,_,{string,_,\"#Ref<\"++_},{nil,_}}}}, diff --git a/lib/stdlib/test/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl index c4817c0d38..3b2e637c84 100644 --- a/lib/stdlib/test/re_SUITE.erl +++ b/lib/stdlib/test/re_SUITE.erl @@ -454,115 +454,115 @@ error_handling(Config) when is_list(Config) -> % The malformed precomiled RE is detected after % the trap to re:grun from grun, in the grun function clause % that handles precompiled expressions - ?line {'EXIT',{badarg,[{re,run,["apa",{1,2,3,4},[global]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,run,["apa",{1,2,3,4},[global]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:run("apa",{1,2,3,4},[global])), % An invalid capture list will also cause a badarg late, % but with a non pre compiled RE, the exception should be thrown by the % grun function clause that handles RE's compiled implicitly by % the run/3 BIF before trapping. - ?line {'EXIT',{badarg,[{re,run,["apa","p",[{capture,[1,{a}]},global]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,run,["apa","p",[{capture,[1,{a}]},global]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:run("apa","p",[{capture,[1,{a}]},global])), % And so the case of a precompiled expression together with % a compile-option (binary and list subject): ?line {ok,RE} = re:compile("(p)"), ?line {match,[[{1,1},{1,1}]]} = re:run(<<"apa">>,RE,[global]), ?line {match,[[{1,1},{1,1}]]} = re:run("apa",RE,[global]), - {'EXIT',{badarg,[{re,run, - [<<"apa">>, - {re_pattern,1,0,_}, - [global,unicode]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,run, + [<<"apa">>, + {re_pattern,1,0,_}, + [global,unicode]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:run(<<"apa">>,RE,[global,unicode])), - {'EXIT',{badarg,[{re,run, - ["apa", - {re_pattern,1,0,_}, - [global,unicode]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,run, + ["apa", + {re_pattern,1,0,_}, + [global,unicode]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:run("apa",RE,[global,unicode])), ?line {'EXIT',{badarg,_}} = (catch re:run("apa","(p",[])), ?line {'EXIT',{badarg,_}} = (catch re:run("apa","(p",[global])), % The replace errors: - ?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:replace("apa",{1,2,3,4},"X",[])), - ?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[global]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[global]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:replace("apa",{1,2,3,4},"X",[global])), ?line {'EXIT',{badarg,[{re,replace, ["apa", {re_pattern,1,0,_}, "X", - [unicode]]}, - {?MODULE, error_handling,1} | _]}} = + [unicode]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:replace("apa",RE,"X",[unicode])), ?line <<"aXa">> = iolist_to_binary(re:replace("apa","p","X",[])), ?line {'EXIT',{badarg,[{re,replace, - ["apa","p","X",[{capture,all,binary}]]}, - {?MODULE, error_handling,1} | _]}} = + ["apa","p","X",[{capture,all,binary}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch iolist_to_binary(re:replace("apa","p","X", [{capture,all,binary}]))), ?line {'EXIT',{badarg,[{re,replace, - ["apa","p","X",[{capture,all}]]}, - {?MODULE, error_handling,1} | _]}} = + ["apa","p","X",[{capture,all}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch iolist_to_binary(re:replace("apa","p","X", [{capture,all}]))), ?line {'EXIT',{badarg,[{re,replace, - ["apa","p","X",[{return,banana}]]}, - {?MODULE, error_handling,1} | _]}} = + ["apa","p","X",[{return,banana}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch iolist_to_binary(re:replace("apa","p","X", [{return,banana}]))), ?line {'EXIT',{badarg,_}} = (catch re:replace("apa","(p","X",[])), % Badarg, not compile error. ?line {'EXIT',{badarg,[{re,replace, - ["apa","(p","X",[{return,banana}]]}, - {?MODULE, error_handling,1} | _]}} = + ["apa","(p","X",[{return,banana}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch iolist_to_binary(re:replace("apa","(p","X", [{return,banana}]))), % And the split errors: ?line [<<"a">>,<<"a">>] = (catch re:split("apa","p",[])), ?line [<<"a">>,<<"p">>,<<"a">>] = (catch re:split("apa",RE,[])), - ?line {'EXIT',{badarg,[{re,split,["apa","p",[global]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa","p",[global]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa","p",[global])), - ?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all}]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa","p",[{capture,all}])), - ?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all,binary}]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all,binary}]],_}, + {?MODULE, error_handling,1,_} | _]}} = (catch re:split("apa","p",[{capture,all,binary}])), - ?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",{1,2,3,4})), - ?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",{1,2,3,4},[])), ?line {'EXIT',{badarg,[{re,split, ["apa", RE, - [unicode]]}, - {?MODULE, error_handling,1} | _]}} = + [unicode]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",RE,[unicode])), ?line {'EXIT',{badarg,[{re,split, ["apa", RE, - [{return,banana}]]}, - {?MODULE, error_handling,1} | _]}} = + [{return,banana}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",RE,[{return,banana}])), ?line {'EXIT',{badarg,[{re,split, ["apa", RE, - [banana]]}, - {?MODULE, error_handling,1} | _]}} = + [banana]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",RE,[banana])), ?line {'EXIT',{badarg,_}} = (catch re:split("apa","(p")), %Exception on bad argument, not compilation error ?line {'EXIT',{badarg,[{re,split, ["apa", "(p", - [banana]]}, - {?MODULE, error_handling,1} | _]}} = + [banana]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa","(p",[banana])), ?t:timetrap_cancel(Dog), ok. diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 8273377ba1..b6019b86f0 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -2388,12 +2388,12 @@ otp_6554(Config) when is_list(Config) -> comm_err(<<"V = lists:seq(1, 20), case V of a -> ok end.">>), ?line "exception error: no function clause matching" = comm_err(<<"fun(P) when is_pid(P) -> true end(a).">>), - ?line "exception error: {function_clause,[{erl_eval,do_apply,[unproper|list]}"++_ = + ?line "exception error: {function_clause," = comm_err(<<"erlang:error(function_clause, [unproper | list]).">>), ?line "exception error: function_clause" = comm_err(<<"erlang:error(function_clause, 4).">>), %% Cheating: - ?line "exception error: no function clause matching erl_eval:do_apply(4)" = + ?line "exception error: no function clause matching erl_eval:do_apply(4)" ++ _ = comm_err(<<"erlang:error(function_clause, [4]).">>), ?line "exception error: no function clause matching" ++ _ = comm_err(<<"fun(a, b, c, d) -> foo end" @@ -2406,7 +2406,7 @@ otp_6554(Config) when is_list(Config) -> comm_err(<<"fun(P, q) when is_pid(P) -> true end(a, b).">>), ?line "exception error: no function clause matching lists:reverse(" ++ _ = comm_err(<<"F=fun() -> hello end, lists:reverse(F).">>), - ?line "exception error: no function clause matching lists:reverse(34)" = + ?line "exception error: no function clause matching lists:reverse(34) (lists.erl, line " ++ _ = comm_err(<<"lists:reverse(34).">>), ?line "exception error: no true branch found when evaluating an if expression" = comm_err(<<"if length([a,b]) > 17 -> a end.">>), diff --git a/lib/stdlib/test/sofs_SUITE.erl b/lib/stdlib/test/sofs_SUITE.erl index d6f88a655e..73b282149a 100644 --- a/lib/stdlib/test/sofs_SUITE.erl +++ b/lib/stdlib/test/sofs_SUITE.erl @@ -1879,11 +1879,11 @@ digraph(Conf) when is_list(Conf) -> ?line {'EXIT', {badarg, _}} = (catch family_to_digraph(set([a]))), - ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_]}|_]}} = + ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_],_}|_]}} = (catch family_to_digraph(set([a]), [foo])), - ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_]}|_]}} = + ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_],_}|_]}} = (catch family_to_digraph(F, [foo])), - ?line {'EXIT', {cyclic, [{sofs,family_to_digraph,[_,_]}|_]}} = + ?line {'EXIT', {cyclic, [{sofs,family_to_digraph,[_,_],_}|_]}} = (catch family_to_digraph(family([{a,[a]}]),[acyclic])), ?line G1 = family_to_digraph(E), diff --git a/lib/stdlib/test/supervisor_1.erl b/lib/stdlib/test/supervisor_1.erl index 3198be0fed..f819594c46 100644 --- a/lib/stdlib/test/supervisor_1.erl +++ b/lib/stdlib/test/supervisor_1.erl @@ -62,6 +62,12 @@ handle_info(die, State) -> handle_info(stop, State) -> {stop, normal, State}; +handle_info({'EXIT',_,shutdown}, State) -> + {stop, shutdown, State}; + +handle_info({'EXIT',_,{shutdown,Term}}, State) -> + {stop, {shutdown,Term}, State}; + handle_info({sleep, Time}, State) -> io:format("FOO: ~p~n", [Time]), timer:sleep(Time), diff --git a/lib/ssl/test/ssl_test_MACHINE.hrl b/lib/stdlib/test/supervisor_2.erl index e78b33f505..67aacf5a9c 100644 --- a/lib/ssl/test/ssl_test_MACHINE.hrl +++ b/lib/stdlib/test/supervisor_2.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2010. 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 @@ -16,24 +16,27 @@ %% %% %CopyrightEnd% %% +%% Description: Simulates the behaviour that a child process may have. +%% Is used by the supervisor_SUITE test suite. +-module(supervisor_2). --record(st, {protomod = ssl, - serialize_accept = false, - parent = nil, - type = nil, - active = nil, - port = 0, - peer = nil, - lsock = nil, - sock = nil, - timeout = infinity, - sockopts = [], - sslopts = [], - protocols = []}). +-export([start_child/1, init/1]). -%%-define(debug(X, Y), io:format(X, Y)). --define(debug(X, Y), ok). --define(error(X, Y), io:format(X, Y)). +-export([handle_call/3, handle_info/2, terminate/2]). --define(DEFAULT_TIMEOUT, 240000). +start_child(Time) when is_integer(Time), Time > 0 -> + gen_server:start_link(?MODULE, Time, []). +init(Time) -> + process_flag(trap_exit, true), + {ok, Time}. + +handle_call(Req, _From, State) -> + {reply, Req, State}. + +handle_info(_, State) -> + {noreply, State}. + +terminate(_Reason, Time) -> + timer:sleep(Time), + ok. diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index b48450c151..da6996cc9f 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -41,6 +41,8 @@ %% Tests concept permanent, transient and temporary -export([ permanent_normal/1, transient_normal/1, temporary_normal/1, + permanent_shutdown/1, transient_shutdown/1, + temporary_shutdown/1, permanent_abnormal/1, transient_abnormal/1, temporary_abnormal/1, temporary_bystander/1]). @@ -50,7 +52,7 @@ one_for_all_escalation/1, simple_one_for_one/1, simple_one_for_one_escalation/1, rest_for_one/1, rest_for_one_escalation/1, - simple_one_for_one_extra/1]). + simple_one_for_one_extra/1, simple_one_for_one_shutdown/1]). %% Misc tests -export([child_unlink/1, tree/1, count_children_memory/1, @@ -71,6 +73,7 @@ all() -> {group, restart_simple_one_for_one}, {group, restart_rest_for_one}, {group, normal_termination}, + {group, shutdown_termination}, {group, abnormal_termination}, child_unlink, tree, count_children_memory, do_not_save_start_parameters_for_temporary_children, do_not_save_child_specs_for_temporary_children, @@ -86,6 +89,8 @@ groups() -> sup_stop_brutal_kill]}, {normal_termination, [], [permanent_normal, transient_normal, temporary_normal]}, + {shutdown_termination, [], + [permanent_shutdown, transient_shutdown, temporary_shutdown]}, {abnormal_termination, [], [permanent_abnormal, transient_abnormal, temporary_abnormal]}, @@ -94,8 +99,8 @@ groups() -> {restart_one_for_all, [], [one_for_all, one_for_all_escalation]}, {restart_simple_one_for_one, [], - [simple_one_for_one, simple_one_for_one_extra, - simple_one_for_one_escalation]}, + [simple_one_for_one, simple_one_for_one_shutdown, + simple_one_for_one_extra, simple_one_for_one_escalation]}, {restart_rest_for_one, [], [rest_for_one, rest_for_one_escalation]}]. @@ -115,7 +120,9 @@ end_per_group(_GroupName, Config) -> init_per_testcase(count_children_memory, Config) -> try erlang:memory() of - _ -> Config + _ -> + erts_debug:set_internal_state(available_internal_state, true), + Config catch error:notsup -> {skip, "+Meamin used during test; erlang:memory/1 not available"} end; @@ -123,6 +130,9 @@ init_per_testcase(_Case, Config) -> erlang:display(_Case), Config. +end_per_testcase(count_children_memory, _Config) -> + catch erts_debug:set_internal_state(available_internal_state, false), + ok; end_per_testcase(_Case, _Config) -> ok. @@ -204,8 +214,8 @@ sup_start_fail(Config) when is_list(Config) -> %%------------------------------------------------------------------------- sup_stop_infinity(doc) -> - ["See sup_stop/1 when Shutdown = infinity, this walue is only allowed " - "for children of type supervisor"]; + ["See sup_stop/1 when Shutdown = infinity, this walue is allowed " + "for children of type supervisor _AND_ worker"]; sup_stop_infinity(suite) -> []; sup_stop_infinity(Config) when is_list(Config) -> @@ -216,12 +226,13 @@ sup_stop_infinity(Config) when is_list(Config) -> Child2 = {child2, {supervisor_1, start_child, []}, permanent, infinity, worker, []}, {ok, CPid1} = supervisor:start_child(sup_test, Child1), + {ok, CPid2} = supervisor:start_child(sup_test, Child2), link(CPid1), - {error, {invalid_shutdown,infinity}} = - supervisor:start_child(sup_test, Child2), + link(CPid2), terminate(Pid, shutdown), - check_exit_reason(CPid1, shutdown). + check_exit_reason(CPid1, shutdown), + check_exit_reason(CPid2, shutdown). %%------------------------------------------------------------------------- @@ -453,9 +464,8 @@ child_specs(Config) when is_list(Config) -> B2 = {child, {m,f,[a]}, prmanent, 1000, worker, []}, B3 = {child, {m,f,[a]}, permanent, -10, worker, []}, B4 = {child, {m,f,[a]}, permanent, 10, wrker, []}, - B5 = {child, {m,f,[a]}, permanent, infinity, worker, []}, - B6 = {child, {m,f,[a]}, permanent, 1000, worker, dy}, - B7 = {child, {m,f,[a]}, permanent, 1000, worker, [1,2,3]}, + B5 = {child, {m,f,[a]}, permanent, 1000, worker, dy}, + B6 = {child, {m,f,[a]}, permanent, 1000, worker, [1,2,3]}, %% Correct child specs! %% <Modules> (last parameter in a child spec) can be [] as we do @@ -464,6 +474,7 @@ child_specs(Config) when is_list(Config) -> C2 = {child, {m,f,[a]}, permanent, 1000, supervisor, []}, C3 = {child, {m,f,[a]}, temporary, 1000, worker, dynamic}, C4 = {child, {m,f,[a]}, transient, 1000, worker, [m]}, + C5 = {child, {m,f,[a]}, permanent, infinity, worker, [m]}, {error, {invalid_mfa,mfa}} = supervisor:start_child(sup_test, B1), {error, {invalid_restart_type, prmanent}} = @@ -472,9 +483,8 @@ child_specs(Config) when is_list(Config) -> = supervisor:start_child(sup_test, B3), {error, {invalid_child_type,wrker}} = supervisor:start_child(sup_test, B4), - {error, _} = supervisor:start_child(sup_test, B5), {error, {invalid_modules,dy}} - = supervisor:start_child(sup_test, B6), + = supervisor:start_child(sup_test, B5), {error, {invalid_mfa,mfa}} = supervisor:check_childspecs([B1]), {error, {invalid_restart_type,prmanent}} = @@ -482,15 +492,15 @@ child_specs(Config) when is_list(Config) -> {error, {invalid_shutdown,-10}} = supervisor:check_childspecs([B3]), {error, {invalid_child_type,wrker}} = supervisor:check_childspecs([B4]), - {error, _} = supervisor:check_childspecs([B5]), - {error, {invalid_modules,dy}} = supervisor:check_childspecs([B6]), + {error, {invalid_modules,dy}} = supervisor:check_childspecs([B5]), {error, {invalid_module, 1}} = - supervisor:check_childspecs([B7]), + supervisor:check_childspecs([B6]), ok = supervisor:check_childspecs([C1]), ok = supervisor:check_childspecs([C2]), ok = supervisor:check_childspecs([C3]), ok = supervisor:check_childspecs([C4]), + ok = supervisor:check_childspecs([C5]), ok. %%------------------------------------------------------------------------- @@ -549,6 +559,87 @@ temporary_normal(Config) when is_list(Config) -> [0,0,0,0] = get_child_counts(sup_test). %%------------------------------------------------------------------------- +permanent_shutdown(doc) -> + ["A permanent child should always be restarted"]; +permanent_shutdown(suite) -> []; +permanent_shutdown(Config) when is_list(Config) -> + {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), + Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, + worker, []}, + + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + + terminate(SupPid, CPid1, child1, shutdown), + + [{child1, CPid2 ,worker,[]}] = supervisor:which_children(sup_test), + case is_pid(CPid2) of + true -> + ok; + false -> + test_server:fail({permanent_child_not_restarted, Child1}) + end, + [1,1,0,1] = get_child_counts(sup_test), + + terminate(SupPid, CPid2, child1, {shutdown, some_info}), + + [{child1, CPid3 ,worker,[]}] = supervisor:which_children(sup_test), + case is_pid(CPid3) of + true -> + ok; + false -> + test_server:fail({permanent_child_not_restarted, Child1}) + end, + + [1,1,0,1] = get_child_counts(sup_test). + +%%------------------------------------------------------------------------- +transient_shutdown(doc) -> + ["A transient child should not be restarted if it exits with " + "reason shutdown or {shutdown,Term}"]; +transient_shutdown(suite) -> []; +transient_shutdown(Config) when is_list(Config) -> + {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), + Child1 = {child1, {supervisor_1, start_child, []}, transient, 1000, + worker, []}, + + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + + terminate(SupPid, CPid1, child1, shutdown), + + [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test), + [1,0,0,1] = get_child_counts(sup_test), + + {ok, CPid2} = supervisor:restart_child(sup_test, child1), + + terminate(SupPid, CPid2, child1, {shutdown, some_info}), + + [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test), + [1,0,0,1] = get_child_counts(sup_test). + +%%------------------------------------------------------------------------- +temporary_shutdown(doc) -> + ["A temporary process should never be restarted"]; +temporary_shutdown(suite) -> []; +temporary_shutdown(Config) when is_list(Config) -> + {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), + Child1 = {child1, {supervisor_1, start_child, []}, temporary, 1000, + worker, []}, + + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + + terminate(SupPid, CPid1, child1, shutdown), + + [] = supervisor:which_children(sup_test), + [0,0,0,0] = get_child_counts(sup_test), + + {ok, CPid2} = supervisor:start_child(sup_test, Child1), + + terminate(SupPid, CPid2, child1, {shutdown, some_info}), + + [] = supervisor:which_children(sup_test), + [0,0,0,0] = get_child_counts(sup_test). + +%%------------------------------------------------------------------------- permanent_abnormal(doc) -> ["A permanent child should always be restarted"]; permanent_abnormal(suite) -> []; @@ -782,6 +873,38 @@ simple_one_for_one(Config) when is_list(Config) -> terminate(SupPid, Pid4, Id4, abnormal), check_exit([SupPid]). + +%%------------------------------------------------------------------------- +simple_one_for_one_shutdown(doc) -> + ["Test simple_one_for_one children shutdown accordingly to the " + "supervisor's shutdown strategy."]; +simple_one_for_one_shutdown(suite) -> []; +simple_one_for_one_shutdown(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ShutdownTime = 1000, + Child = {child, {supervisor_2, start_child, []}, + permanent, 2*ShutdownTime, worker, []}, + {ok, SupPid} = start_link({ok, {{simple_one_for_one, 2, 3600}, [Child]}}), + + %% Will be gracefully shutdown + {ok, _CPid1} = supervisor:start_child(sup_test, [ShutdownTime]), + {ok, _CPid2} = supervisor:start_child(sup_test, [ShutdownTime]), + + %% Will be killed after 2*ShutdownTime milliseconds + {ok, _CPid3} = supervisor:start_child(sup_test, [5*ShutdownTime]), + + {T, ok} = timer:tc(fun terminate/2, [SupPid, shutdown]), + if T < 1000*ShutdownTime -> + %% Because supervisor's children wait before exiting, it can't + %% terminate quickly + test_server:fail({shutdown_too_short, T}); + T >= 1000*5*ShutdownTime -> + test_server:fail({shutdown_too_long, T}); + true -> + check_exit([SupPid]) + end. + + %%------------------------------------------------------------------------- simple_one_for_one_extra(doc) -> ["Tests automatic restart of children " @@ -1018,25 +1141,25 @@ count_children_memory(Config) when is_list(Config) -> [supervisor:start_child(sup_test, []) || _Ignore <- lists:seq(1,1000)], garbage_collect(), - _Size1 = erlang:memory(processes_used), + _Size1 = proc_memory(), Children = supervisor:which_children(sup_test), - _Size2 = erlang:memory(processes_used), + _Size2 = proc_memory(), ChildCount = get_child_counts(sup_test), - _Size3 = erlang:memory(processes_used), + _Size3 = proc_memory(), [supervisor:start_child(sup_test, []) || _Ignore2 <- lists:seq(1,1000)], garbage_collect(), Children2 = supervisor:which_children(sup_test), - Size4 = erlang:memory(processes_used), + Size4 = proc_memory(), ChildCount2 = get_child_counts(sup_test), - Size5 = erlang:memory(processes_used), + Size5 = proc_memory(), garbage_collect(), Children3 = supervisor:which_children(sup_test), - Size6 = erlang:memory(processes_used), + Size6 = proc_memory(), ChildCount3 = get_child_counts(sup_test), - Size7 = erlang:memory(processes_used), + Size7 = proc_memory(), 1000 = length(Children), [1,1000,0,1000] = ChildCount, @@ -1062,6 +1185,10 @@ count_children_memory(Config) when is_list(Config) -> [terminate(SupPid, Pid, child, kill) || {undefined, Pid, worker, _Modules} <- Children3], [1,0,0,0] = get_child_counts(sup_test). +proc_memory() -> + erts_debug:set_internal_state(wait, deallocations), + erlang:memory(processes_used). + %%------------------------------------------------------------------------- do_not_save_start_parameters_for_temporary_children(doc) -> ["Temporary children shall not be restarted so they should not " @@ -1282,6 +1409,13 @@ terminate(_, ChildPid, _, shutdown) -> {'DOWN', Ref, process, ChildPid, shutdown} -> ok end; +terminate(_, ChildPid, _, {shutdown, Term}) -> + Ref = erlang:monitor(process, ChildPid), + exit(ChildPid, {shutdown, Term}), + receive + {'DOWN', Ref, process, ChildPid, {shutdown, Term}} -> + ok + end; terminate(_, ChildPid, _, normal) -> Ref = erlang:monitor(process, ChildPid), ChildPid ! stop, diff --git a/lib/stdlib/test/unicode_SUITE.erl b/lib/stdlib/test/unicode_SUITE.erl index 9aa800209d..4055af2741 100644 --- a/lib/stdlib/test/unicode_SUITE.erl +++ b/lib/stdlib/test/unicode_SUITE.erl @@ -322,7 +322,7 @@ roundtrips(Config) when is_list(Config) -> ex_roundtrips(Config) when is_list(Config) -> ?line L1 = ranges(0, 16#D800 - 1, erlang:system_info(context_reductions) * 11), - ?line L2 = ranges(16#DFFF + 1, 16#FFFE - 1, + ?line L2 = ranges(16#DFFF + 1, 16#10000 - 1, erlang:system_info(context_reductions) * 11), %?line L3 = ranges(16#FFFF + 1, 16#10FFFF, % erlang:system_info(context_reductions) * 11), @@ -569,7 +569,6 @@ utf16_illegal_sequences_bif(Config) when is_list(Config) -> ex_utf16_illegal_sequences_bif(Config) when is_list(Config) -> ?line utf16_fail_range_bif_simple(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line utf16_fail_range_bif(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line utf16_fail_range_bif(16#FFFE, 16#FFFF), %Non-characters. ?line lonely_hi_surrogate_bif(16#D800, 16#DBFF,incomplete), ?line lonely_hi_surrogate_bif(16#DC00, 16#DFFF,error), @@ -644,7 +643,6 @@ utf8_illegal_sequences_bif(Config) when is_list(Config) -> ex_utf8_illegal_sequences_bif(Config) when is_list(Config) -> ?line fail_range_bif(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line fail_range_bif(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line fail_range_bif(16#FFFE, 16#FFFF), %Reserved (BOM). %% Illegal first character. ?line [fail_bif(<<I,16#8F,16#8F,16#8F>>,unicode) || I <- lists:seq(16#80, 16#BF)], diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk index 9d4ed17774..2f0ecd3863 100644 --- a/lib/stdlib/vsn.mk +++ b/lib/stdlib/vsn.mk @@ -1 +1 @@ -STDLIB_VSN = 1.17.5 +STDLIB_VSN = 1.18 diff --git a/lib/syntax_tools/doc/Makefile b/lib/syntax_tools/doc/Makefile index 6afd16f669..d9981de880 100644 --- a/lib/syntax_tools/doc/Makefile +++ b/lib/syntax_tools/doc/Makefile @@ -78,12 +78,3 @@ release_docs_spec: docs release_spec: - - - -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- -#-include make.dep - - diff --git a/lib/syntax_tools/doc/src/make.dep b/lib/syntax_tools/doc/src/make.dep deleted file mode 100644 index acc76857bb..0000000000 --- a/lib/syntax_tools/doc/src/make.dep +++ /dev/null @@ -1,22 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex chapter.tex epp_dodger.tex erl_comment_scan.tex \ - erl_prettypr.tex erl_recomment.tex erl_syntax.tex \ - erl_syntax_lib.tex erl_tidy.tex igor.tex part.tex \ - prettypr.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 9df5f26454..7f58fda519 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -6093,11 +6093,16 @@ implicit_fun_name(Node) -> {'fun', Pos, {function, Atom, Arity}} -> arity_qualifier(set_pos(atom(Atom), Pos), set_pos(integer(Arity), Pos)); - {'fun', Pos, {function, Module, Atom, Arity}} -> + {'fun', Pos, {function, Module, Atom, Arity}} + when is_atom(Module), is_atom(Atom), is_integer(Arity) -> + %% Backward compatibility with pre-R15 abstract format. module_qualifier(set_pos(atom(Module), Pos), arity_qualifier( set_pos(atom(Atom), Pos), set_pos(integer(Arity), Pos))); + {'fun', Pos, {function, Module, Atom, Arity}} -> + %% New in R15: fun M:F/A. + module_qualifier(Module, arity_qualifier(Atom, Arity)); Node1 -> data(Node1) end. diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl index 1cfdc7234a..09efc9c392 100644 --- a/lib/syntax_tools/src/erl_tidy.erl +++ b/lib/syntax_tools/src/erl_tidy.erl @@ -103,7 +103,7 @@ dir(Dir) -> %% <dt>{regexp, string()}</dt> %% %% <dd>The value denotes a regular expression (see module -%% `regexp'). Tidying will only be applied to those +%% `re'). Tidying will only be applied to those %% regular files whose names match this pattern. The default %% value is `".*\\.erl$"', which matches normal %% Erlang source file names.</dd> @@ -124,7 +124,7 @@ dir(Dir) -> %% %% See the function {@link file/2} for further options. %% -%% @see //stdlib/regexp +%% @see //stdlib/re %% @see file/2 -record(dir, {follow_links = false :: boolean(), diff --git a/lib/test_server/doc/src/Makefile b/lib/test_server/doc/src/Makefile index c7ba415e5b..f0be284324 100644 --- a/lib/test_server/doc/src/Makefile +++ b/lib/test_server/doc/src/Makefile @@ -133,9 +133,3 @@ release_docs_spec: docs release_spec: release_tests_spec: - -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -include make.dep diff --git a/lib/test_server/doc/src/make.dep b/lib/test_server/doc/src/make.dep deleted file mode 100644 index ee9100bd08..0000000000 --- a/lib/test_server/doc/src/make.dep +++ /dev/null @@ -1,24 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: basics_chapter.tex book.tex example_chapter.tex \ - part.tex ref_man.tex run_test_chapter.tex \ - test_server_app.tex test_server_ctrl.tex \ - test_server.tex test_spec_chapter.tex \ - write_framework_chapter.tex \ - write_test_chapter.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/test_server/include/test_server.hrl b/lib/test_server/include/test_server.hrl index 4b96d84ace..36e7e1f83d 100644 --- a/lib/test_server/include/test_server.hrl +++ b/lib/test_server/include/test_server.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -20,11 +20,10 @@ -ifdef(line_trace). -line_trace(true). -define(line, - put(test_server_loc,{?MODULE,?LINE}), io:format(lists:concat([?MODULE,",",integer_to_list(?LINE),": ~p"]), [erlang:now()]),). -else. --define(line,put(test_server_loc,{?MODULE,?LINE}),). +-define(line,). -endif. -define(t,test_server). -define(config,test_server:lookup_config). diff --git a/lib/test_server/include/test_server_line.hrl b/lib/test_server/include/test_server_line.hrl index 60ef860883..3c309d3ee5 100644 --- a/lib/test_server/include/test_server_line.hrl +++ b/lib/test_server/include/test_server_line.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-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 @@ -16,5 +16,4 @@ %% %% %CopyrightEnd% %% --compile({parse_transform,test_server_line}). diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile index 63a585d526..4bc51873c2 100644 --- a/lib/test_server/src/Makefile +++ b/lib/test_server/src/Makefile @@ -43,7 +43,6 @@ MODULES= test_server_ctrl \ test_server_node \ test_server \ test_server_sup \ - test_server_line \ test_server_h \ erl2html2 \ vxworks_client diff --git a/lib/test_server/src/test_server.app.src b/lib/test_server/src/test_server.app.src index af2d4dc2cb..7e87583a7b 100644 --- a/lib/test_server/src/test_server.app.src +++ b/lib/test_server/src/test_server.app.src @@ -24,7 +24,6 @@ test_server_ctrl, test_server, test_server_h, - test_server_line, test_server_node, test_server_sup ]}, diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 244207e140..49f97686a0 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -768,7 +768,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, Comment,undefined); Loc1 -> - {Mod,Func} = get_mf(Loc1), %% call end_per_testcase on a separate process, %% only so that the user has a chance to clean up %% after init_per_testcase, even after a timetrap timeout @@ -784,6 +783,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> TVal), {EndConfPid,{Mod,Func},Conf}; _ -> + {Mod,Func} = get_mf(Loc1), %% The framework functions mustn't execute on this %% group leader process or io will cause deadlock, %% so we spawn a dedicated process for the operation @@ -821,7 +821,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, Comment,undefined); Loc1 -> - {Mod,Func} = get_mf(Loc1), %% call end_per_testcase on a separate process, only so %% that the user has a chance to clean up after init_per_testcase, %% even after abortion @@ -839,6 +838,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> TVal), {EndConfPid,{Mod,Func},Conf}; _ -> + {Mod,Func} = get_mf(Loc1), spawn_fw_call(Mod,Func,CurrConf,Pid,ErrorMsg, Loc1,self(),Comment), undefined @@ -1388,57 +1388,62 @@ init_per_testcase(Mod, Func, Args) -> false -> code:load_file(Mod); _ -> ok end, - %% init_per_testcase defined, returns new configuration - case erlang:function_exported(Mod,init_per_testcase,2) of + case erlang:function_exported(Mod, init_per_testcase, 2) of true -> - case catch my_apply(Mod, init_per_testcase, [Func|Args]) of - {'$test_server_ok',{Skip,Reason}} when Skip==skip; - Skip==skipped -> - {skip,Reason}; - {'$test_server_ok',Res={skip_and_save,_,_}} -> - Res; - {'$test_server_ok',NewConf} when is_list(NewConf) -> - case lists:filter(fun(T) when is_tuple(T) -> false; - (_) -> true end, NewConf) of - [] -> - {ok,NewConf}; - Bad -> - group_leader() ! {printout,12, - "ERROR! init_per_testcase has returned " - "bad elements in Config: ~p\n",[Bad]}, - {skip,{failed,{Mod,init_per_testcase,bad_return}}} - end; - {'$test_server_ok',Res={fail,_Reason}} -> - Res; - {'$test_server_ok',_Other} -> - group_leader() ! {printout,12, - "ERROR! init_per_testcase did not return " - "a Config list.\n",[]}, - {skip,{failed,{Mod,init_per_testcase,bad_return}}}; - {'EXIT',Reason} -> - Line = get_loc(), - FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), - group_leader() ! {printout,12, - "ERROR! init_per_testcase crashed!\n" - "\tLocation: ~s\n\tReason: ~p\n", - [FormattedLoc,Reason]}, - {skip,{failed,{Mod,init_per_testcase,Reason}}}; - Other -> - Line = get_loc(), - FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), - group_leader() ! {printout,12, - "ERROR! init_per_testcase thrown!\n" - "\tLocation: ~s\n\tReason: ~p\n", - [FormattedLoc, Other]}, - {skip,{failed,{Mod,init_per_testcase,Other}}} - end; + do_init_per_testcase(Mod, [Func|Args]); false -> -%% Optional init_per_testcase not defined -%% keep quiet. + %% Optional init_per_testcase is not defined -- keep quiet. [Config] = Args, {ok, Config} end. +do_init_per_testcase(Mod, Args) -> + try apply(Mod, init_per_testcase, Args) of + {Skip,Reason} when Skip =:= skip; Skip =:= skipped -> + {skip,Reason}; + {skip_and_save,_,_}=Res -> + Res; + NewConf when is_list(NewConf) -> + case lists:filter(fun(T) when is_tuple(T) -> false; + (_) -> true end, NewConf) of + [] -> + {ok,NewConf}; + Bad -> + group_leader() ! {printout,12, + "ERROR! init_per_testcase has returned " + "bad elements in Config: ~p\n",[Bad]}, + {skip,{failed,{Mod,init_per_testcase,bad_return}}} + end; + {fail,_Reason}=Res -> + Res; + _Other -> + group_leader() ! {printout,12, + "ERROR! init_per_testcase did not return " + "a Config list.\n",[]}, + {skip,{failed,{Mod,init_per_testcase,bad_return}}} + catch + throw:Other -> + set_loc(erlang:get_stacktrace()), + Line = get_loc(), + FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), + group_leader() ! {printout,12, + "ERROR! init_per_testcase thrown!\n" + "\tLocation: ~s\n\tReason: ~p\n", + [FormattedLoc, Other]}, + {skip,{failed,{Mod,init_per_testcase,Other}}}; + _:Reason0 -> + Stk = erlang:get_stacktrace(), + Reason = {Reason0,Stk}, + set_loc(Stk), + Line = get_loc(), + FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), + group_leader() ! {printout,12, + "ERROR! init_per_testcase crashed!\n" + "\tLocation: ~s\n\tReason: ~p\n", + [FormattedLoc,Reason]}, + {skip,{failed,{Mod,init_per_testcase,Reason}}} + end. + end_per_testcase(Mod, Func, Conf) -> case erlang:function_exported(Mod,end_per_testcase,2) of true -> @@ -1456,65 +1461,87 @@ end_per_testcase(Mod, Func, Conf) -> do_end_per_testcase(Mod,EndFunc,Func,Conf) -> put(test_server_init_or_end_conf,{EndFunc,Func}), put(test_server_loc, {Mod,{EndFunc,Func}}), - case catch my_apply(Mod, EndFunc, [Func,Conf]) of - {'$test_server_ok',SaveCfg={save_config,_}} -> + try Mod:EndFunc(Func, Conf) of + {save_config,_}=SaveCfg -> SaveCfg; - {'$test_server_ok',{fail,_}=Fail} -> + {fail,_}=Fail -> Fail; - {'$test_server_ok',_} -> - ok; - {'EXIT',Reason} = Why -> + _ -> + ok + catch + throw:Other -> Comment0 = case read_comment() of "" -> ""; Cmt -> Cmt ++ "<br>" end, + set_loc(erlang:get_stacktrace()), comment(io_lib:format("~s<font color=\"red\">" - "WARNING: ~w crashed!" + "WARNING: ~w thrown!" "</font>\n",[Comment0,EndFunc])), group_leader() ! {printout,12, - "WARNING: ~w crashed!\n" + "WARNING: ~w thrown!\n" "Reason: ~p\n" "Line: ~s\n", - [EndFunc, Reason, + [EndFunc, Other, test_server_sup:format_loc( mod_loc(get_loc()))]}, - {failed,{Mod,end_per_testcase,Why}}; - Other -> + {failed,{Mod,end_per_testcase,Other}}; + Class:Reason -> + Stk = erlang:get_stacktrace(), + set_loc(Stk), + Why = case Class of + exit -> {'EXIT',Reason}; + error -> {'EXIT',{Reason,Stk}} + end, Comment0 = case read_comment() of "" -> ""; Cmt -> Cmt ++ "<br>" end, comment(io_lib:format("~s<font color=\"red\">" - "WARNING: ~w thrown!" + "WARNING: ~w crashed!" "</font>\n",[Comment0,EndFunc])), group_leader() ! {printout,12, - "WARNING: ~w thrown!\n" + "WARNING: ~w crashed!\n" "Reason: ~p\n" "Line: ~s\n", - [EndFunc, Other, + [EndFunc, Reason, test_server_sup:format_loc( mod_loc(get_loc()))]}, - {failed,{Mod,end_per_testcase,Other}} + {failed,{Mod,end_per_testcase,Why}} end. get_loc() -> - case catch test_server_line:get_lines() of - [] -> - get(test_server_loc); - {'EXIT',_} -> - get(test_server_loc); - Loc -> - Loc - end. + get(test_server_loc). get_loc(Pid) -> - {dictionary,Dict} = process_info(Pid, dictionary), - lists:foreach(fun({Key,Val}) -> put(Key,Val) end,Dict), + [{current_stacktrace,Stk0},{dictionary,Dict}] = + process_info(Pid, [current_stacktrace,dictionary]), + lists:foreach(fun({Key,Val}) -> put(Key, Val) end, Dict), + Stk = [rewrite_loc_item(Loc) || Loc <- Stk0], + put(test_server_loc, Stk), get_loc(). -get_mf([{M,F,_}|_]) -> {M,F}; -get_mf([{M,F}|_]) -> {M,F}; -get_mf(_) -> {undefined,undefined}. +%% find the latest known Suite:Testcase +get_mf(MFs) -> + get_mf(MFs, {undefined,undefined}). + +get_mf([MF|MFs], Found) when is_tuple(MF) -> + ModFunc = {Mod,_} = case MF of + {M,F,_} -> {M,F}; + MF -> MF + end, + case is_suite(Mod) of + true -> ModFunc; + false -> get_mf(MFs, ModFunc) + end; +get_mf(_, Found) -> + Found. + +is_suite(Mod) -> + case lists:reverse(atom_to_list(Mod)) of + "ETIUS" ++ _ -> true; + _ -> false + end. mod_loc(Loc) -> %% handle diff line num versions @@ -1587,16 +1614,22 @@ lookup_config(Key,Config) -> %% timer:tc/3 ts_tc(M, F, A) -> Before = erlang:now(), - Val = (catch my_apply(M, F, A)), + Result = try + apply(M, F, A) + catch + Type:Reason -> + Stk = erlang:get_stacktrace(), + set_loc(Stk), + case Type of + throw -> + {failed,{thrown,Reason}}; + error -> + {'EXIT',{Reason,Stk}}; + exit -> + {'EXIT',Reason} + end + end, After = erlang:now(), - Result = case Val of - {'$test_server_ok', R} -> - R; % test case ok - {'EXIT',_Reason} = R -> - R; % test case crashed - Other -> - {failed, {thrown,Other}} % test case was thrown - end, Elapsed = (element(1,After)*1000000000000 +element(2,After)*1000000+element(3,After)) - @@ -1604,8 +1637,12 @@ ts_tc(M, F, A) -> +element(2,Before)*1000000+element(3,Before)), {Elapsed, Result}. -my_apply(M, F, A) -> - {'$test_server_ok',apply(M, F, A)}. +set_loc(Stk) -> + Loc = [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk], + put(test_server_loc, Loc). + +rewrite_loc_item({M,F,_,Loc}) -> + {M,F,proplists:get_value(line, Loc, 0)}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1768,7 +1805,16 @@ adjusted_sleep(MSecs) -> %% to read when using this function, rather than exit directly. fail(Reason) -> comment(cast_to_list(Reason)), - exit({suite_failed,Reason}). + try + exit({suite_failed,Reason}) + catch + Class:R -> + case erlang:get_stacktrace() of + [{?MODULE,fail,1,_}|Stk] -> ok; + Stk -> ok + end, + erlang:raise(Class, R, Stk) + end. cast_to_list(X) when is_list(X) -> X; cast_to_list(X) when is_atom(X) -> atom_to_list(X); @@ -1782,7 +1828,16 @@ cast_to_list(X) -> lists:flatten(io_lib:format("~p", [X])). %% Immediately calls exit. Included because test suites are easier %% to read when using this function, rather than exit directly. fail() -> - exit(suite_failed). + try + exit(suite_failed) + catch + Class:R -> + case erlang:get_stacktrace() of + [{?MODULE,fail,0,_}|Stk] -> ok; + Stk -> ok + end, + erlang:raise(Class, R, Stk) + end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% break(Comment) -> ok diff --git a/lib/test_server/src/test_server_line.erl b/lib/test_server/src/test_server_line.erl deleted file mode 100644 index 848a9c23dd..0000000000 --- a/lib/test_server/src/test_server_line.erl +++ /dev/null @@ -1,387 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2010. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% --module(test_server_line). - -%% User interface --export([get_lines/0]). --export([clear/0]). - -%% Parse transform functions --export([parse_transform/2]). --export(['$test_server_line'/3]). --export(['$test_server_lineQ'/3]). --export([trace_line/3]). - --define(TEST_SERVER_LINE_SIZE, 10). -%-define(STORAGE_FUNCTION, '$test_server_line'). --define(STORAGE_FUNCTION, '$test_server_lineQ'). - --include("test_server.hrl"). - --record(vars, {module, % atom() Module name - function, % atom() Function name - arity, % int() Function arity - lines, % [int()] seen lines - is_guard=false, % boolean() - no_lines=[], % [{atom(),integer()}] - % Functions to exclude - line_trace=false - }). - - - - -%% Process dictionary littering variant -%% - -'$test_server_line'(Mod, Func, Line) -> - {Prev,Next} = - case get('$test_server_line') of - I when is_integer(I) -> - if 1 =< I, I < ?TEST_SERVER_LINE_SIZE -> {I,I+1}; - true -> {?TEST_SERVER_LINE_SIZE,1} - end; - _ -> {?TEST_SERVER_LINE_SIZE,1} - end, - PrevTag = {'$test_server_line',Prev}, - case get(PrevTag) of - {Mod,Func,_} -> put(PrevTag, {Mod,Func,Line}); - _ -> - put({'$test_server_line',Next}, {Mod,Func,Line}), - put('$test_server_line', Next) - end, ok. - -test_server_line_get() -> - case get('$test_server_line') of - I when is_integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE -> - test_server_line_get_1(?TEST_SERVER_LINE_SIZE, I, []); - _ -> [] - end. - -test_server_line_get_1(0, _I, R) -> - R; -test_server_line_get_1(Cnt, I, R) -> - J = if I < ?TEST_SERVER_LINE_SIZE -> I+1; - true -> 1 end, - case get({'$test_server_line',J}) of - undefined -> - %% Less than ?TEST_SERVER_LINE_SIZE number of lines stored - %% Start from line 1 and stop at actutual number of lines - case get({'$test_server_line',1}) of - undefined -> R; % no lines at all stored - E -> test_server_line_get_1(I-1,1,[E|R]) - end; - E -> - test_server_line_get_1(Cnt-1, J, [E|R]) - end. - -test_server_line_clear() -> - Is = lists:seq(1,?TEST_SERVER_LINE_SIZE), - lists:foreach(fun (I) -> erase({'$test_server_line',I}) end, Is), - erase('$test_server_line'), - ok. - - -%% Queue variant, uses just one process dictionary entry -%% - -'$test_server_lineQ'(Mod, Func, Line) -> - case get('$test_server_lineQ') of - {I,Q} when is_integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE -> - case queue:head(Q) of - {Mod,Func,_} -> - %% Replace queue head - put('$test_server_lineQ', - {I,queue:cons({Mod,Func,Line}, queue:tail(Q))}); - _ when I < ?TEST_SERVER_LINE_SIZE -> - put('$test_server_lineQ', - {I+1,queue:cons({Mod,Func,Line}, Q)}); - _ -> - %% Waste last in queue - put('$test_server_lineQ', - {I,queue:cons({Mod,Func,Line}, queue:lait(Q))}) - end; - _ -> - Q = queue:new(), - put('$test_server_lineQ', {1,queue:cons({Mod,Func,Line}, Q)}) - end, ok. - -%test_server_lineQ_get() -> -% case get('$test_server_lineQ') of -% {I,Q} when integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE -> -% queue:to_list(Q); -% _ -> [] -% end. - -test_server_lineQ_clear() -> - erase('$test_server_lineQ'), - ok. - - -%% Get line - check if queue or dictionary is used, then get the lines -%% - -get_lines() -> - case get('$test_server_lineQ') of - {I,Q} when is_integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE -> - queue:to_list(Q); - _ -> - test_server_line_get() - end. - -%% Clear all dictionary entries -%% -clear() -> - test_server_line_clear(), - test_server_lineQ_clear(). - - -trace_line(Mod,Func,Line) -> - io:format(lists:concat([Mod,":",Func,",",integer_to_list(Line),": ~p"]), - [erlang:now()]). - - -%%%================================================================= -%%%========= **** PARSE TRANSFORM **** ======================== -%%%================================================================= -parse_transform(Forms, _Options) -> - transform(Forms, _Options). - -%% forms(Fs) -> lists:map(fun (F) -> form(F) end, Fs). - -transform(Forms, _Options)-> - Vars0 = #vars{}, - {ok, MungedForms, _Vars} = transform(Forms, [], Vars0), - MungedForms. - - -transform([Form|Forms], MungedForms, Vars) -> - case munge(Form, Vars) of - ignore -> - transform(Forms, MungedForms, Vars); - {MungedForm, Vars2} -> - transform(Forms, [MungedForm|MungedForms], Vars2) - end; -transform([], MungedForms, Vars) -> - {ok, lists:reverse(MungedForms), Vars}. - -%% This code traverses the abstract code, stored as the abstract_code -%% chunk in the BEAM file, as described in absform(3) for Erlang/OTP R8B -%% (Vsn=abstract_v2). -%% The abstract format after preprocessing differs slightly from the abstract -%% format given eg using epp:parse_form, this has been noted in comments. -munge(Form={attribute,_,module,Module}, Vars) -> - Vars2 = Vars#vars{module=Module}, - {Form, Vars2}; - -munge(Form={attribute,_,no_lines,Funcs}, Vars) -> - Vars2 = Vars#vars{no_lines=Funcs}, - {Form, Vars2}; - -munge(Form={attribute,_,line_trace,_}, Vars) -> - Vars2 = Vars#vars{line_trace=true}, - {Form, Vars2}; - -munge({function,0,module_info,_Arity,_Clauses}, _Vars) -> - ignore; % module_info will be added again when the forms are recompiled -munge(Form = {function,Line,Function,Arity,Clauses}, Vars) -> - case lists:member({Function,Arity},Vars#vars.no_lines) of - true -> - %% Line numbers in this function shall not be stored - {Form,Vars}; - false -> - Vars2 = Vars#vars{function=Function, - arity=Arity, - lines=[]}, - {MungedClauses, Vars3} = munge_clauses(Clauses, Vars2, []), - {{function,Line,Function,Arity,MungedClauses}, Vars3} - end; -munge(Form, Vars) -> % attributes - {Form, Vars}. - -munge_clauses([{clause,Line,Pattern,Guards,Body}|Clauses], Vars, MClauses) -> - {MungedGuards, _Vars} = munge_exprs(Guards, Vars#vars{is_guard=true},[]), - {MungedBody, Vars2} = munge_body(Body, Vars, []), - munge_clauses(Clauses, Vars2, - [{clause,Line,Pattern,MungedGuards,MungedBody}| - MClauses]); -munge_clauses([], Vars, MungedClauses) -> - {lists:reverse(MungedClauses), Vars}. - -munge_body([Expr|Body], Vars, MungedBody) -> - %% Here is the place to add a call to storage function! - Line = element(2, Expr), - Lines = Vars#vars.lines, - case lists:member(Line,Lines) of - true -> % already a bump at this line! - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_body(Body, Vars2, [MungedExpr|MungedBody]); - false -> - Bump = {call, 0, {remote,0, - {atom,0,?MODULE}, - {atom,0,?STORAGE_FUNCTION}}, - [{atom,0,Vars#vars.module}, - {atom, 0, Vars#vars.function}, - {integer, 0, Line}]}, - Lines2 = [Line|Lines], - - {MungedExpr, Vars2} = munge_expr(Expr, Vars#vars{lines=Lines2}), - MungedBody2 = - if Vars#vars.line_trace -> - LineTrace = {call, 0, {remote,0, - {atom,0,?MODULE}, - {atom,0,trace_line}}, - [{atom,0,Vars#vars.module}, - {atom, 0, Vars#vars.function}, - {integer, 0, Line}]}, - [MungedExpr,LineTrace,Bump|MungedBody]; - true -> - [MungedExpr,Bump|MungedBody] - end, - munge_body(Body, Vars2, MungedBody2) - end; -munge_body([], Vars, MungedBody) -> - {lists:reverse(MungedBody), Vars}. - -munge_expr({match,Line,ExprL,ExprR}, Vars) -> - {MungedExprL, Vars2} = munge_expr(ExprL, Vars), - {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), - {{match,Line,MungedExprL,MungedExprR}, Vars3}; -munge_expr({tuple,Line,Exprs}, Vars) -> - {MungedExprs, Vars2} = munge_exprs(Exprs, Vars, []), - {{tuple,Line,MungedExprs}, Vars2}; -munge_expr({record,Line,Expr,Exprs}, Vars) -> - %% Only for Vsn=raw_abstract_v1 - {MungedExprName, Vars2} = munge_expr(Expr, Vars), - {MungedExprFields, Vars3} = munge_exprs(Exprs, Vars2, []), - {{record,Line,MungedExprName,MungedExprFields}, Vars3}; -munge_expr({record_field,Line,ExprL,ExprR}, Vars) -> - %% Only for Vsn=raw_abstract_v1 - {MungedExprL, Vars2} = munge_expr(ExprL, Vars), - {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), - {{record_field,Line,MungedExprL,MungedExprR}, Vars3}; -munge_expr({cons,Line,ExprH,ExprT}, Vars) -> - {MungedExprH, Vars2} = munge_expr(ExprH, Vars), - {MungedExprT, Vars3} = munge_expr(ExprT, Vars2), - {{cons,Line,MungedExprH,MungedExprT}, Vars3}; -munge_expr({op,Line,Op,ExprL,ExprR}, Vars) -> - {MungedExprL, Vars2} = munge_expr(ExprL, Vars), - {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), - {{op,Line,Op,MungedExprL,MungedExprR}, Vars3}; -munge_expr({op,Line,Op,Expr}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {{op,Line,Op,MungedExpr}, Vars2}; -munge_expr({'catch',Line,Expr}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {{'catch',Line,MungedExpr}, Vars2}; -munge_expr({call,Line1,{remote,Line2,ExprM,ExprF},Exprs}, - Vars) when Vars#vars.is_guard==false-> - {MungedExprM, Vars2} = munge_expr(ExprM, Vars), - {MungedExprF, Vars3} = munge_expr(ExprF, Vars2), - {MungedExprs, Vars4} = munge_exprs(Exprs, Vars3, []), - {{call,Line1,{remote,Line2,MungedExprM,MungedExprF},MungedExprs}, Vars4}; -munge_expr({call,Line1,{remote,_Line2,_ExprM,ExprF},Exprs}, - Vars) when Vars#vars.is_guard==true -> - %% Difference in abstract format after preprocessing: BIF calls in guards - %% are translated to {remote,...} (which is not allowed as source form) - %% NOT NECESSARY FOR Vsn=raw_abstract_v1 - munge_expr({call,Line1,ExprF,Exprs}, Vars); -munge_expr({call,Line,Expr,Exprs}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {MungedExprs, Vars3} = munge_exprs(Exprs, Vars2, []), - {{call,Line,MungedExpr,MungedExprs}, Vars3}; -munge_expr({lc,Line,Expr,LC}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {MungedLC, Vars3} = munge_lc(LC, Vars2, []), - {{lc,Line,MungedExpr,MungedLC}, Vars3}; -munge_expr({block,Line,Body}, Vars) -> - {MungedBody, Vars2} = munge_body(Body, Vars, []), - {{block,Line,MungedBody}, Vars2}; -munge_expr({'if',Line,Clauses}, Vars) -> - {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), - {{'if',Line,MungedClauses}, Vars2}; -munge_expr({'case',Line,Expr,Clauses}, Vars) -> - {MungedExpr,Vars2} = munge_expr(Expr,Vars), - {MungedClauses,Vars3} = munge_clauses(Clauses, Vars2, []), - {{'case',Line,MungedExpr,MungedClauses}, Vars3}; -munge_expr({'receive',Line,Clauses}, Vars) -> - {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), - {{'receive',Line,MungedClauses}, Vars2}; -munge_expr({'receive',Line,Clauses,Expr,Body}, Vars) -> - {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), - {MungedExpr, Vars3} = munge_expr(Expr, Vars2), - {MungedBody, Vars4} = munge_body(Body, Vars3, []), - {{'receive',Line,MungedClauses,MungedExpr,MungedBody}, Vars4}; -munge_expr({'try',Line,Exprs,Clauses,CatchClauses,After}, Vars) -> - {MungedExprs, Vars1} = munge_exprs(Exprs, Vars, []), - {MungedClauses, Vars2} = munge_clauses(Clauses, Vars1, []), - {MungedCatchClauses, Vars3} = munge_clauses(CatchClauses, Vars2, []), - {MungedAfter, Vars4} = munge_body(After, Vars3, []), - {{'try',Line,MungedExprs,MungedClauses,MungedCatchClauses,MungedAfter}, - Vars4}; -%% Difference in abstract format after preprocessing: Funs get an extra -%% element Extra. -%% NOT NECESSARY FOR Vsn=raw_abstract_v1 -munge_expr({'fun',Line,{function,Name,Arity},_Extra}, Vars) -> - {{'fun',Line,{function,Name,Arity}}, Vars}; -munge_expr({'fun',Line,{clauses,Clauses},_Extra}, Vars) -> - {MungedClauses,Vars2}=munge_clauses(Clauses, Vars, []), - {{'fun',Line,{clauses,MungedClauses}}, Vars2}; -munge_expr({'fun',Line,{clauses,Clauses}}, Vars) -> - %% Only for Vsn=raw_abstract_v1 - {MungedClauses,Vars2}=munge_clauses(Clauses, Vars, []), - {{'fun',Line,{clauses,MungedClauses}}, Vars2}; -munge_expr({bc,Line,Expr,LC}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {MungedLC, Vars3} = munge_lc(LC, Vars2, []), - {{bc,Line,MungedExpr,MungedLC}, Vars3}; -munge_expr(Form, Vars) -> % var|char|integer|float|string|atom|nil|bin|eof - {Form, Vars}. - -munge_exprs([Expr|Exprs], Vars, MungedExprs) when Vars#vars.is_guard==true, - is_list(Expr) -> - {MungedExpr, _Vars} = munge_exprs(Expr, Vars, []), - munge_exprs(Exprs, Vars, [MungedExpr|MungedExprs]); -munge_exprs([Expr|Exprs], Vars, MungedExprs) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_exprs(Exprs, Vars2, [MungedExpr|MungedExprs]); -munge_exprs([], Vars, MungedExprs) -> - {lists:reverse(MungedExprs), Vars}. - -munge_lc([{generate,Line,Pattern,Expr}|LC], Vars, MungedLC) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_lc(LC, Vars2, [{generate,Line,Pattern,MungedExpr}|MungedLC]); -munge_lc([{b_generate,Line,Pattern,Expr}|LC], Vars, MungedLC) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_lc(LC, Vars2, [{b_generate,Line,Pattern,MungedExpr}|MungedLC]); -munge_lc([Expr|LC], Vars, MungedLC) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_lc(LC, Vars2, [MungedExpr|MungedLC]); -munge_lc([], Vars, MungedLC) -> - {lists:reverse(MungedLC), Vars}. - - - - - - - - - - diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 77d364d5cb..875f45eea6 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -51,18 +51,19 @@ timetrap(Timeout0, Scale, Pid) -> Timeout = if not Scale -> Timeout0; true -> test_server:timetrap_scale_factor() * Timeout0 end, + TruncTO = trunc(Timeout), receive - after trunc(Timeout) -> - Line = test_server:get_loc(Pid), + after TruncTO -> + MFLs = test_server:get_loc(Pid), Mon = erlang:monitor(process, Pid), Trap = case get(test_server_init_or_end_conf) of undefined -> - {timetrap_timeout,trunc(Timeout),Line}; + {timetrap_timeout,TruncTO,MFLs}; InitOrEnd -> - {timetrap_timeout,trunc(Timeout),Line,InitOrEnd} + {timetrap_timeout,TruncTO,MFLs,InitOrEnd} end, - exit(Pid,Trap), + exit(Pid, Trap), receive {'DOWN', Mon, process, Pid, _} -> ok diff --git a/lib/toolbar/doc/src/make.dep b/lib/toolbar/doc/src/make.dep deleted file mode 100644 index d93ff2a315..0000000000 --- a/lib/toolbar/doc/src/make.dep +++ /dev/null @@ -1,26 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex ref_man.tex toolbar.tex \ - toolbar_chapter.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: bar.ps create_tool.ps - diff --git a/lib/tools/c_src/Makefile.in b/lib/tools/c_src/Makefile.in index 65a7f5f424..6921193154 100644 --- a/lib/tools/c_src/Makefile.in +++ b/lib/tools/c_src/Makefile.in @@ -142,7 +142,9 @@ EMEM_OBJS = $(addprefix $(EMEM_OBJ_DIR)/,$(notdir $(EMEM_SRCS:.c=.o))) # Misc targets # -all: $(CREATE_DIRS) erts_lib $(PROGS) $(DRIVERS) +_create_dirs := $(shell mkdir -p $(CREATE_DIRS)) + +all: erts_lib $(PROGS) $(DRIVERS) erts_lib: cd $(ERL_TOP)/erts/lib_src && $(MAKE) $(TYPE) @@ -158,13 +160,6 @@ clean: .PHONY: all erts_lib docs clean # -# Make dir targets -# - -$(CREATE_DIRS): - $(MKDIR) -p $@ - -# # Object targets # diff --git a/lib/tools/doc/src/eprof.xml b/lib/tools/doc/src/eprof.xml index 6d68c90768..1dbc41ec8e 100644 --- a/lib/tools/doc/src/eprof.xml +++ b/lib/tools/doc/src/eprof.xml @@ -147,7 +147,7 @@ </type> <desc> <p>This function ensures that the results displayed by - <c>analyse/0</c> and <c>total_analyse/0</c> are printed both to + <c>analyze/0,1,2</c> are printed both to the file <c>File</c> and the screen.</p> </desc> </func> diff --git a/lib/tools/doc/src/make.dep b/lib/tools/doc/src/make.dep deleted file mode 100644 index 11fa090d6f..0000000000 --- a/lib/tools/doc/src/make.dep +++ /dev/null @@ -1,33 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex cover.tex cover_chapter.tex cprof.tex \ - cprof_chapter.tex eprof.tex erlang_mode.tex \ - erlang_mode_chapter.tex fprof.tex fprof_chapter.tex \ - instrument.tex make.tex part.tex ref_man.tex \ - tags.tex xref.tex xref_chapter.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -cprof.tex: ../../../../system/doc/definitions/term.defs - -xref.tex: ../../../../system/doc/definitions/term.defs - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: venn1.ps venn2.ps - diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index fb9744d759..e21bd1b88c 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -522,7 +522,7 @@ call(Request) -> {?SERVER,Reply} -> Reply end, - erlang:demonitor(Ref), + erlang:demonitor(Ref, [flush]), Return end. @@ -545,7 +545,7 @@ remote_call(Node,Request) -> {?SERVER,Reply} -> Reply end, - erlang:demonitor(Ref), + erlang:demonitor(Ref, [flush]), Return end. diff --git a/lib/tools/src/xref_reader.erl b/lib/tools/src/xref_reader.erl index d22f0df164..92f0c45c7b 100644 --- a/lib/tools/src/xref_reader.erl +++ b/lib/tools/src/xref_reader.erl @@ -158,15 +158,20 @@ expr({'try',_Line,Es,Scs,Ccs,As}, S) -> S2 = clauses(Scs, S1), S3 = clauses(Ccs, S2), expr(As, S3); -expr({call, Line, - {remote, _, {atom,_,erlang}, {atom,_,make_fun}}, - [{atom,_,Mod}, {atom,_,Fun}, {integer,_,Arity}]}, S) -> - %% Added in R10B-6. M:F/A. - expr({'fun', Line, {function, Mod, Fun, Arity}}, S); -expr({'fun', Line, {function, Mod, Name, Arity}}, S) -> - %% Added in R10B-6. M:F/A. +expr({'fun', Line, {function, {atom,_,Mod}, + {atom,_,Name}, + {integer,_,Arity}}}, S) -> + %% New format in R15. M:F/A (literals). As = lists:duplicate(Arity, {atom, Line, foo}), external_call(Mod, Name, As, Line, false, S); +expr({'fun', Line, {function, Mod, Name, {integer,_,Arity}}}, S) -> + %% New format in R15. M:F/A (one or more variables). + As = lists:duplicate(Arity, {atom, Line, foo}), + external_call(erlang, apply, [Mod, Name, list2term(As)], Line, true, S); +expr({'fun', Line, {function, Mod, Name, _Arity}}, S) -> + %% New format in R15. M:F/A (one or more variables). + As = {var, Line, '_'}, + external_call(erlang, apply, [Mod, Name, As], Line, true, S); expr({'fun', Line, {function, Name, Arity}, _Extra}, S) -> %% Added in R8. handle_call(local, S#xrefr.module, Name, Arity, Line, S); @@ -286,10 +291,10 @@ check_funarg(W, ArgsList, Line, S) -> expr(ArgsList, S1). funarg({'fun', _, _Clauses, _Extra}, _S) -> true; -funarg({var, _, Var}, S) -> member(Var, S#xrefr.funvars); -funarg({call,_,{remote,_,{atom,_,erlang},{atom,_,make_fun}},_MFA}, _S) -> - %% R10B-6. M:F/A. +funarg({'fun', _, {function,_,_,_}}, _S) -> + %% New abstract format for fun M:F/A in R15. true; +funarg({var, _, Var}, S) -> member(Var, S#xrefr.funvars); funarg(_, _S) -> false. fun_args(apply2, [FunArg, Args]) -> {FunArg, Args}; diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index fe7f92de78..881a3c2997 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -583,21 +583,14 @@ otp_6115_1(Config) -> %% called -- running cover compiled code when there is no cover %% server and thus no ets tables to bump counters in, makes no %% sense. - ?line Pid1 = f1:start_fail(), - - %% If f1 is cover compiled, a process P is started with a - %% reference to the fun created in start_ok/0, and - %% cover:stop() is called, then P should survive. - %% This is because (the fun held by) P always references the current - %% version of the module, and is thus not affected by the cover - %% compiled version being unloaded. - ?line Pid2 = f1:start_ok(), + Pid1 = f1:start_a(), + Pid2 = f1:start_b(), %% Now stop cover ?line cover:stop(), - %% Ensure that f1 is loaded (and not cover compiled), that Pid1 - %% is dead and Pid2 is alive, but with no reference to old code + %% Ensure that f1 is loaded (and not cover compiled), and that + %% both Pid1 and Pid2 are dead. case code:which(f1) of Beam when is_list(Beam) -> ok; @@ -608,19 +601,15 @@ otp_6115_1(Config) -> undefined -> ok; _PI1 -> - RefToOldP = erlang:check_process_code(Pid1, f1), - ?line ?t:fail({"Pid1 still alive", RefToOldP}) + RefToOldP1 = erlang:check_process_code(Pid1, f1), + ?t:fail({"Pid1 still alive", RefToOldP1}) end, case process_info(Pid2) of - PI2 when is_list(PI2) -> - case erlang:check_process_code(Pid2, f2) of - false -> - ok; - true -> - ?line ?t:fail("Pid2 has ref to old code") - end; undefined -> - ?line ?t:fail("Pid2 has died") + ok; + _PI2 -> + RefToOldP2 = erlang:check_process_code(Pid1, f2), + ?t:fail({"Pid2 still alive", RefToOldP2}) end, ?line file:set_cwd(CWD), diff --git a/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl b/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl index b659e5d818..5399b33f19 100644 --- a/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl +++ b/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl @@ -1,12 +1,13 @@ -module(f1). --export([start_fail/0, start_ok/0]). +-export([start_a/0, start_b/0]). -start_fail() -> +start_a() -> f2:start(fun() -> - io:format("this does not work\n",[]) + ok end). -start_ok() -> +start_b() -> f2:start(fun fun1/0). + fun1() -> - io:format("this works\n",[]). + ok. diff --git a/lib/tools/test/eprof_SUITE_data/ed.script b/lib/tools/test/eprof_SUITE_data/ed.script index 94531a9e98..fe1625bc50 100644 --- a/lib/tools/test/eprof_SUITE_data/ed.script +++ b/lib/tools/test/eprof_SUITE_data/ed.script @@ -1,5 +1,7 @@ H r eed.erl +1,$s/Created :/Skapad :/p +/^cmd_line/,/^file/-1p g/^[a-z][a-zA-Z_]*\(/i\ %%% -------------------------------------------------------------\ %%% A stupid function header.\ diff --git a/lib/tools/test/eprof_SUITE_data/eed.erl b/lib/tools/test/eprof_SUITE_data/eed.erl index 0175abdd0e..520c5f3dd1 100644 --- a/lib/tools/test/eprof_SUITE_data/eed.erl +++ b/lib/tools/test/eprof_SUITE_data/eed.erl @@ -10,6 +10,8 @@ -export([edit/0, edit/1, file/1, cmd_line/1]). +-compile({no_auto_import,[error/1]}). + -record(state, {dot = 0, % Line number of dot. upto_dot = [], % Lines up to dot (reversed). after_dot = [], % Lines after dot. @@ -60,7 +62,7 @@ loop(St0) -> ok; {error, Reason} -> loop(print_error(Reason, St1)); - St2 when record(St2, state) -> + St2 when is_record(St2, state) -> loop(St2) end. @@ -68,7 +70,7 @@ command(Cmd, St) -> case parse_command(Cmd, St) of quit -> quit; - St1 when function(St1#state.print) -> + St1 when is_function(St1#state.print) -> if St1#state.dot /= 0 -> print_current(St1); @@ -76,7 +78,7 @@ command(Cmd, St) -> ok end, St1#state{print=false}; - St1 when record(St1, state) -> + St1 when is_record(St1, state) -> St1 end. @@ -103,13 +105,13 @@ get_input([C|Rest], St, Result) -> get_line1(Io, Prompt, Result) -> get_line2(Io, io:get_line(Io, Prompt), Result). -get_line2(Io, eof, []) -> +get_line2(_Io, eof, []) -> eof; -get_line2(Io, eof, Result) -> +get_line2(_Io, eof, Result) -> lists:reverse(Result); get_line2(Io, [$\\, $\n], Result) -> get_line1(Io, '', [$\n|Result]); -get_line2(Io, [$\n], Result) -> +get_line2(_Io, [$\n], Result) -> lists:reverse(Result, [$\n]); get_line2(Io, [C|Rest], Result) -> get_line2(Io, Rest, [C|Result]). @@ -193,7 +195,7 @@ get_one1([$+|Rest], Sum, St) -> get_one2({ok, 1, Rest}, 1, Sum, St); get_one1([$-|Rest], Sum, St) -> get_one2({ok, 1, Rest}, -1, Sum, St); -get_one1(Cmd, false, St) -> +get_one1(_Cmd, false, _St) -> false; get_one1(Cmd, Sum, St) -> {ok, Sum, Cmd, St}. @@ -222,13 +224,13 @@ get_address([$', Mark|Rest], St) when $a =< Mark, Mark =< $z -> false -> {ok, 0, Rest, St} end; -get_address([$'|Rest], State) -> +get_address([$'|_Rest], _State) -> error(bad_mark); get_address([$/|Rest], State) -> scan_forward($/, Rest, State); -get_address([$?|Rest], State) -> +get_address([$?|_Rest], _State) -> error(not_implemented); -get_address(Cmd, St) -> +get_address(_Cmd, _St) -> false. scan_forward(End, Patt0, State) -> @@ -238,8 +240,8 @@ scan_forward(End, Patt0, State) -> scan_forward1(Dot+1, After, NewState, Rest). scan_forward1(Linenum, [Line|Rest], State, RestCmd) -> - case regexp:first_match(Line#line.contents, State#state.pattern) of - {match, _, _} -> + case re:run(Line#line.contents, State#state.pattern, [{capture, none}]) of + match -> {ok, Linenum, RestCmd, State}; nomatch -> scan_forward1(Linenum+1, Rest, State, RestCmd) @@ -254,13 +256,14 @@ scan_forward1(_, [], State, RestCmd) -> Other end. -scan_forward2(0, [], State, RestCmd) -> +scan_forward2(0, [], _State, _RestCmd) -> false; scan_forward2(Linenum, [Line|Rest], State, RestCmd) -> case scan_forward2(Linenum-1, Rest, State, RestCmd) of false -> - case regexp:first_match(Line#line.contents, State#state.pattern) of - {match, _, _} -> + case re:run(Line#line.contents, State#state.pattern, + [{capture, none}]) of + match -> {ok, Linenum, RestCmd, State}; nomatch -> false @@ -296,7 +299,7 @@ parse_cmd_char($t, Cont) -> Cont(fun transpose_command/3, 2, dot); parse_cmd_char($u, Cont) -> Cont(fun undo_command/3, 0, none); parse_cmd_char($v, Cont) -> Cont(fun vglobal_command/3, 2, all); parse_cmd_char($w, Cont) -> Cont(fun write_command/3, 2, all); -parse_cmd_char(_, Cont) -> error(bad_command). +parse_cmd_char(_, _Cont) -> error(bad_command). execute_command(Fun, NumLines, Def, State, Nums, Rest) -> Lines = check_lines(NumLines, Def, Nums, State), @@ -380,7 +383,7 @@ change_command(Rest, Lines, St0) -> %% (.,.)d - delete lines -delete_command(Rest, [0, Last], St) -> +delete_command(_Rest, [0, _Last], _St) -> error(bad_linenum); delete_command(Rest, [First, Last], St0) -> St1 = check_trailing_p(Rest, save_for_undo(St0)), @@ -396,7 +399,7 @@ delete(Left, St0) -> %% e file - replace buffer with new file -enter_command(Name, [], St) when St#state.modified == true -> +enter_command(_Name, [], St) when St#state.modified == true -> error(buffer_modified); enter_command(Name, [], St0) -> enter_always_command(Name, [], St0). @@ -439,7 +442,7 @@ mark(Sense, [First, Last], St0) -> St1 = move_to(Last, St0), mark1(Sense, First-1, St1). -mark1(Sense, First, St) when St#state.dot == First -> +mark1(_Sense, First, St) when St#state.dot == First -> St; mark1(Sense, First, St) -> [Line|Prev] = St#state.upto_dot, @@ -507,16 +510,16 @@ help_always_command([], [], St) -> %% (.)i - insert text -insert_command(Rest, [0], State) -> +insert_command(_Rest, [0], _State) -> error(bad_linenum); insert_command(Rest, [Line], State) -> append_command(Rest, [Line-1], State). %% (.)kx - mark line -mark_command(_, [0], St) -> +mark_command(_, [0], _St) -> error(bad_linenum); -mark_command([Mark|Rest], [Line], St) when $a =< Mark, Mark =< $z -> +mark_command([Mark|_Rest], [_Line], _St) when $a =< Mark, Mark =< $z -> error(not_implemented); mark_command(_, _, _) -> error(bad_mark). @@ -528,12 +531,12 @@ list_command(Rest, Lines, St) -> %% (.,.)m - move lines -move_command(Cmd, [First, Last], St) -> +move_command(_Cmd, [_First, _Last], _St) -> error(not_implemented). %% (.,.)t - copy lines -transpose_command(Cmd, [First, Last], St) -> +transpose_command(_Cmd, [_First, _Last], _St) -> error(not_implemented). %% (.,.)n - print lines with line numbers @@ -604,39 +607,41 @@ read(After, Name, St0) -> subst_command(_, [0, _], _) -> error(bad_linenum); -subst_command([$ |Cmd0], [First, Last], St0) -> +subst_command([$ |_Cmd0], [_First, _Last], _St0) -> error(bad_delimiter); -subst_command([$\n|Cmd0], [First, Last], St0) -> +subst_command([$\n|_Cmd0], [_First, _Last], _St0) -> error(bad_delimiter); subst_command([Sep|Cmd0], [First, Last], St0) -> St1 = save_for_undo(St0), {ok, Cmd1, St2} = get_pattern(Sep, Cmd0, St1), {ok, Replacement, Cmd2} = get_replacement(Sep, Cmd1), - {ok, Sub, Cmd3} = subst_check_gflag(Cmd2), + {ok, Opts, Cmd3} = subst_check_gflag(Cmd2), St3 = check_trailing_p(Cmd3, St2), - subst_command(Last-First+1, Sub, Replacement, move_to(First-1, St3), nomatch); + subst_command(Last-First+1, Opts, Replacement, + move_to(First-1, St3), nomatch); subst_command([], _, _) -> error(bad_delimiter). subst_command(0, _, _, _, nomatch) -> error(nomatch); -subst_command(0, _, _, _, StLast) when record(StLast, state) -> +subst_command(0, _, _, _, StLast) when is_record(StLast, state) -> StLast; -subst_command(Left, Sub, Repl, St0, LastMatch) -> +subst_command(Left, Opts, Repl, St0, LastMatch) -> St1 = next_line(St0), [Line|_] = St1#state.upto_dot, - case regexp:Sub(Line#line.contents, St1#state.pattern, Repl) of - {ok, _, 0} -> - subst_command(Left-1, Sub, Repl, St1, LastMatch); - {ok, NewContents, _} -> + Contents = Line#line.contents, + case re:replace(Contents, St1#state.pattern, Repl, Opts) of + Contents -> + subst_command(Left-1, Opts, Repl, St1, LastMatch); + NewContents -> %% XXX This doesn't work with marks. St2 = delete_current_line(St1), St3 = insert_line(NewContents, St2), - subst_command(Left-1, Sub, Repl, St3, St3) + subst_command(Left-1, Opts, Repl, St3, St3) end. -subst_check_gflag([$g|Cmd]) -> {ok, gsub, Cmd}; -subst_check_gflag(Cmd) -> {ok, sub, Cmd}. +subst_check_gflag([$g|Cmd]) -> {ok, [global,{return,list}], Cmd}; +subst_check_gflag(Cmd) -> {ok, [{return,list}], Cmd}. %% u - undo @@ -649,7 +654,7 @@ undo_command(_, _, _) -> %% (1,$)w - write buffer to file -write_command(Cmd, [First, Last], St) -> +write_command(_Cmd, [_First, _Last], _St) -> error(not_implemented). @@ -721,7 +726,7 @@ get_pattern(End, Cmd, State) -> get_pattern(End, [End|Rest], State, []) when State#state.pattern /= undefined -> {ok, Rest, State}; get_pattern(End, [End|Rest], State, Result) -> - case regexp:parse(lists:reverse(Result)) of + case re:compile(lists:reverse(Result)) of {error, _} -> error(bad_pattern); {ok, Re} -> @@ -754,7 +759,7 @@ check_trailing_p([$p], St) -> St#state{print=fun(Line, _) -> io:put_chars(Line) end}; check_trailing_p([], State) -> State; -check_trailing_p(Other, State) -> +check_trailing_p(_Other, _State) -> error(garbage_after_command). error(Reason) -> @@ -765,9 +770,9 @@ match(State) when State#state.dot == 0 -> match(State) -> [Line|_] = State#state.upto_dot, Re = State#state.pattern, - case regexp:first_match(Line#line.contents, Re) of - {match, _, _} -> true; - nomatch -> false + case re:run(Line#line.contents, Re, [{capture, none}]) of + match -> true; + nomatch -> false end. skip_blanks([$ |Rest]) -> diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl index 2f83ab4995..e0876381ca 100644 --- a/lib/tools/test/xref_SUITE.erl +++ b/lib/tools/test/xref_SUITE.erl @@ -46,7 +46,8 @@ -export([ add/1, default/1, info/1, lib/1, read/1, read2/1, remove/1, replace/1, update/1, deprecated/1, trycatch/1, - abstract_modules/1, fun_mfa/1, qlc/1]). + abstract_modules/1, fun_mfa/1, fun_mfa_r14/1, + fun_mfa_vars/1, qlc/1]). -export([ analyze/1, basic/1, md/1, q/1, variables/1, unused_locals/1]). @@ -82,7 +83,7 @@ groups() -> {files, [], [add, default, info, lib, read, read2, remove, replace, update, deprecated, trycatch, abstract_modules, fun_mfa, - qlc]}, + fun_mfa_r14, fun_mfa_vars, qlc]}, {analyses, [], [analyze, basic, md, q, variables, unused_locals]}, {misc, [], [format_error, otp_7423, otp_7831]}]. @@ -1771,6 +1772,88 @@ fun_mfa(Conf) when is_list(Conf) -> ?line ok = file:delete(Beam), ok. +%% Same as the previous test case, except that we use a BEAM file +%% that was compiled by an R14 compiler to test backward compatibility. +fun_mfa_r14(Conf) when is_list(Conf) -> + Dir = ?config(data_dir, Conf), + MFile = fname(Dir, "fun_mfa_r14"), + + A = fun_mfa_r14, + {ok, _} = xref:start(s), + {ok, A} = xref:add_module(s, MFile, {warnings,false}), + {ok, [{{{A,t,0},{'$M_EXPR','$F_EXPR',0}},[7]}, + {{{A,t,0},{A,t,0}},[6]}, + {{{A,t1,0},{'$M_EXPR','$F_EXPR',0}},[11]}, + {{{A,t1,0},{A,t,0}},[10]}, + {{{A,t2,0},{A,t,0}},[14]}, + {{{A,t3,0},{A,t3,0}},[17]}]} = + xref:q(s, "(Lin) E"), + + ok = check_state(s), + xref:stop(s), + + ok. + +%% fun M:F/A with varibles. +fun_mfa_vars(Conf) when is_list(Conf) -> + Dir = ?copydir, + File = fname(Dir, "fun_mfa_vars.erl"), + MFile = fname(Dir, "fun_mfa_vars"), + Beam = fname(Dir, "fun_mfa_vars.beam"), + Test = <<"-module(fun_mfa_vars). + + -export([t/1, t1/1, t2/3]). + + t(Mod) -> + F = fun Mod:bar/2, + (F)(a, b). + + t1(Name) -> + F = fun ?MODULE:Name/1, + (F)(a). + + t2(Mod, Name, Arity) -> + F = fun Mod:Name/Arity, + (F)(a). + + t3(Arity) -> + F = fun ?MODULE:t/Arity, + (F)(1, 2, 3). + + t4(Mod, Name) -> + F = fun Mod:Name/3, + (F)(a, b, c). + + t5(Mod, Arity) -> + F = fun Mod:t/Arity, + (F)(). + ">>, + + ok = file:write_file(File, Test), + A = fun_mfa_vars, + {ok, A} = compile:file(File, [report,debug_info,{outdir,Dir}]), + {ok, _} = xref:start(s), + {ok, A} = xref:add_module(s, MFile, {warnings,false}), + {ok, [{{{A,t,1},{'$M_EXPR','$F_EXPR',2}},[7]}, + {{{A,t,1},{'$M_EXPR',bar,2}},[6]}, + {{{A,t1,1},{'$M_EXPR','$F_EXPR',1}},[11]}, + {{{A,t1,1},{A,'$F_EXPR',1}},[10]}, + {{{A,t2,3},{'$M_EXPR','$F_EXPR',-1}},[14]}, + {{{A,t2,3},{'$M_EXPR','$F_EXPR',1}},[15]}, + {{{A,t3,1},{'$M_EXPR','$F_EXPR',3}},[19]}, + {{{A,t3,1},{fun_mfa_vars,t,-1}},[18]}, + {{{A,t4,2},{'$M_EXPR','$F_EXPR',3}},[22,23]}, + {{{A,t5,2},{'$M_EXPR','$F_EXPR',0}},[27]}, + {{{A,t5,2},{'$M_EXPR',t,-1}},[26]}]} = + xref:q(s, "(Lin) E"), + + ok = check_state(s), + xref:stop(s), + + ok = file:delete(File), + ok = file:delete(Beam), + ok. + qlc(suite) -> []; qlc(doc) -> ["OTP-5195: A bug fix when using qlc:q/1,2."]; qlc(Conf) when is_list(Conf) -> diff --git a/lib/tools/test/xref_SUITE_data/fun_mfa_r14.beam b/lib/tools/test/xref_SUITE_data/fun_mfa_r14.beam Binary files differnew file mode 100644 index 0000000000..4645525690 --- /dev/null +++ b/lib/tools/test/xref_SUITE_data/fun_mfa_r14.beam diff --git a/lib/tools/test/xref_SUITE_data/fun_mfa_r14.erl b/lib/tools/test/xref_SUITE_data/fun_mfa_r14.erl new file mode 100644 index 0000000000..293bd83a8b --- /dev/null +++ b/lib/tools/test/xref_SUITE_data/fun_mfa_r14.erl @@ -0,0 +1,18 @@ +-module(fun_mfa_r14). + +-export([t/0, t1/0, t2/0, t3/0]). + +t() -> + F = fun ?MODULE:t/0, + (F)(). + +t1() -> + F = fun t/0, + (F)(). + +t2() -> + fun ?MODULE:t/0(). + +t3() -> + fun t3/0(). + diff --git a/lib/tv/doc/src/Makefile b/lib/tv/doc/src/Makefile index f30e0307a9..5a41b28d48 100644 --- a/lib/tv/doc/src/Makefile +++ b/lib/tv/doc/src/Makefile @@ -26,14 +26,6 @@ VSN=$(TV_VSN) APPLICATION=tv # ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - -# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) @@ -89,32 +81,10 @@ EXTRA_FILES = \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = tv-$(VSN).pdf -TOP_PS_FILE = tv-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -127,8 +97,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -144,31 +112,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) gifs - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ $(LATEX_CLEAN) -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -181,8 +124,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -193,29 +134,5 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -endif -endif - -endif - release_spec: diff --git a/lib/tv/doc/src/make.dep b/lib/tv/doc/src/make.dep deleted file mode 100644 index 8437e320c6..0000000000 --- a/lib/tv/doc/src/make.dep +++ /dev/null @@ -1,32 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex ref_man.tex table_visualizer_chapter.tex \ - tv.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: info_window.ps set_poll_int.ps tv_create_table.ps \ - tv_record_editor_mnesia.ps tv_row_marked.ps \ - tv_row_marked_popup.ps tv_search_result.ps \ - tv_search_window.ps tv_start.ps tv_start_mnesia.ps \ - tv_start_other_node.ps tv_start_pid_sorted.ps \ - tv_start_system.ps tv_start_system_unreadable.ps \ - tv_table_browser.ps tv_table_browser_updated.ps - diff --git a/lib/tv/src/tv_db_search.erl b/lib/tv/src/tv_db_search.erl index edd3c188e2..7634bc63b6 100644 --- a/lib/tv/src/tv_db_search.erl +++ b/lib/tv/src/tv_db_search.erl @@ -244,10 +244,10 @@ get_entry_text() -> string_to_regexp(Str) -> - case regexp:parse(Str) of + case re:compile(Str) of {ok, RegExp} -> {ok, RegExp}; - _Error -> + {error, _Error} -> case get(error_msg_mode) of normal -> {error, {not_a_regexp, "Please enter a regular expression!"}}; @@ -410,33 +410,11 @@ search_for_regexp(Pattern, Elem, ListAsStr) -> lists:flatten(tv_io_lib:write(Elem)) end, - case regexp:first_match(ListToSearch, Pattern) of - {match, _, _} -> + case re:run(ListToSearch, Pattern, [{capture,none}]) of + match -> found; - _Other -> + nomatch -> not_found - %% The code below shall be used instead if it is desired to - %% compare each *element* in the tuples to the regular expression, - %% i.e., treat each element as a new line/string. - %% The difference is most easily explained through an example: - %% If we treat each tuple as a new line/string, the regular expression - %% "^{win" will match the string "{win, 1, 2, 3}", but not the string - %% "{1, {win,2}}". - %% If we treat each element as a new line/string, the RE "^{win" will match - %% both strings above. - - %% SearchList = tuple_to_list(Elem), - %% case lists:dropwhile( - %% fun(H) -> - %% nomatch == regexp:first_match(lists:flatten(io_lib:write(H)), - %% Pattern) - %% end, - %% SearchList) of - %% [] -> - %% not_found; - %% _AnyList -> - %% found - %% end end. diff --git a/lib/tv/src/tv_main.erl b/lib/tv/src/tv_main.erl index 2f743c2397..283ba4c967 100644 --- a/lib/tv/src/tv_main.erl +++ b/lib/tv/src/tv_main.erl @@ -312,7 +312,7 @@ analyze_error(Cause, Node, Table) -> handle_error(mnesia_not_started, Node, Table); {badrpc, {'EXIT', {aborted, {node_not_running,_ErrNode}}}} -> handle_error(mnesia_not_started, Node, Table); - {'EXIT', {undef, {mnesia,_Fcn,_Args}}} -> + {'EXIT', {undef, {mnesia,_Fcn,_Args,_}}} -> handle_error(mnesia_not_started, Node, Table); {'EXIT', Reason} -> diff --git a/lib/tv/src/tv_mnesia_rpc.erl b/lib/tv/src/tv_mnesia_rpc.erl index a2385714ec..4a75994145 100644 --- a/lib/tv/src/tv_mnesia_rpc.erl +++ b/lib/tv/src/tv_mnesia_rpc.erl @@ -87,6 +87,8 @@ chk(Result) -> throw(mnesia_not_started); {badrpc, _Reason} -> throw(mnesia_not_started); + {'EXIT', {undef, {mnesia,_Fcn,_Args,_}}} -> + throw(mnesia_not_started); {'EXIT', {undef, {mnesia,_Fcn,_Args}}} -> throw(mnesia_not_started); diff --git a/lib/webtool/doc/src/make.dep b/lib/webtool/doc/src/make.dep deleted file mode 100644 index 87526b3f73..0000000000 --- a/lib/webtool/doc/src/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex ref_man.tex start_webtool.tex \ - webtool.tex webtool_chapter.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/wx/doc/src/make.dep b/lib/wx/doc/src/make.dep deleted file mode 100644 index 91001be438..0000000000 --- a/lib/wx/doc/src/make.dep +++ /dev/null @@ -1,13 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex chapter.tex part.tex - diff --git a/lib/wx/examples/demo/Makefile b/lib/wx/examples/demo/Makefile index 98d7c6a130..8afa0e780e 100755..100644 --- a/lib/wx/examples/demo/Makefile +++ b/lib/wx/examples/demo/Makefile @@ -80,7 +80,7 @@ include $(ERL_TOP)/make/otp_release_targets.mk docs: -release_spec: +release_spec: opt $(INSTALL_DIR) $(EXRELSYSDIR) $(INSTALL_DATA) $(TESTSRC) $(EXRELSYSDIR) $(INSTALL_DATA) $(TESTTARGETS) $(EXRELSYSDIR) diff --git a/lib/wx/examples/simple/Makefile b/lib/wx/examples/simple/Makefile index 41f0b46eb1..66f5952f0d 100644 --- a/lib/wx/examples/simple/Makefile +++ b/lib/wx/examples/simple/Makefile @@ -51,7 +51,7 @@ include $(ERL_TOP)/make/otp_release_targets.mk docs: -release_spec: +release_spec: opt $(INSTALL_DIR) $(EXRELSYSDIR) $(INSTALL_DATA) $(TESTSRC) $(EXRELSYSDIR) $(INSTALL_DATA) copy.xpm sample.xpm $(TESTTARGETS) $(EXRELSYSDIR) diff --git a/lib/wx/examples/simple/hello.erl b/lib/wx/examples/simple/hello.erl index dc845ddfbb..dc845ddfbb 100755..100644 --- a/lib/wx/examples/simple/hello.erl +++ b/lib/wx/examples/simple/hello.erl diff --git a/lib/wx/examples/simple/menu.erl b/lib/wx/examples/simple/menu.erl index d573fcf13a..d573fcf13a 100755..100644 --- a/lib/wx/examples/simple/menu.erl +++ b/lib/wx/examples/simple/menu.erl diff --git a/lib/wx/examples/simple/minimal.erl b/lib/wx/examples/simple/minimal.erl index dca4adc643..dca4adc643 100755..100644 --- a/lib/wx/examples/simple/minimal.erl +++ b/lib/wx/examples/simple/minimal.erl diff --git a/lib/wx/examples/simple/sample.xpm b/lib/wx/examples/simple/sample.xpm index 3263b15f8a..3263b15f8a 100755..100644 --- a/lib/wx/examples/simple/sample.xpm +++ b/lib/wx/examples/simple/sample.xpm diff --git a/lib/wx/examples/sudoku/Makefile b/lib/wx/examples/sudoku/Makefile index b86c654fdd..33725756b7 100755..100644 --- a/lib/wx/examples/sudoku/Makefile +++ b/lib/wx/examples/sudoku/Makefile @@ -51,7 +51,7 @@ include $(ERL_TOP)/make/otp_release_targets.mk docs: -release_spec: +release_spec: opt $(INSTALL_DIR) $(EXRELSYSDIR) $(INSTALL_DATA) $(TESTSRC) sudoku.hrl $(EXRELSYSDIR) $(INSTALL_DATA) $(TESTTARGETS) $(EXRELSYSDIR) diff --git a/lib/wx/examples/sudoku/sudoku.erl b/lib/wx/examples/sudoku/sudoku.erl index 01caeb9524..01caeb9524 100755..100644 --- a/lib/wx/examples/sudoku/sudoku.erl +++ b/lib/wx/examples/sudoku/sudoku.erl diff --git a/lib/wx/examples/sudoku/sudoku.hrl b/lib/wx/examples/sudoku/sudoku.hrl index 775b563bdc..775b563bdc 100755..100644 --- a/lib/wx/examples/sudoku/sudoku.hrl +++ b/lib/wx/examples/sudoku/sudoku.hrl diff --git a/lib/wx/examples/sudoku/sudoku_board.erl b/lib/wx/examples/sudoku/sudoku_board.erl index 756837582f..756837582f 100755..100644 --- a/lib/wx/examples/sudoku/sudoku_board.erl +++ b/lib/wx/examples/sudoku/sudoku_board.erl diff --git a/lib/wx/examples/sudoku/sudoku_game.erl b/lib/wx/examples/sudoku/sudoku_game.erl index 470aee0e3b..470aee0e3b 100755..100644 --- a/lib/wx/examples/sudoku/sudoku_game.erl +++ b/lib/wx/examples/sudoku/sudoku_game.erl diff --git a/lib/wx/examples/sudoku/sudoku_gui.erl b/lib/wx/examples/sudoku/sudoku_gui.erl index 4aaecfe086..4aaecfe086 100755..100644 --- a/lib/wx/examples/sudoku/sudoku_gui.erl +++ b/lib/wx/examples/sudoku/sudoku_gui.erl diff --git a/lib/wx/examples/xrc/Makefile b/lib/wx/examples/xrc/Makefile index 1dfaae9689..aba58e0d0f 100755..100644 --- a/lib/wx/examples/xrc/Makefile +++ b/lib/wx/examples/xrc/Makefile @@ -28,7 +28,8 @@ TESTMODS = xrc TESTTARGETS = $(TESTMODS:%=%.beam) TESTSRC = $(TESTMODS:%=%.erl) -RESOURCEFILES = appicon.ico basicdlg.xpm custclas.xpm fileopen.gif menu.xrc \ +RESOURCEFILES = \ + appicon.ico basicdlg.xpm custclas.xpm fileopen.gif menu.xrc \ resource.xrc uncenter.xpm variable.xrc appicon.xpm basicdlg.xrc \ custclas.xrc filesave.gif platform.xpm stop.xpm uncenter.xrc \ artprov.xpm controls.xpm derivdlg.xpm frame.xrc platform.xrc \ @@ -59,7 +60,7 @@ include $(ERL_TOP)/make/otp_release_targets.mk docs: -release_spec: +release_spec: opt $(INSTALL_DIR) $(EXRELSYSDIR) $(INSTALL_DATA) $(TESTSRC) $(EXRELSYSDIR) $(INSTALL_DATA) $(TESTTARGETS) $(EXRELSYSDIR) diff --git a/lib/wx/src/wx_object.erl b/lib/wx/src/wx_object.erl index bfd38960dd..82c4cfbad5 100644 --- a/lib/wx/src/wx_object.erl +++ b/lib/wx/src/wx_object.erl @@ -537,16 +537,16 @@ error_info(_Reason, application_controller, _Msg, _State, _Debug) -> error_info(Reason, Name, Msg, State, Debug) -> Reason1 = case Reason of - {undef,[{M,F,A}|MFAs]} -> + {undef,[{M,F,A,L}|MFAs]} -> case code:is_loaded(M) of false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; + {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> Reason; false -> - {'function not exported',[{M,F,A}|MFAs]} + {'function not exported',[{M,F,A,L}|MFAs]} end end; _ -> diff --git a/lib/xmerl/doc/examples/test_html.erl b/lib/xmerl/doc/examples/test_html.erl index 3ca15f30f8..3ca15f30f8 100755..100644 --- a/lib/xmerl/doc/examples/test_html.erl +++ b/lib/xmerl/doc/examples/test_html.erl diff --git a/lib/xmerl/doc/examples/xml/test.xml b/lib/xmerl/doc/examples/xml/test.xml index e803a83560..e803a83560 100755..100644 --- a/lib/xmerl/doc/examples/xml/test.xml +++ b/lib/xmerl/doc/examples/xml/test.xml diff --git a/lib/xmerl/doc/examples/xml/test2.xml b/lib/xmerl/doc/examples/xml/test2.xml index 0cb11194fc..0cb11194fc 100755..100644 --- a/lib/xmerl/doc/examples/xml/test2.xml +++ b/lib/xmerl/doc/examples/xml/test2.xml diff --git a/lib/xmerl/doc/examples/xml/test3.xml b/lib/xmerl/doc/examples/xml/test3.xml index dbdc1e62c2..dbdc1e62c2 100755..100644 --- a/lib/xmerl/doc/examples/xml/test3.xml +++ b/lib/xmerl/doc/examples/xml/test3.xml diff --git a/lib/xmerl/doc/examples/xml/test4.xml b/lib/xmerl/doc/examples/xml/test4.xml index e9d85b8d8f..e9d85b8d8f 100755..100644 --- a/lib/xmerl/doc/examples/xml/test4.xml +++ b/lib/xmerl/doc/examples/xml/test4.xml diff --git a/lib/xmerl/doc/examples/xml/test5.xml b/lib/xmerl/doc/examples/xml/test5.xml index e9d85b8d8f..e9d85b8d8f 100755..100644 --- a/lib/xmerl/doc/examples/xml/test5.xml +++ b/lib/xmerl/doc/examples/xml/test5.xml diff --git a/lib/xmerl/doc/examples/xml/testdtd.dtd b/lib/xmerl/doc/examples/xml/testdtd.dtd index 2ce1c513a6..2ce1c513a6 100755..100644 --- a/lib/xmerl/doc/examples/xml/testdtd.dtd +++ b/lib/xmerl/doc/examples/xml/testdtd.dtd diff --git a/lib/xmerl/doc/examples/xml/xmerl.xml b/lib/xmerl/doc/examples/xml/xmerl.xml index f02282dbef..f02282dbef 100755..100644 --- a/lib/xmerl/doc/examples/xml/xmerl.xml +++ b/lib/xmerl/doc/examples/xml/xmerl.xml diff --git a/lib/xmerl/doc/src/make.dep b/lib/xmerl/doc/src/make.dep deleted file mode 100644 index 9c303fc41c..0000000000 --- a/lib/xmerl/doc/src/make.dep +++ /dev/null @@ -1,24 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex ref_man.tex xmerl.tex xmerl_eventp.tex \ - xmerl_scan.tex xmerl_ug.tex xmerl_xpath.tex \ - xmerl_xs.tex xmerl_xsd.tex xmerl_sax_parser.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -xmerl_ug.tex: motorcycles.txt motorcycles2html.erl motorcycles_dtd.txt \ - new_motorcycles.txt new_motorcycles2.txt - diff --git a/lib/xmerl/doc/src/part_notes.xml b/lib/xmerl/doc/src/part_notes.xml index 827ffd90e9..827ffd90e9 100755..100644 --- a/lib/xmerl/doc/src/part_notes.xml +++ b/lib/xmerl/doc/src/part_notes.xml diff --git a/lib/xmerl/include/xmerl.hrl b/lib/xmerl/include/xmerl.hrl index 7bb3f4de9b..3760a5cce0 100755..100644 --- a/lib/xmerl/include/xmerl.hrl +++ b/lib/xmerl/include/xmerl.hrl @@ -61,10 +61,11 @@ }). %% namespace node - i.e. a {Prefix, URI} pair -%% TODO: these are not currently used?? /RC -record(xmlNsNode,{ - prefix, - uri = [] + parents = [], % [{atom(),integer()}] + pos, % integer() + prefix, % string() + uri = [] % [] | atom() }). %% XML Element @@ -103,9 +104,10 @@ %% processing instruction -record(xmlPI,{ - name, % atom() - pos, % integer() - value % IOlist() + name, % atom() + parents = [], % [{atom(),integer()}] + pos, % integer() + value % IOlist() }). -record(xmlDocument,{ @@ -154,6 +156,9 @@ declarations = [], % [{Name, Attrs}] doctype_name, doctype_DTD = internal, % internal | DTDId + comments = true, + document = false, + default_attrs = false, rules, keep_rules = false, % delete (ets) tab if false namespace_conformant = false, % true | false diff --git a/lib/xmerl/include/xmerl_xlink.hrl b/lib/xmerl/include/xmerl_xlink.hrl index 375e244c23..375e244c23 100755..100644 --- a/lib/xmerl/include/xmerl_xlink.hrl +++ b/lib/xmerl/include/xmerl_xlink.hrl diff --git a/lib/xmerl/src/xmerl.erl b/lib/xmerl/src/xmerl.erl index cf78f7bdf7..2332517988 100644 --- a/lib/xmerl/src/xmerl.erl +++ b/lib/xmerl/src/xmerl.erl @@ -307,7 +307,7 @@ apply_cb(Ms, F, Df, Args) -> apply_cb([M|Ms], F, Df, Args, Ms0) -> case catch apply(M, F, Args) of - {'EXIT', {undef,[{M,F,_}|_]}} -> + {'EXIT', {undef,[{M,F,_,_}|_]}} -> apply_cb(Ms, F, Df, Args, Ms0); {'EXIT', Reason} -> exit(Reason); diff --git a/lib/xmerl/src/xmerl_lib.erl b/lib/xmerl/src/xmerl_lib.erl index 6402f1cbeb..aeb821f411 100644 --- a/lib/xmerl/src/xmerl_lib.erl +++ b/lib/xmerl/src/xmerl_lib.erl @@ -160,8 +160,9 @@ expand_element(E = #xmlText{}, Pos, Parents, Norm) -> E#xmlText{pos = Pos, parents = Parents, value = expand_text(E#xmlText.value, Norm)}; -expand_element(E = #xmlPI{}, Pos, _Parents, Norm) -> +expand_element(E = #xmlPI{}, Pos, Parents, Norm) -> E#xmlPI{pos = Pos, + parents = Parents, value = expand_text(E#xmlPI.value, Norm)}; expand_element(E = #xmlComment{}, Pos, Parents, Norm) -> E#xmlComment{pos = Pos, diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc index 3b9eaa309c..ec9178ea25 100644 --- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc @@ -944,14 +944,19 @@ parse_att_value(?STRING_REST("&", Rest), State, Stop, Acc) -> {unparsed, Name, _} -> ?fatal_error(State1, "Unparsed entity reference in attribute value: " ++ Name) end; -parse_att_value(?STRING_UNBOUND_REST(Stop, Rest), State, Stop, Acc) -> +parse_att_value(?STRING_UNBOUND_REST(Stop, Rest), State, Stop, Acc) -> {lists:reverse(Acc), Rest, State}; -parse_att_value(?STRING_UNBOUND_REST($<, _Rest), State, _Stop, _Acc) -> +parse_att_value(?STRING_UNBOUND_REST($<, _Rest), State, _Stop, _Acc) -> ?fatal_error(State, "< not allowed in attribute value"); -parse_att_value(?STRING_UNBOUND_REST(C, Rest), State, Stop, Acc) -> - parse_att_value(Rest, State, Stop, [C|Acc]); -parse_att_value(Bytes, State, Stop, Acc) -> - unicode_incomplete_check([Bytes, State, Stop, Acc, fun parse_att_value/4], +parse_att_value(?STRING_UNBOUND_REST(C, Rest), State, Stop, Acc) -> + if + ?is_char(C) -> + parse_att_value(Rest, State, Stop, [C|Acc]); + true -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character in attribute value: ~p", [C]))) + end; +parse_att_value(Bytes, State, Stop, Acc) -> + unicode_incomplete_check([Bytes, State, Stop, Acc, fun parse_att_value/4], undefined). @@ -1120,10 +1125,10 @@ parse_content(?STRING_UNBOUND_REST(C, Rest), State, Acc, _IgnorableWS) -> ?is_char(C) -> parse_content(Rest, State, [C|Acc], false); true -> - ?fatal_error(State, "Bad character in content: " ++ C) - end; -parse_content(Bytes, State, Acc, IgnorableWS) -> - unicode_incomplete_check([Bytes, State, Acc, IgnorableWS, fun parse_content/4], + ?fatal_error(State, lists:flatten(io_lib:format("Bad character in content: ~p", [C]))) + end; +parse_content(Bytes, State, Acc, IgnorableWS) -> + unicode_incomplete_check([Bytes, State, Acc, IgnorableWS, fun parse_content/4], undefined). @@ -2522,11 +2527,16 @@ parse_entity_value(?STRING_REST("%", Rest), #xmerl_sax_parser_state{file_type=Ty end end; -parse_entity_value(?STRING_UNBOUND_REST(Stop, Rest), State, Stop, Acc) -> +parse_entity_value(?STRING_UNBOUND_REST(Stop, Rest), State, Stop, Acc) -> {lists:reverse(Acc), Rest, State}; -parse_entity_value(?STRING_UNBOUND_REST(C, Rest), State, Stop, Acc) -> - parse_entity_value(Rest, State, Stop, [C|Acc]); -parse_entity_value(Bytes, State, Stop, Acc) -> +parse_entity_value(?STRING_UNBOUND_REST(C, Rest), State, Stop, Acc) -> + if + ?is_char(C) -> + parse_entity_value(Rest, State, Stop, [C|Acc]); + true -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character in entity value: ~p", [C]))) + end; +parse_entity_value(Bytes, State, Stop, Acc) -> unicode_incomplete_check([Bytes, State, Stop, Acc, fun parse_entity_value/4], undefined). diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 25c6547497..ec7ea534d6 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -100,7 +100,21 @@ %% <dd>Set default character set used (default UTF-8). %% This character set is used only if not explicitly given by the XML %% declaration. </dd> +%% <dt><code>{document, Flag}</code></dt> +%% <dd>Set to 'true' if xmerl should return a complete XML document +%% as an xmlDocument record (default 'false').</dd> +%% <dt><code>{comments, Flag}</code></dt> +%% <dd>Set to 'false' if xmerl should skip comments otherwise they will +%% be returned as xmlComment records (default 'true').</dd> +%% <dt><code>{default_attrs, Flag}</code></dt> +%% <dd>Set to 'true' if xmerl should add to elements missing attributes +%% with a defined default value (default 'false').</dd> %% </dl> +%% @type document() = xmlElement() | xmlDocument(). <p> +%% The document returned by <tt>xmerl_scan:string/[1,2]</tt> and +%% <tt>xmerl_scan:file/[1,2]</tt>. The type of the returned record depends on +%% the value of the document option passed to the function. +%% </p> -module(xmerl_scan). @@ -224,7 +238,7 @@ cont_state(X, S=#xmerl_scanner{fun_states = FS}) -> file(F) -> file(F, []). -%% @spec file(Filename::string(), Options::option_list()) -> {xmlElement(),Rest} +%% @spec file(Filename::string(), Options::option_list()) -> {document(),Rest} %% Rest = list() %%% @doc Parse file containing an XML document file(F, Options) -> @@ -264,7 +278,7 @@ int_file_decl(F, Options,_ExtCharset) -> string(Str) -> string(Str, []). -%% @spec string(Text::list(),Options::option_list()) -> {xmlElement(),Rest} +%% @spec string(Text::list(),Options::option_list()) -> {document(),Rest} %% Rest = list() %%% @doc Parse string containing an XML document string(Str, Options) -> @@ -381,6 +395,12 @@ initial_state([{quiet, F}|T], S) when F==true; F==false -> initial_state(T, S#xmerl_scanner{quiet = F}); initial_state([{doctype_DTD,DTD}|T], S) -> initial_state(T,S#xmerl_scanner{doctype_DTD = DTD}); +initial_state([{document, F}|T], S) when is_boolean(F) -> + initial_state(T,S#xmerl_scanner{document = F}); +initial_state([{comments, F}|T], S) when is_boolean(F) -> + initial_state(T,S#xmerl_scanner{comments = F}); +initial_state([{default_attrs, F}|T], S) when is_boolean(F) -> + initial_state(T,S#xmerl_scanner{default_attrs = F}); initial_state([{text_decl,Bool}|T], S) -> initial_state(T,S#xmerl_scanner{text_decl=Bool}); initial_state([{environment,Env}|T], S) -> @@ -518,6 +538,7 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event, line = L, col = C, environment=Env, encoding=Charset, + document=Document, validation=ValidateResult}) -> S1 = Event(#xmerl_event{event = started, line = L, @@ -530,8 +551,8 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event, Str=if Charset == "utf-8" -> Str0; - Charset=/=undefined -> % Default character set is UTF-8 - xmerl_ucs:to_unicode(Str0,list_to_atom(Charset)); + Charset =/= undefined -> % Default character set is UTF-8 + xmerl_ucs:to_unicode(Str0, list_to_atom(Charset)); true -> %% Charset is undefined if no external input is %% given, and no auto detection of character %% encoding was made. @@ -539,17 +560,17 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event, end, %% M1 = erlang:memory(), %% io:format("Memory status before prolog: ~p~n",[M1]), - {T1, S2} = scan_prolog(Str, S1, _StartPos = 1), + {Prolog, Pos, T1, S2} = scan_prolog(Str, S1, _StartPos = 1), %% M2 = erlang:memory(), %% io:format("Memory status after prolog: ~p~n",[M2]), %%io:format("scan_document 2, prolog parsed~n",[]), - T2 = scan_mandatory("<",T1,1,S2,expected_element_start_tag), + T2 = scan_mandatory("<", T1, 1, S2, expected_element_start_tag), %% M3 = erlang:memory(), %% io:format("Memory status before element: ~p~n",[M3]), - {Res, T3, S3} =scan_element(T2,S2,_StartPos = 1), + {Res, T3, S3} = scan_element(T2,S2,Pos), %% M4 = erlang:memory(), %% io:format("Memory status after element: ~p~n",[M4]), - {Tail, S4}=scan_misc(T3, S3, _StartPos = 1), + {Misc, _Pos1, Tail, S4}=scan_misc(T3, S3, Pos + 1), %% M5 = erlang:memory(), %% io:format("Memory status after misc: ~p~n",[M5]), @@ -558,44 +579,52 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event, col = S4#xmerl_scanner.col, data = document}, S4), - {Res2,S6} = case validation_mode(ValidateResult) of + {Res2, S6} = case validation_mode(ValidateResult) of off -> - {Res,cleanup(S5)}; + {Res, cleanup(S5)}; dtd when Env == element; Env == prolog -> check_decl2(S5), - case xmerl_validate:validate(S5,Res) of - {'EXIT',{error,Reason}} -> - S5b=cleanup(S5), - ?fatal({failed_validation,Reason}, S5b); - {'EXIT',Reason} -> - S5b=cleanup(S5), - ?fatal({failed_validation,Reason}, S5b); - {error,Reason} -> - S5b=cleanup(S5), - ?fatal({failed_validation,Reason}, S5b); - {error,Reason,_Next} -> - S5b=cleanup(S5), - ?fatal({failed_validation,Reason}, S5b); + case xmerl_validate:validate(S5, Res) of + {'EXIT', {error, Reason}} -> + S5b = cleanup(S5), + ?fatal({failed_validation, Reason}, S5b); + {'EXIT', Reason} -> + S5b = cleanup(S5), + ?fatal({failed_validation, Reason}, S5b); + {error, Reason} -> + S5b = cleanup(S5), + ?fatal({failed_validation, Reason}, S5b); + {error, Reason, _Next} -> + S5b = cleanup(S5), + ?fatal({failed_validation, Reason}, S5b); _XML -> - {Res,cleanup(S5)} + {Res, cleanup(S5)} end; schema -> - case schemaLocations(Res,S5) of - {ok,Schemas} -> + case schemaLocations(Res, S5) of + {ok, Schemas} -> cleanup(S5), %%io:format("Schemas: ~p~nRes: ~p~ninhertih_options(S): ~p~n", %% [Schemas,Res,inherit_options(S5)]), - XSDRes = xmerl_xsd:process_validate(Schemas,Res, + XSDRes = xmerl_xsd:process_validate(Schemas, Res, inherit_options(S5)), - handle_schema_result(XSDRes,S5); + handle_schema_result(XSDRes, S5); _ -> - {Res,cleanup(S5)} + {Res, cleanup(S5)} end; _ -> - {Res,cleanup(S5)} + {Res, cleanup(S5)} end, - {Res2, Tail, S6}. + Res3 = + case Document of + true -> + Content = lists:reverse(Prolog, [Res2 | lists:reverse(Misc)]), + #xmlDocument{content = Content}; + false -> + Res2 + end, + {Res3, Tail, S6}. scan_decl(Str, S=#xmerl_scanner{event_fun = Event, @@ -609,11 +638,11 @@ scan_decl(Str, S=#xmerl_scanner{event_fun = Event, data = document}, S), case scan_prolog(Str, S1, _StartPos = 1) of - {T2="<"++_, S2} -> + {_,_,T2="<"++_, S2} -> {{S2#xmerl_scanner.user_state,T2},[],S2}; - {[], S2}-> + {_,_,[], S2}-> {[],[],S2}; - {T2, S2} -> + {_,_,T2, S2} -> {_,_,S3} = scan_content(T2,S2,[],_Attrs=[],S2#xmerl_scanner.space, _Lang=[],_Parents=[],#xmlNamespace{}), {T2,[],S3} @@ -624,14 +653,17 @@ scan_decl(Str, S=#xmerl_scanner{event_fun = Event, %%% prolog ::= XMLDecl? Misc* (doctypedecl Misc*)? %%% %% empty text declarations are handled by the first function clause. -scan_prolog([], S=#xmerl_scanner{continuation_fun = F}, Pos) -> +scan_prolog(T, S, Pos) -> + scan_prolog(T, S, Pos, []). +scan_prolog([], S=#xmerl_scanner{continuation_fun = F}, Pos, Acc) -> ?dbg("cont()...~n", []), - F(fun(MoreBytes, S1) -> scan_prolog(MoreBytes, S1, Pos) end, - fun(S1) -> {[], S1} end, + F(fun(MoreBytes, S1) -> scan_prolog(MoreBytes, S1, Pos, Acc) end, + fun(S1) -> {Acc, Pos, [], S1} end, S); -scan_prolog("<?xml"++T,S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L},Pos) - when ?whitespace(hd(T)) -> - {Charset,T3, S3}= +scan_prolog("<?xml"++T, + S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L}, + Pos,Acc) when ?whitespace(hd(T)) -> + {Charset, T3, S3} = if Col==1,L==1,S0#xmerl_scanner.text_decl==true -> ?dbg("prolog(\"<?xml\")~n", []), @@ -639,13 +671,13 @@ scan_prolog("<?xml"++T,S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L},Pos) {_,T1,S1} = mandatory_strip(T,S), {Decl,T2, S2}=scan_text_decl(T1,S1), Encoding=Decl#xmlDecl.encoding, - {Encoding,T2, S2#xmerl_scanner{encoding=Encoding}}; + {Encoding, T2, S2#xmerl_scanner{encoding=Encoding}}; Col==1,L==1 -> ?dbg("prolog(\"<?xml\")~n", []), ?bump_col(5), {Decl,T2, S2}=scan_xml_decl(T, S), Encoding=Decl#xmlDecl.encoding, - {Encoding,T2, S2#xmerl_scanner{encoding=Encoding}}; + {Encoding, T2, S2#xmerl_scanner{encoding=Encoding}}; true -> ?fatal({xml_declaration_must_be_first_in_doc,Col,L},S0) end, @@ -659,7 +691,7 @@ scan_prolog("<?xml"++T,S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L},Pos) %% Now transform to declared character set. if Charset==Charset0 -> % Document already transformed to this charset! - scan_prolog(T3, S3, Pos); + scan_prolog(T3, S3, Pos, Acc); Charset0=/=undefined -> %% For example may an external entity %% have the BOM for utf-16 and the internal @@ -668,17 +700,18 @@ scan_prolog("<?xml"++T,S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L},Pos) %% 'iso-10646-utf-1', and Charset will be 'utf-16', all %% legal. %% - scan_prolog(T3,S3#xmerl_scanner{encoding=Charset0},Pos); + scan_prolog(T3,S3#xmerl_scanner{encoding=Charset0},Pos,Acc); Charset == "utf-8" -> - scan_prolog(T3, S3, Pos); + scan_prolog(T3, S3, Pos, Acc); Charset=/=undefined -> % Document not previously transformed T4=xmerl_ucs:to_unicode(T3,list_to_atom(Charset)), - scan_prolog(T4, S3, Pos); + scan_prolog(T4, S3, Pos, Acc); true -> % No encoding info given - scan_prolog(T3, S3, Pos) + scan_prolog(T3, S3, Pos, Acc) end; -scan_prolog("<!DOCTYPE" ++ T, S0=#xmerl_scanner{environment=prolog, - encoding=_Charset}, Pos) -> +scan_prolog("<!DOCTYPE" ++ T, + S0=#xmerl_scanner{environment=prolog,encoding=_Charset}, + Pos, Acc) -> ?dbg("prolog(\"<!DOCTYPE\")~n", []), ?bump_col(9), %% If no known character set assume it is UTF-8 @@ -687,10 +720,13 @@ scan_prolog("<!DOCTYPE" ++ T, S0=#xmerl_scanner{environment=prolog, true -> T end, {T2, S1} = scan_doctype(T1, S), - scan_misc(T2, S1, Pos); -scan_prolog(Str="%"++_T,S=#xmerl_scanner{environment={external,_}},_Pos) -> - scan_ext_subset(Str,S); -scan_prolog(Str, S0 = #xmerl_scanner{user_state=_US,encoding=_Charset},Pos) -> + scan_misc(T2, S1, Pos, Acc); +scan_prolog(Str="%"++_T,S=#xmerl_scanner{environment={external,_}}, + Pos,Acc) -> + {T, S1} = scan_ext_subset(Str,S), + {Acc, Pos, T, S1}; +scan_prolog(Str, S0 = #xmerl_scanner{user_state=_US,encoding=_Charset}, + Pos,Acc) -> ?dbg("prolog(\"<\")~n", []), %% Check for Comments, PI before possible DOCTYPE declaration @@ -700,26 +736,28 @@ scan_prolog(Str, S0 = #xmerl_scanner{user_state=_US,encoding=_Charset},Pos) -> %% Charset==undefined -> xmerl_ucs:to_unicode(Str,'utf-8'); true -> Str end, - {T1, S1}=scan_misc(T, S, Pos), - scan_prolog2(T1,S1,Pos). + {Acc1, Pos1, T1, S1}=scan_misc(T, S, Pos, Acc), + scan_prolog2(T1,S1,Pos1,Acc1). -scan_prolog2([], S=#xmerl_scanner{continuation_fun = F}, Pos) -> +scan_prolog2([], S=#xmerl_scanner{continuation_fun = F}, Pos, Acc) -> ?dbg("cont()...~n", []), - F(fun(MoreBytes, S1) -> scan_prolog2(MoreBytes, S1, Pos) end, - fun(S1) -> {[], S1} end, + F(fun(MoreBytes, S1) -> scan_prolog2(MoreBytes, S1, Pos, Acc) end, + fun(S1) -> {Acc, Pos, [], S1} end, S); -scan_prolog2("<!DOCTYPE" ++ T, S0=#xmerl_scanner{environment=prolog}, Pos) -> +scan_prolog2("<!DOCTYPE" ++ T, S0=#xmerl_scanner{environment=prolog}, + Pos, Acc) -> ?dbg("prolog(\"<!DOCTYPE\")~n", []), ?bump_col(9), {T1, S1} = scan_doctype(T, S), - scan_misc(T1, S1, Pos); -scan_prolog2(Str = "<!" ++ _, S, _Pos) -> + scan_misc(T1, S1, Pos, Acc); +scan_prolog2(Str = "<!" ++ _, S, Pos, Acc) -> ?dbg("prolog(\"<!\")~n", []), %% In e.g. a DTD, we jump directly to markup declarations - scan_ext_subset(Str, S); -scan_prolog2(Str, S0 = #xmerl_scanner{user_state=_US},Pos) -> + {T, S1} = scan_ext_subset(Str, S), + {Acc, Pos, T, S1}; +scan_prolog2(Str, S0 = #xmerl_scanner{user_state=_US},Pos,Acc) -> ?dbg("prolog(\"<\")~n", []), %% Here we consider the DTD provided by doctype_DTD option, @@ -733,7 +771,7 @@ scan_prolog2(Str, S0 = #xmerl_scanner{user_state=_US},Pos) -> end, %% Check for more Comments and PI after DOCTYPE declaration % ?bump_col(1), - scan_misc(Str, S1, Pos). + scan_misc(Str, S1, Pos, Acc). @@ -743,26 +781,46 @@ scan_prolog2(Str, S0 = #xmerl_scanner{user_state=_US},Pos) -> %% - Neither of Comment and PI are returned in the resulting parsed %% structure. %% - scan_misc/3 implements Misc* as that is how the rule is always used -scan_misc([], S=#xmerl_scanner{continuation_fun = F}, Pos) -> +scan_misc(T, S, Pos) -> + scan_misc(T, S, Pos, []). +scan_misc([], S=#xmerl_scanner{continuation_fun = F}, Pos, Acc) -> ?dbg("cont()...~n", []), - F(fun(MoreBytes, S1) -> scan_misc(MoreBytes, S1, Pos) end, - fun(S1) -> {[], S1} end, + F(fun(MoreBytes, S1) -> scan_misc(MoreBytes, S1, Pos, Acc) end, + fun(S1) -> {Acc, Pos, [], S1} end, S); -scan_misc("<!--" ++ T, S0, Pos) -> % Comment +scan_misc("<!--" ++ T, S0=#xmerl_scanner{acc_fun = F, comments=CF}, Pos, Acc) -> % Comment ?bump_col(4), - {_, T1, S1} = scan_comment(T, S, Pos, _Parents = [], _Lang = []), - scan_misc(T1,S1,Pos); -scan_misc("<?" ++ T, S0, Pos) -> % PI + {C, T1, S1} = scan_comment(T, S, Pos, _Parents = [], _Lang = []), + case CF of + true -> + {Acc2, Pos2, S3} = + case F(C, Acc, S1) of + {Acc1, S2} -> + {Acc1, Pos + 1, S2}; + {Acc1, Pos1, S2} -> + {Acc1, Pos1, S2} + end, + scan_misc(T1, S3, Pos2, Acc2); + false -> + scan_misc(T1, S1, Pos, Acc) + end; +scan_misc("<?" ++ T, S0=#xmerl_scanner{acc_fun = F}, Pos, Acc) -> % PI ?dbg("prolog(\"<?\")~n", []), ?bump_col(2), - {_PI, T1, S1} = scan_pi(T, S, Pos), - scan_misc(T1,S1,Pos); -scan_misc(T=[H|_T], S, Pos) when ?whitespace(H) -> + {PI, T1, S1} = scan_pi(T, S, Pos, []), + {Acc2, Pos2, S3} = case F(PI, Acc, S1) of + {Acc1, S2} -> + {Acc1, Pos + 1, S2}; + {Acc1, Pos1, S2} -> + {Acc1, Pos1, S2} + end, + scan_misc(T1,S3,Pos2,Acc2); +scan_misc(T=[H|_T], S, Pos, Acc) when ?whitespace(H) -> ?dbg("prolog(whitespace)~n", []), {_,T1,S1}=strip(T,S), - scan_misc(T1,S1,Pos); -scan_misc(T,S,_Pos) -> - {T,S}. + scan_misc(T1,S1,Pos,Acc); +scan_misc(T,S,Pos,Acc) -> + {Acc,Pos,T,S}. cleanup(S=#xmerl_scanner{keep_rules = false, @@ -789,7 +847,8 @@ scan_xml_decl(T, S) -> Attr = #xmlAttribute{name = version, parents = [{xml, _XMLPos = 1}], value = Vsn}, - scan_xml_decl(T4, S4, #xmlDecl{attributes = [Attr]}). + scan_xml_decl(T4, S4, #xmlDecl{vsn = Vsn, + attributes = [Attr]}). scan_xml_decl([], S=#xmerl_scanner{continuation_fun = F}, Decl) -> ?dbg("cont()...~n", []), @@ -1025,50 +1084,53 @@ xml_vsn([H|T], S=#xmerl_scanner{col = C}, Delim, Acc) -> %%%%%%% [16] PI ::= '<?' PITarget (S (Char* - (Char* '?>' Char*)))? '?>' -scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Pos) -> +scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Pos, Ps) -> ?dbg("cont()...~n", []), - F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Pos) end, + F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Pos, Ps) end, fun(S1) -> ?fatal(unexpected_end, S1) end, S); -scan_pi(Str = [H1,H2,H3 | T],S0=#xmerl_scanner{line = L, col = C}, Pos) +scan_pi(Str = [H1,H2,H3 | T],S0=#xmerl_scanner{line = L, col = C}, Pos, Ps) when H1==$x;H1==$X -> %% names beginning with [xX][mM][lL] are reserved for future use. ?bump_col(3), if ((H2==$m) or (H2==$M)) and ((H3==$l) or (H3==$L)) -> - scan_wellknown_pi(T,S,Pos); + scan_wellknown_pi(T,S,Pos,Ps); true -> {Target, _NamespaceInfo, T1, S1} = scan_name(Str, S), - scan_pi(T1, S1, Target, L, C, Pos, []) + scan_pi(T1, S1, Target, L, C, Pos, Ps, []) end; -scan_pi(Str, S=#xmerl_scanner{line = L, col = C}, Pos) -> +scan_pi(Str, S=#xmerl_scanner{line = L, col = C}, Pos, Ps) -> {Target, _NamespaceInfo, T1, S1} = scan_name(Str, S), - scan_pi(T1, S1, Target, L, C, Pos,[]). + scan_pi(T1, S1, Target, L, C, Pos, Ps, []). %%% More info on xml-stylesheet can be found at: %%% "Associating Style Sheets with XML documents", Version 1.0, %%% W3C Recommendation 29 June 1999 (http://www.w3.org/TR/xml-stylesheet/) -scan_wellknown_pi("-stylesheet"++T, S0=#xmerl_scanner{line=L,col=C},Pos) -> +scan_wellknown_pi("-stylesheet"++T, S0=#xmerl_scanner{line=L,col=C},Pos,Ps) -> ?dbg("prolog(\"<?xml-stylesheet\")~n", []), ?bump_col(16), - scan_pi(T, S, "xml-stylesheet",L,C,Pos,[]); -scan_wellknown_pi(Str,S,_Pos) -> + scan_pi(T, S, "xml-stylesheet",L,C,Pos,Ps,[]); +scan_wellknown_pi(Str,S,_Pos,_Ps) -> ?fatal({invalid_target_name, lists:sublist(Str, 1, 10)}, S). -scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Target,L, C, Pos, Acc) -> +scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Target, + L, C, Pos, Ps, Acc) -> ?dbg("cont()...~n", []), - F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Target, L, C, Pos, Acc) end, + F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Target, + L, C, Pos, Ps, Acc) end, fun(S1) -> ?fatal(unexpected_end, S1) end, S); scan_pi("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event}, - Target, L, C, Pos, Acc) -> + Target, L, C, Pos, Ps, Acc) -> ?bump_col(2), PI = #xmlPI{name = Target, + parents = Ps, pos = Pos, value = lists:reverse(Acc)}, S1 = #xmerl_scanner{} = Event(#xmerl_event{event = ended, @@ -1077,22 +1139,25 @@ scan_pi("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, data = PI}, S), {Ret, S2} = Hook(PI, S1), {Ret, T, S2}; -scan_pi([H|T], S, Target, L, C, Pos, Acc) when ?whitespace(H) -> +scan_pi([H|T], S, Target, L, C, Pos, Ps, Acc) when ?whitespace(H) -> ?strip1, - scan_pi2(T1, S1, Target, L, C, Pos, Acc); -scan_pi([H|_T],S,_Target, _L, _C, _Pos, _Acc) -> + scan_pi2(T1, S1, Target, L, C, Pos, Ps, Acc); +scan_pi([H|_T],S,_Target, _L, _C, _Pos, _Ps, _Acc) -> ?fatal({expected_whitespace_OR_end_of_PI,{char,H}}, S). -scan_pi2([], S=#xmerl_scanner{continuation_fun = F}, Target,L, C, Pos, Acc) -> +scan_pi2([], S=#xmerl_scanner{continuation_fun = F}, Target, + L, C, Pos, Ps, Acc) -> ?dbg("cont()...~n", []), - F(fun(MoreBytes, S1) -> scan_pi2(MoreBytes, S1, Target, L, C, Pos, Acc) end, + F(fun(MoreBytes, S1) -> scan_pi2(MoreBytes, S1, Target, + L, C, Pos, Ps, Acc) end, fun(S1) -> ?fatal(unexpected_end, S1) end, S); scan_pi2("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event}, - Target, L, C, Pos, Acc) -> + Target, L, C, Pos, Ps, Acc) -> ?bump_col(2), PI = #xmlPI{name = Target, + parents = Ps, pos = Pos, value = lists:reverse(Acc)}, S1 = #xmerl_scanner{} = Event(#xmerl_event{event = ended, @@ -1101,10 +1166,10 @@ scan_pi2("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, data = PI}, S), {Ret, S2} = Hook(PI, S1), {Ret, T, S2}; -scan_pi2(Str, S0, Target, L, C, Pos, Acc) -> +scan_pi2(Str, S0, Target, L, C, Pos, Ps, Acc) -> ?bump_col(1), {Ch,T} = wfc_legal_char(Str,S), - scan_pi2(T, S, Target, L, C, Pos, [Ch|Acc]). + scan_pi2(T, S, Target, L, C, Pos, Ps, [Ch|Acc]). @@ -1575,7 +1640,7 @@ scan_markup_decl("<!--" ++ T, S0) -> scan_comment(T, S); scan_markup_decl("<?" ++ T, S0) -> ?bump_col(2), - {_PI, T1, S1} = scan_pi(T, S,_Pos=markup), + {_PI, T1, S1} = scan_pi(T, S,_Pos=markup,[]), strip(T1, S1); scan_markup_decl("<!ELEMENT" ++ T, #xmerl_scanner{rules_read_fun = Read, @@ -1981,7 +2046,7 @@ scan_element(T, S, Pos) -> scan_element(T, S=#xmerl_scanner{line=L,col=C}, Pos, SpaceDefault,Lang, Parents, NS) -> {Name, NamespaceInfo, T1, S1} = scan_name(T, S), - vc_Element_valid(Name,S), + vc_Element_valid(Name,NamespaceInfo,S), ?strip2, scan_element(T2, S2, Pos, Name, L, C, _Attrs = [], Lang, Parents, NamespaceInfo, NS, @@ -2016,7 +2081,8 @@ scan_element("/>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, Attrs = lists:reverse(Attrs0), E=processed_whole_element(S, Pos, Name, Attrs, Lang, Parents,NSI,Namespace), - wfc_unique_att_spec(Attrs,S), + #xmlElement{attributes = Attrs1} = E, + wfc_unique_att_spec(Attrs1,S), S1 = #xmerl_scanner{} = Event(#xmerl_event{event = ended, line = L, col = C, @@ -2086,9 +2152,10 @@ scan_element(T, S, Pos, Name, StartL, StartC, Attrs, Lang, Parents, P+1 end, Attr = #xmlAttribute{name = AttName, + parents = [{Name, Pos}|Parents], pos = AttrPos, language = Lang, - namespace = NamespaceInfo, + nsinfo = NamespaceInfo, value = AttValue, normalized = IsNorm}, XMLBase=if @@ -2110,6 +2177,14 @@ scan_element(T, S, Pos, Name, StartL, StartC, Attrs, Lang, Parents, scan_element(T4, S5, Pos, Name, StartL, StartC, [Attr|Attrs], Lang, Parents, NSI, NewNS, SpaceDefault). +get_default_attrs(S = #xmerl_scanner{rules_read_fun = Read}, ElemName) -> + case Read(elem_def, ElemName, S) of + #xmlElement{attributes = Attrs} -> + [ {AttName, AttValue} || + {AttName, _, AttValue, _, _} <- Attrs, AttValue =/= no_value ]; + _ -> [] + end. + get_att_type(S=#xmerl_scanner{rules_read_fun=Read},AttName,ElemName) -> case Read(elem_def,ElemName,S) of #xmlElement{attributes = Attrs} -> @@ -2139,6 +2214,23 @@ processed_whole_element(S=#xmerl_scanner{hook_fun = _Hook, Pos, Name, Attrs, Lang, Parents, NSI, Namespace) -> Language = check_language(Attrs, Lang), + AllAttrs = + case S#xmerl_scanner.default_attrs of + true -> + [ #xmlAttribute{name = AttName, + parents = [{Name, Pos} | Parents], + language = Lang, + nsinfo = NSI, + namespace = Namespace, + value = AttValue, + normalized = true} || + {AttName, AttValue} <- get_default_attrs(S, Name), + AttValue =/= no_value, + not lists:keymember(AttName, #xmlAttribute.name, Attrs) ]; + false -> + Attrs + end, + {ExpName, ExpAttrs} = case S#xmerl_scanner.namespace_conformant of true -> @@ -2153,14 +2245,15 @@ processed_whole_element(S=#xmerl_scanner{hook_fun = _Hook, TempNamespace = Namespace#xmlNamespace{default = []}, ExpAttrsX = [A#xmlAttribute{ + namespace=Namespace, expanded_name=expanded_name( A#xmlAttribute.name, - A#xmlAttribute.namespace, + A#xmlAttribute.nsinfo, % NSI, - TempNamespace, S)} || A <- Attrs], + TempNamespace, S)} || A <- AllAttrs], {expanded_name(Name, NSI, Namespace, S), ExpAttrsX}; false -> - {Name, Attrs} + {Name, AllAttrs} end, #xmlElement{name = Name, @@ -2194,10 +2287,32 @@ check_namespace(_, _, _, NS) -> expanded_name(Name, [], #xmlNamespace{default = []}, _S) -> Name; -expanded_name(Name, [], #xmlNamespace{default = URI}, _S) -> - {URI, Name}; -expanded_name(_Name, {"xmlns", Local}, _NS, _S) -> % CHECK THIS /JB - {"xmlns",Local}; +expanded_name(Name, [], #xmlNamespace{default = URI}, S) -> + case URI of + 'http://www.w3.org/XML/1998/namespace' -> + ?fatal(cannot_bind_default_namespace_to_xml_namespace_name, S); + 'http://www.w3.org/2000/xmlns/' -> + ?fatal(cannot_bind_default_namespace_to_xmlns_namespace_name, S); + _ -> + {URI, Name} + end; +expanded_name(Name, N = {"xmlns", Local}, #xmlNamespace{nodes = Ns}, S) -> + {_, Value} = lists:keyfind(Local, 1, Ns), + case Name of + 'xmlns:xml' when Value =/= 'http://www.w3.org/XML/1998/namespace' -> + ?fatal({xml_prefix_cannot_be_redeclared, Value}, S); + 'xmlns:xmlns' -> + ?fatal({xmlns_prefix_cannot_be_declared, Value}, S); + _ -> + case Value of + 'http://www.w3.org/XML/1998/namespace' -> + ?fatal({cannot_bind_prefix_to_xml_namespace, Local}, S); + 'http://www.w3.org/2000/xmlns/' -> + ?fatal({cannot_bind_prefix_to_xmlns_namespace, Local}, S); + _ -> + N + end + end; expanded_name(_Name, {Prefix, Local}, #xmlNamespace{nodes = Ns}, S) -> case lists:keysearch(Prefix, 1, Ns) of {value, {_, URI}} -> @@ -2449,9 +2564,23 @@ scan_content("&" ++ T, S0, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) - _ -> scan_content(string_to_char_set(S1#xmerl_scanner.encoding,ExpRef)++T1,S1,Pos,Name,Attrs,Space,Lang,Parents,NS,Acc,[]) end; -scan_content("<!--" ++ T, S, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) -> - {_, T1, S1} = scan_comment(T, S, Pos, Parents, Lang), - scan_content(T1, S1, Pos+1, Name, Attrs, Space, Lang, Parents, NS, Acc,[]); +scan_content("<!--" ++ T, S0=#xmerl_scanner{acc_fun = F, comments=CF}, Pos, Name, Attrs, Space, + Lang, Parents, NS, Acc,[]) -> + ?bump_col(4), + {C, T1, S1} = scan_comment(T, S, Pos, Parents, Lang), + case CF of + true -> + {Acc2, Pos2, S3} = + case F(C, Acc, S1) of + {Acc1, S2} -> + {Acc1, Pos + 1, S2}; + {Acc1, Pos1, S2} -> + {Acc1, Pos1, S2} + end, + scan_content(T1, S3, Pos2, Name, Attrs, Space, Lang, Parents, NS, Acc2,[]); + false -> + scan_content(T1, S1, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) + end; scan_content("<" ++ T, S0, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) -> ?bump_col(1), {Markup, T1, S1} = @@ -2508,9 +2637,9 @@ scan_content_markup("![CDATA[" ++ T, S0, Pos, _Name, _Attrs, _Space, _Lang, Parents, _NS) -> ?bump_col(8), scan_cdata(T, S, Pos, Parents); -scan_content_markup("?"++T,S0,Pos,_Name,_Attrs,_Space,_Lang,_Parents,_NS) -> +scan_content_markup("?"++T,S0,Pos,_Name,_Attrs,_Space,_Lang,Parents,_NS) -> ?bump_col(1), - scan_pi(T, S, Pos); + scan_pi(T, S, Pos, Parents); scan_content_markup(T, S, Pos, _Name, _Attrs, Space, Lang, Parents, NS) -> scan_element(T, S, Pos, Space, Lang, Parents, NS). @@ -3259,12 +3388,18 @@ mandatory_delimeter_wfc(T,S) -> wfc_unique_att_spec([],_S) -> ok; -wfc_unique_att_spec([#xmlAttribute{name=N}|Atts],S) -> +wfc_unique_att_spec([#xmlAttribute{name=N,expanded_name=EN}|Atts],S) -> case lists:keymember(N,#xmlAttribute.name,Atts) of true -> ?fatal({error,{unique_att_spec_required,N}},S); _ -> - wfc_unique_att_spec(Atts,S) + case S#xmerl_scanner.namespace_conformant andalso + lists:keymember(EN, #xmlAttribute.expanded_name, Atts) of + true -> + ?fatal({error,{unique_att_spec_required,EN}},S); + _ -> + wfc_unique_att_spec(Atts,S) + end end. wfc_legal_char(Chars,S) when is_list(Chars)-> @@ -3313,6 +3448,11 @@ wfc_Internal_parsed_entity(internal,Value,S) -> wfc_Internal_parsed_entity(_,_,_) -> ok. +vc_Element_valid(_Name, {"xmlns", _}, + S = #xmerl_scanner{namespace_conformant = true}) -> + ?fatal({error,{illegal_element_prefix,xmlns}},S); +vc_Element_valid(Name, _, S) -> + vc_Element_valid(Name, S). vc_Element_valid(_Name,#xmerl_scanner{environment=internal_parsed_entity}) -> ok; @@ -3917,7 +4057,7 @@ schemaLocations(El,#xmerl_scanner{schemaLocation=SL}) -> schemaLocations(#xmlElement{attributes=Atts,xmlbase=_Base}) -> Pred = fun(#xmlAttribute{name=schemaLocation}) -> false; - (#xmlAttribute{namespace={_,"schemaLocation"}}) -> false; + (#xmlAttribute{nsinfo={_,"schemaLocation"}}) -> false; (_) -> true end, case lists:dropwhile(Pred,Atts) of diff --git a/lib/xmerl/src/xmerl_validate.erl b/lib/xmerl/src/xmerl_validate.erl index 893e23ca34..4028fef2b9 100644 --- a/lib/xmerl/src/xmerl_validate.erl +++ b/lib/xmerl/src/xmerl_validate.erl @@ -399,25 +399,28 @@ test_attribute_value(_Rule,Attr,_,_) -> %% +type valid_contents([rule()],[xmlElement()])-> %% [xmlElement() | {error,???}. -valid_contents(Rule,XMLS,Rules,S,WSActionMode)-> - case parse(Rule,XMLS,Rules,WSActionMode,S) of - {XML_N,[]}-> - lists:flatten(XML_N); - {_,[#xmlElement{name=Name}|_T]} -> - exit({error,{element,Name,isnt_comprise_in_the_rule,Rule}}); - {_,[#xmlText{}=Txt|_T]} -> - exit({error,{element,text,Txt,isnt_comprise_in_the_rule,Rule}}); - {error,Reason} -> - {error,Reason}; - {error,Reason,N} -> - {error,Reason,N} +valid_contents(Rule, XMLS, Rules, S, WSActionMode)-> + case parse(Rule, XMLS, Rules, WSActionMode, S) of + {error, Reason} -> + {error, Reason}; + {error, Reason, N} -> + {error, Reason, N}; + {XML_N, Rest} -> %The list may consist of xmlComment{} records + case lists:dropwhile(fun(X) when is_record(X, xmlComment) -> true; (_) -> false end, Rest) of + [] -> + lists:flatten(XML_N); + [#xmlElement{name=Name} |_T] -> + exit({error, {element, Name, isnt_comprise_in_the_rule, Rule}}); + [#xmlText{} = Txt |_T] -> + exit({error, {element, text, Txt, isnt_comprise_in_the_rule, Rule}}) + end end. -parse({'*',SubRule},XMLS,Rules,WSaction,S)-> - star(SubRule,XMLS,Rules,WSaction,[],S); -parse({'+',SubRule},XMLS,Rules,WSaction,S) -> - plus(SubRule,XMLS,Rules,WSaction,S); -parse({choice,CHOICE},XMLS,Rules,WSaction,S)-> +parse({'*', SubRule}, XMLS, Rules, WSaction, S)-> + star(SubRule, XMLS, Rules, WSaction, [], S); +parse({'+',SubRule}, XMLS, Rules, WSaction, S) -> + plus(SubRule, XMLS, Rules, WSaction, S); +parse({choice,CHOICE}, XMLS, Rules, WSaction, S)-> % case XMLS of % [] -> % io:format("~p~n",[{choice,CHOICE,[]}]); @@ -426,47 +429,49 @@ parse({choice,CHOICE},XMLS,Rules,WSaction,S)-> % [#xmlText{value=V}|_] -> % io:format("~p~n",[{choice,CHOICE,{text,V}}]) % end, - choice(CHOICE,XMLS,Rules,WSaction,S); -parse(empty,[],_Rules,_WSaction,_S) -> - {[],[]}; -parse({'?',SubRule},XMLS,Rules,_WSaction,S)-> - question(SubRule,XMLS,Rules,S); -parse({seq,List},XMLS,Rules,WSaction,S) -> - seq(List,XMLS,Rules,WSaction,S); -parse(El_Name,[#xmlElement{name=El_Name}=XML|T],Rules,_WSaction,S) + choice(CHOICE, XMLS, Rules, WSaction, S); +parse(empty, [], _Rules, _WSaction, _S) -> + {[], []}; +parse({'?', SubRule}, XMLS, Rules, _WSaction, S)-> + question(SubRule, XMLS, Rules, S); +parse({seq,List}, XMLS, Rules, WSaction, S) -> + seq(List, XMLS, Rules, WSaction, S); +parse(El_Name, [#xmlElement{name=El_Name} = XML |T], Rules, _WSaction, S) when is_atom(El_Name)-> - case do_validation(read_rules(Rules,El_Name),XML,Rules,S) of - {error,R} -> + case do_validation(read_rules(Rules, El_Name), XML, Rules, S) of + {error, R} -> % {error,R}; exit(R); - {error,R,_N}-> + {error, R, _N}-> % {error,R,N}; exit(R); XML_-> - {[XML_],T} + {[XML_], T} end; -parse(any,Cont,Rules,_WSaction,S) -> - case catch parse_any(Cont,Rules,S) of - Err = {error,_} -> Err; - ValidContents -> {ValidContents,[]} +parse(any, Cont, Rules, _WSaction, S) -> + case catch parse_any(Cont, Rules, S) of + Err = {error, _} -> Err; + ValidContents -> {ValidContents, []} end; -parse(El_Name,[#xmlElement{name=Name}|_T]=S,_Rules,_WSa,_S) when is_atom(El_Name)-> +parse(El_Name, [#xmlElement{name=Name} |_T] = XMLS, _Rules, _WSa, _S) when is_atom(El_Name) -> {error, - {element_seq_not_conform,{wait,El_Name},{is,Name}}, - {{next,S},{act,[]}} }; -parse(_El_Name,[#xmlPI{}=H|T],_Rules,_WSa,_S) -> - {[H],T}; -parse('#PCDATA',XML,_Rules,_WSa,_S)-> + {element_seq_not_conform,{wait, El_Name}, {is, Name}}, + {{next, XMLS}, {act, []}}}; +parse(El_Name, [#xmlComment{} |T], Rules, WSa, S) -> + parse(El_Name, T, Rules, WSa, S); +parse(_El_Name, [#xmlPI{} = H |T], _Rules, _WSa, _S) -> + {[H], T}; +parse('#PCDATA', XMLS, _Rules, _WSa, _S)-> %%% PCDATA it is 0 , 1 or more #xmlText{}. - parse_pcdata(XML); -parse(El_Name,[#xmlText{}|_T]=S,_Rules,_WSa,_S)-> + parse_pcdata(XMLS); +parse(El_Name, [#xmlText{}|_T] = XMLS, _Rules, _WSa, _S)-> {error, - {text_in_place_of,El_Name}, - {{next,S},{act,[]}}}; -parse([],_,_,_,_) -> - {error,no_rule}; -parse(Rule,[],_,_,_) -> - {error,{no_xml_element,Rule}}. + {text_in_place_of, El_Name}, + {{next, XMLS}, {act, []}}}; +parse([], _, _, _, _) -> + {error, no_rule}; +parse(Rule, [], _, _, _) -> + {error, {no_xml_element, Rule}}. parse_any([],_Rules,_S) -> []; @@ -618,11 +623,15 @@ el_name(#xmlElement{name=Name})-> parse_pcdata([#xmlText{}=H|T])-> parse_pcdata(T,[H]); +parse_pcdata([#xmlComment{}|T])-> + parse_pcdata(T,[]); parse_pcdata(H) -> {[],H}. parse_pcdata([#xmlText{}=H|T],Acc)-> parse_pcdata(T,Acc++[H]); +parse_pcdata([#xmlComment{}|T],Acc)-> + parse_pcdata(T,Acc); parse_pcdata(H,Acc) -> {Acc,H}. diff --git a/lib/xmerl/src/xmerl_xpath.erl b/lib/xmerl/src/xmerl_xpath.erl index db3d3ac2d6..b3301f2faf 100644 --- a/lib/xmerl/src/xmerl_xpath.erl +++ b/lib/xmerl/src/xmerl_xpath.erl @@ -41,18 +41,13 @@ % xmerl_xpath_parse:parse(xmerl_xpath_scan:tokens("parent::processing-instruction('foo')")). %% </pre> %% -%% @type docEntity() = +%% @type nodeEntity() = %% xmlElement() %% | xmlAttribute() %% | xmlText() %% | xmlPI() %% | xmlComment() -%% @type nodeEntity() = -%% xmlElement() -%% | xmlAttribute() -%% | xmlText() -%% | xmlPI() -%% | xmlNamespace() +%% | xmlNsNode() %% | xmlDocument() %% @type option_list(). <p>Options allows to customize the behaviour of the %% XPath scanner. @@ -303,6 +298,17 @@ write_node(#xmlNode{pos = Pos, node = #xmlText{value = Txt, parents = Ps}}) -> {text, Pos, Txt, Ps}; +write_node(#xmlNode{pos = Pos, + node = #xmlComment{parents = Ps}}) -> + {comment, Pos, '', Ps}; +write_node(#xmlNode{pos = Pos, + node = #xmlPI{name = Name, + parents = Ps}}) -> + {processing_instruction, Pos, Name, Ps}; +write_node(#xmlNode{pos = Pos, + node = #xmlNsNode{parents = Ps, + prefix = Prefix}}) -> + {namespace, Pos, Prefix, Ps}; write_node(_) -> other. @@ -330,18 +336,16 @@ eval_path(rel, PathExpr, C = #xmlContext{}) -> Context = C#xmlContext{nodeset = NodeSet}, S = #state{context = Context}, path_expr(PathExpr, S); -eval_path(filter, {PathExpr, PredExpr}, C = #xmlContext{}) -> +eval_path(filter, {PathExpr, {pred, Pred}}, C = #xmlContext{}) -> S = #state{context = C}, - S1 = path_expr(PathExpr, S), - pred_expr(PredExpr, S1). + S1 = match_expr(PathExpr, S), + eval_pred(Pred, S1). -eval_primary_expr(FC = {function_call,_,_},S = #state{context = Context}) -> +eval_primary_expr(PrimExpr, S = #state{context = Context}) -> %% NewNodeSet = xmerl_xpath_pred:eval(FC, Context), - NewNodeSet = xmerl_xpath_lib:eval(primary_expr, FC, Context), + NewNodeSet = xmerl_xpath_lib:eval(primary_expr, PrimExpr, Context), NewContext = Context#xmlContext{nodeset = NewNodeSet}, - S#state{context = NewContext}; -eval_primary_expr(PrimExpr,_S) -> - exit({primary_expression,{not_implemented, PrimExpr}}). + S#state{context = NewContext}. %% axis(Axis,NodeTest,Context::xmlContext()) -> xmlContext() @@ -384,8 +388,8 @@ axis1(preceding, Tok, N, Acc, Context) -> match_preceding(Tok, N, Acc, Context); axis1(attribute, Tok, N, Acc, Context) -> match_attribute(Tok, N, Acc, Context); -%axis1(namespace, Tok, N, Acc, Context) -> -% match_namespace(Tok, N, Acc, Context); +axis1(namespace, Tok, N, Acc, Context) -> + match_namespace(Tok, N, Acc, Context); axis1(ancestor_or_self, Tok, N, Acc, Context) -> match_ancestor_or_self(Tok, N, Acc, Context); axis1(descendant_or_self, Tok, N, Acc, Context) -> @@ -627,14 +631,58 @@ node_type(#xmlAttribute{}) -> attribute; node_type(#xmlElement{}) -> element; node_type(#xmlText{}) -> text; node_type(#xmlPI{}) -> processing_instruction; -node_type(#xmlNamespace{}) -> namespace; +node_type(#xmlNsNode{}) -> namespace; +node_type(#xmlComment{}) -> comment; node_type(#xmlDocument{}) -> root_node. %% "The namespace axis contains the namespace nodes of the context node; %% the axis will be empty unless the context node is an element." -%match_namespace(_Tok, _N, _Acc, _Context) -> - %% TODO: IMPLEMENT NAMESPACE AXIS -% erlang:fault(not_yet_implemented). +match_namespace(Tok, N, Acc, Context) -> + case N#xmlNode.type of + element -> + #xmlNode{parents = Ps, node = E} = N, + #xmlElement{name = Name, + namespace = NS, + parents = EPs, + pos = Pos} = E, + #xmlNamespace{default = Default, nodes = NSPairs} = NS, + ThisEPs = [{Name, Pos}|EPs], + ThisPs = [N|Ps], + Acc0 = + case Default of + D when D =:= []; D =:= '' -> + {[], 1}; + URI -> + DefaultNSNode = #xmlNsNode{parents = ThisEPs, + pos = 1, + prefix = [], + uri = URI}, + Node = #xmlNode{type = namespace, + node = DefaultNSNode, + parents = ThisPs}, + {[Node], 2} + end, + {Nodes, _I} = + lists:foldr( + fun ({Prefix, URI}, {AccX, I}) -> + NSNode = #xmlNsNode{parents = ThisEPs, + pos = I, + prefix = Prefix, + uri = URI}, + ThisN = #xmlNode{pos = I, + type = namespace, + node = NSNode, + parents = ThisPs}, + {[ThisN | AccX], I + 1} + end, Acc0, NSPairs), + lists:foldr( + fun (ThisN, AccX) -> + match_self(Tok, ThisN, AccX, Context) + end, Acc, Nodes); + _Other -> + %%[] + Acc + end. update_nodeset(Context = #xmlContext{axis_type = AxisType}, NodeSet) -> @@ -655,8 +703,15 @@ update_nodeset(Context = #xmlContext{axis_type = AxisType}, NodeSet) -> node_test(F, N, Context) when is_function(F) -> F(N, Context); +node_test(_Test, #xmlNode{type=attribute,node=#xmlAttribute{name=xmlns}}, + _Context) -> + false; +node_test(_Test, + #xmlNode{type=attribute,node=#xmlAttribute{nsinfo={"xmlns",_Local}}}, + _Context) -> + false; node_test({wildcard, _}, #xmlNode{type=ElAt}, _Context) - when ElAt==element; ElAt==attribute -> + when ElAt==element; ElAt==attribute; ElAt==namespace -> true; node_test({prefix_test, Prefix}, #xmlNode{node = N}, _Context) -> case N of @@ -720,6 +775,9 @@ node_test({name, {_Tag, Prefix, Local}}, [{_Tag, Prefix, Local}, write_node(NSNodes)]), false end; +node_test({name, {_Tag, [], Local}}, + #xmlNode{node = #xmlNsNode{prefix = Local}}, _Context) -> + true; node_test({node_type, NT}, #xmlNode{node = N}, _Context) -> case {NT, N} of {text, #xmlText{}} -> @@ -728,14 +786,18 @@ node_test({node_type, NT}, #xmlNode{node = N}, _Context) -> true; {attribute, #xmlAttribute{}} -> true; - {namespace, #xmlNamespace{}} -> + {namespace, #xmlNsNode{}} -> + true; + {comment, #xmlComment{}} -> + true; + {processing_instruction, #xmlPI{}} -> true; _ -> false end; -node_test({processing_instruction, {literal, _, Name}}, - #xmlNode{node = {processing_instruction, Name, _Data}}, _Context) -> - true; +node_test({processing_instruction, Name1}, + #xmlNode{node = #xmlPI{name = Name2}}, _Context) -> + Name1 == atom_to_list(Name2); node_test(_Other, _N, _Context) -> %io:format("node_test(~p, ~p) -> false.~n", [_Other, write_node(_N)]), false. diff --git a/lib/xmerl/src/xmerl_xpath_lib.erl b/lib/xmerl/src/xmerl_xpath_lib.erl index cfd0e36667..096f54ec30 100644 --- a/lib/xmerl/src/xmerl_xpath_lib.erl +++ b/lib/xmerl/src/xmerl_xpath_lib.erl @@ -49,5 +49,7 @@ primary_expr({function_call, F, Args}, C) -> %% here, we should look up the function in the context provided %% by the caller, but we haven't figured this out yet. exit({not_a_core_function, F}) - end. + end; +primary_expr(PrimExpr, _C) -> + exit({primary_expression, {not_implemented, PrimExpr}}). diff --git a/lib/xmerl/src/xmerl_xpath_parse.yrl b/lib/xmerl/src/xmerl_xpath_parse.yrl index 37576b9e61..f60cea0a2e 100644 --- a/lib/xmerl/src/xmerl_xpath_parse.yrl +++ b/lib/xmerl/src/xmerl_xpath_parse.yrl @@ -144,6 +144,7 @@ Expect 2. %% [7] 'NodeTest' -> 'NameTest' : '$1' . 'NodeTest' -> 'node_type' '(' ')' : {node_type, value('$1')} . +'NodeTest' -> 'processing-instruction' '(' ')' : {node_type, value('$1')} . 'NodeTest' -> 'processing-instruction' '(' 'literal' ')' : {processing_instruction, value('$3')} . diff --git a/lib/xmerl/src/xmerl_xpath_pred.erl b/lib/xmerl/src/xmerl_xpath_pred.erl index 451a09bee3..855b8599fe 100644 --- a/lib/xmerl/src/xmerl_xpath_pred.erl +++ b/lib/xmerl/src/xmerl_xpath_pred.erl @@ -337,6 +337,9 @@ local_name1([#xmlNode{type=element,node=El}|_]) -> local_name1([#xmlNode{type=attribute,node=Att}|_]) -> #xmlAttribute{name=Name,nsinfo=NSI} = Att, local_name2(Name,NSI); +local_name1([#xmlNode{type=namespace,node=N}|_]) -> + #xmlNsNode{prefix=Prefix} = N, + ?string(Prefix); local_name1([#xmlElement{name = Name, nsinfo = NSI}|_]) -> local_name2(Name,NSI). local_name2(Name, NSI) -> @@ -431,6 +434,9 @@ string_value(N=#xmlObj{}) -> string_value(A=#xmlNode{type=attribute}) -> #xmlAttribute{value=AttVal}=A#xmlNode.node, ?string(AttVal); +string_value(N=#xmlNode{type=namespace}) -> + #xmlNsNode{uri=URI}=N#xmlNode.node, + ?string(atom_to_list(URI)); string_value(El=#xmlNode{type=element}) -> #xmlElement{content=C} = El#xmlNode.node, TextValue = fun(#xmlText{value=T},_Fun) -> T; @@ -442,6 +448,9 @@ string_value(El=#xmlNode{type=element}) -> string_value(T=#xmlNode{type=text}) -> #xmlText{value=Txt} = T#xmlNode.node, ?string(Txt); +string_value(T=#xmlNode{type=comment}) -> + #xmlComment{value=Txt} = T#xmlNode.node, + ?string(Txt); string_value(infinity) -> ?string("Infinity"); string_value(neg_infinity) -> ?string("-Infinity"); string_value(A) when is_atom(A) -> diff --git a/lib/xmerl/src/xmerl_xsd.erl b/lib/xmerl/src/xmerl_xsd.erl index dfdc6138ef..ed0890f0d0 100644 --- a/lib/xmerl/src/xmerl_xsd.erl +++ b/lib/xmerl/src/xmerl_xsd.erl @@ -245,21 +245,27 @@ process_validate2({SE,_},Schema,Xml,Opts) -> S4 = validation_options(S3,Opts), validate3(Schema,Xml,S4). -validate3(Schema,Xml,S=#xsd_state{errors=[]}) -> - Ret = {_,S2} = - case catch validate_xml(Xml,S) of - {[XML2],[],Sx} -> - {XML2,Sx}; - {XML2,[],Sx} -> - {XML2,Sx}; - {_,UnValidated,Sx} -> - {Xml,acc_errs(Sx,{error_path(UnValidated,Xml#xmlElement.name),?MODULE, - {unvalidated_rest,UnValidated}})}; - _Err = {error,Reason} -> - {Xml,acc_errs(S,Reason)}; - {'EXIT',Reason} -> - {Xml,acc_errs(S,{error_path(Xml,Xml#xmlElement.name),?MODULE, - {undefined,{internal_error,Reason}}})} +validate3(Schema, Xml,S =#xsd_state{errors=[]}) -> + Ret = {_, S2} = + case catch validate_xml(Xml, S) of + _Err = {error, Reason} -> + {Xml, acc_errs(S, Reason)}; + {'EXIT', Reason} -> + {Xml, acc_errs(S, {error_path(Xml, Xml#xmlElement.name), ?MODULE, + {undefined, {internal_error, Reason}}})}; + {XML2, Rest, Sx} -> + case lists:dropwhile(fun(X) when is_record(X, xmlComment) -> true; (_) -> false end, Rest) of + [] -> + case XML2 of + [XML3] -> + {XML3,Sx}; + XML3 -> + {XML3,Sx} + end; + UnValidated -> + {Xml,acc_errs(Sx,{error_path(UnValidated,Xml#xmlElement.name),?MODULE, + {unvalidated_rest,UnValidated}})} + end end, save_to_file(S2,filename:rootname(Schema)++".tab2"), case S2#xsd_state.errors of @@ -1950,7 +1956,7 @@ fetch_external_schema(Path,S) when is_list(Path) -> {EXSD,S#xsd_state{schema_name=File}} end; {_,{string,String},_} -> %% this is for a user defined fetch fun that returns an xml document on string format. - ?debug("scanning string: ~p~n",[File]), + ?debug("scanning string: ~p~n",[String]), case xmerl_scan:string(String,S#xsd_state.xml_options) of {error,Reason} -> {error,acc_errs(S,{[],?MODULE,{parsing_external_schema_failed,Path,Reason}})}; @@ -2520,9 +2526,9 @@ check_element_type([],#schema_complex_type{name=_Name,block=_Bl,content=C}, {error,{error_path(Checked,undefined),?MODULE, {empty_content_not_allowed,C}}} end; -check_element_type(C,{anyType,_},_Env,_Block,S,_Checked) -> +check_element_type(C, {anyType, _}, _Env, _Block, S, _Checked) -> %% permitt anything - {C,[],S}; + {lists:reverse(C), [], S}; check_element_type(XML=[#xmlText{}|_],Type=#schema_simple_type{}, _Env,_Block,S,_Checked) -> @@ -2585,7 +2591,7 @@ check_element_type(XML=[XMLEl=#xmlElement{name=Name}|RestXML], S6 = check_form(ElName,Name,XMLEl, actual_form_value(CMEl#schema_element.form, S5#xsd_state.elementFormDefault), - S5), + S5), %Step into content of XML element. {Content,_,S7} = case @@ -2605,12 +2611,12 @@ check_element_type(XML=[XMLEl=#xmlElement{name=Name}|RestXML], RestXML, set_scope(S5#xsd_state.scope,set_num_el(S7,S6))}; true -> - {error,{error_path(XMLEl,Name),?MODULE, - {element_not_suitable_with_schema,ElName,S}}}; + {error,{error_path(XMLEl, Name), ?MODULE, + {element_not_suitable_with_schema, ElName, S}}}; _ when S#xsd_state.num_el >= Min -> %% it may be a match error or an optional element not %% present - {[],XML,S#xsd_state{num_el=0}}; + {[], XML, S#xsd_state{num_el=0}}; _ -> {error,{error_path(XMLEl,Name),?MODULE, {element_not_suitable_with_schema,ElName,CMName,CMEl,S}}} @@ -2645,7 +2651,7 @@ check_element_type(XML=[#xmlElement{}|_Rest], check_element_type(XML=[E=#xmlElement{name=Name}|Rest], Any={any,{Namespace,_Occ={Min,_},ProcessorContents}},Env, _Block,S,_Checked) -> - ?debug("check any: {any,{~p,~p,~p}}~n",[Namespace,Occ,ProcessorContents]), + ?debug("check any: {any,{~p,~p,~p}}~n",[Namespace,_Occ,ProcessorContents]), %% ProcessorContents any of lax | strict | skip %% lax: may validate if schema is found %% strict: must validate @@ -2710,8 +2716,11 @@ check_element_type([],CM,_Env,_Block,S,Checked) -> {error,{error_path(Checked,undefined),?MODULE, {empty_content_not_allowed,CM}}} end; +check_element_type([C = #xmlComment{} |Rest],CM,Env,Block,S,Checked) -> + check_element_type(Rest,CM,Env,Block,S,[C |Checked]); check_element_type(XML,CM,_Env,_Block,S,_Checked) -> {error,{error_path(XML,undefined),?MODULE,{match_failure,XML,CM,S}}}. + %% single xml content object and single schema object check_text_type(XML=[#xmlText{}|_],optional_text,S) -> % {XMLTxt,optional_text}; @@ -2730,7 +2739,7 @@ check_text_type([XMLTxt=#xmlText{}|_],CMEl,_S) -> {cannot_contain_text,XMLTxt,CMEl}}}. split_xmlText(XML) -> - splitwith(fun(#xmlText{}) -> true;(_) -> false end,XML). + splitwith(fun(#xmlText{}) -> true;(#xmlComment{}) -> true;(_) -> false end,XML). %% Sequence check_sequence([T=#xmlText{}|Rest],Els,Occ,Env,S,Checked) -> @@ -2773,6 +2782,8 @@ check_sequence(Seq=[_InstEl=#xmlElement{}|_],[El|Els],Occ={_Min,_Max},Env,S,Chec count_num_el(set_num_el(S3,S2)), Ret++Checked) end; +check_sequence([C = #xmlComment{} |Rest], Els, Occ, Env, S, Checked) -> + check_sequence(Rest,Els,Occ,Env,S,[C |Checked]); check_sequence(Rest,[],_Occ,_Env,S,Checked) -> {Checked,Rest,set_num_el(S,0)}; check_sequence([],Els,_Occ,_Env,S,Checked) -> @@ -2869,6 +2880,8 @@ check_all(XML=[E=#xmlElement{name=Name}|RestXML],CM,Occ,Env,S, {element_not_in_all,ElName,E,CM}}, check_all(RestXML,CM,Occ,Env,acc_errs(S,Err),[E|Checked],PrevXML) end; +check_all([C=#xmlComment{} |RestXML], CM, Occ, Env, S, Checked, XML) -> + check_all(RestXML, CM, Occ, Env, S, [C |Checked], XML); check_all(XML,[],_,_,S,Checked,_) -> {Checked,XML,S}; check_all([],CM,_Occ,_,S,Checked,_PrevXML) -> @@ -2920,7 +2933,7 @@ check_target_namespace(XMLEl,S) -> schemaLocations(El=#xmlElement{attributes=Atts},S) -> Pred = fun(#xmlAttribute{name=schemaLocation}) -> false; - (#xmlAttribute{namespace={_,"schemaLocation"}}) -> false; + (#xmlAttribute{nsinfo={_,"schemaLocation"}}) -> false; (_) -> true end, case lists:dropwhile(Pred,Atts) of diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl index 94c38d4d48..55b6d1844c 100644 --- a/lib/xmerl/test/xmerl_SUITE.erl +++ b/lib/xmerl/test/xmerl_SUITE.erl @@ -58,7 +58,7 @@ groups() -> {ticket_tests, [], [ticket_5998, ticket_7211, ticket_7214, ticket_7430, ticket_6873, ticket_7496, ticket_8156, ticket_8697, - ticket_9411, ticket_9457]}, + ticket_9411, ticket_9457, ticket_9664_schema, ticket_9664_dtd]}, {app_test, [], [{xmerl_app_test, all}]}, {appup_test, [], [{xmerl_appup_test, all}]}]. @@ -284,7 +284,7 @@ export(Config) -> ?line {E,_} = xmerl_scan:file(TestFile), ?line Exported = xmerl:export([E],xmerl_xml,[{prolog,Prolog}]), B = list_to_binary(Exported++"\n"), - ?line {ok,B} = file:read_file(TestFile), + ?line {ok, B} = file:read_file(TestFile), ok. %%---------------------------------------------------------------------- @@ -609,6 +609,38 @@ ticket_9457_cont(Continue, Exception, GlobalState) -> Exception(GlobalState) end. + +ticket_9664_schema(suite) -> []; +ticket_9664_schema(doc) -> + ["Test that comments are handled correct whith"]; +ticket_9664_schema(Config) -> + + ?line {E, _} = xmerl_scan:file(filename:join([?config(data_dir, Config), misc, + "ticket_9664_schema.xml"]),[]), + ?line {ok, S} = xmerl_xsd:process_schema(filename:join([?config(data_dir, Config), misc, + "motorcycles.xsd"])), + ?line {E1, _} = xmerl_xsd:validate(E, S), + + ?line {E1,_} = xmerl_xsd:process_validate(filename:join([?config(data_dir,Config), misc, + "motorcycles.xsd"]),E,[]), + + ?line {E1,_} = xmerl_scan:file(filename:join([?config(data_dir,Config), misc, + "ticket_9664_schema.xml"]), + [{schemaLocation, [{"mc", "motorcycles.xsd"}]}, + {validation, schema}]), + ok. + +ticket_9664_dtd(suite) -> []; +ticket_9664_dtd(doc) -> + ["Test that comments are handled correct whith"]; +ticket_9664_dtd(Config) -> + ?line {E, _} = xmerl_scan:file(filename:join([?config(data_dir, Config), misc, + "ticket_9664_dtd.xml"]),[]), + ?line {E, _} = xmerl_scan:file(filename:join([?config(data_dir, Config), misc, + "ticket_9664_dtd.xml"]),[{validation, true}]), + ok. + + %%====================================================================== %% Support Functions %%====================================================================== diff --git a/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz b/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz Binary files differindex fef7431845..ffc1d327a5 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz +++ b/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl index 850b7f8135..7b6f1e95b3 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl +++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl @@ -210,7 +210,7 @@ ticket_7496() -> ?line {Doc3,_} = xmerl_scan:file("documentRoot.xml"), ?line ok = Test(Doc3,"//child",[child,child,child]), ?line ok = Test(Doc3,"//child[@name='beta']",[child]), - ?line [{xmlAttribute,id,[],[],[],[],1,[],"2",false}] = + ?line [{xmlAttribute,id,[],[],[],_,1,[],"2",false}] = xmerl_xpath:string("/documentRoot/parent/child[@name='beta']/@id",Doc3), ?line ok = Test(Doc3,"/documentRoot/parent/child|/documentRoot/parent/pet", [child,child,child,pet,pet]), diff --git a/lib/xmerl/test/xmerl_test_lib.erl b/lib/xmerl/test/xmerl_test_lib.erl index a83956c076..e82ad283b2 100644 --- a/lib/xmerl/test/xmerl_test_lib.erl +++ b/lib/xmerl/test/xmerl_test_lib.erl @@ -87,6 +87,6 @@ keysearch_delete(Key,N,List) -> %% the original data directory. get_data_dir(Config) -> - Data0 = ?config(data_dir, Config), - {ok,Data,_} = regexp:sub(Data0, "xmerl_sax_std_SUITE", "xmerl_std_SUITE"), - Data. + Data = ?config(data_dir, Config), + Opts = [{return,list}], + re:replace(Data, "xmerl_sax_std_SUITE", "xmerl_std_SUITE", Opts). diff --git a/lib/xmerl/test/xmerl_xsd_SUITE_data/mim.xsd b/lib/xmerl/test/xmerl_xsd_SUITE_data/mim.xsd index 057344cde8..057344cde8 100755..100644 --- a/lib/xmerl/test/xmerl_xsd_SUITE_data/mim.xsd +++ b/lib/xmerl/test/xmerl_xsd_SUITE_data/mim.xsd diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk index 82df8fdeef..de47e3418b 100644 --- a/lib/xmerl/vsn.mk +++ b/lib/xmerl/vsn.mk @@ -1 +1 @@ -XMERL_VSN = 1.2.10 +XMERL_VSN = 1.3 diff --git a/lib/xmerl/xmerl.pub b/lib/xmerl/xmerl.pub index 29a81bbde2..29a81bbde2 100755..100644 --- a/lib/xmerl/xmerl.pub +++ b/lib/xmerl/xmerl.pub |
