diff options
74 files changed, 1720 insertions, 1011 deletions
diff --git a/erts/configure.in b/erts/configure.in index 2b1aedc992..8c6f2ac076 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1788,6 +1788,9 @@ AC_CHECK_FUNCS([fdatasync]) dnl Find which C libraries are required to use fdatasync AC_SEARCH_LIBS(fdatasync, [rt]) +AC_CHECK_HEADERS(net/if_dl.h ifaddrs.h) +AC_CHECK_FUNCS([getifaddrs]) + dnl ---------------------------------------------------------------------- dnl Checks for features/quirks in the system that affects Erlang. dnl ---------------------------------------------------------------------- @@ -2673,7 +2676,7 @@ static __inline__ int check_fpe(double f) * Implement SIGFPE handler based on CPU/OS combination */ -#if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__i386__) || defined(__x86_64__))) || (defined(__OpenBSD__) && defined(__x86_64__)) || (defined(__sun__) && defined(__x86_64__)) +#if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__i386__) || defined(__x86_64__))) || ((defined(__OpenBSD__) || defined(__NetBSD__)) && defined(__x86_64__)) || (defined(__sun__) && defined(__x86_64__)) #if defined(__linux__) && defined(__i386__) #if !defined(X86_FXSR_MAGIC) @@ -2787,6 +2790,11 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc) struct fxsave64 *fxsave = uc->sc_fpstate; fxsave->fx_mxcsr = 0x1F80; fxsave->fx_fsw &= ~0xFF; +#elif defined(__NetBSD__) && defined(__x86_64__) + mcontext_t *mc = &uc->uc_mcontext; + struct fxsave64 *fxsave = (struct fxsave64 *)&mc->__fpregs; + fxsave->fx_mxcsr = 0x1F80; + fxsave->fx_fsw &= ~0xFF; #elif defined(__sun__) && defined(__x86_64__) mcontext_t *mc = &uc->uc_mcontext; struct fpchip_state *fpstate = &mc->fpregs.fp_reg_set.fpchip_state; diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index f477280a6f..e36d0adb0d 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -831,14 +831,28 @@ <p>For more information, see <seealso marker="erlang#system_flag_cpu_topology">erlang:system_flag(cpu_topology, CpuTopology)</seealso>.</p> </item> + <tag><marker id="+swt"><c>+swt very_low|low|medium|high|very_high</c></marker></tag> + <item> + <p>Set scheduler wakeup threshold. Default is <c>medium</c>. + The threshold determines when to wake up sleeping schedulers + when more work than can be handled by currently awake schedulers + exist. A low threshold will cause earlier wakeups, and a high + threshold will cause later wakeups. Early wakeups will + distribute work over multiple schedulers faster, but work will + more easily bounce between schedulers. + </p> + <p><em>NOTE:</em> This flag may be removed or changed at any time + without prior notice. + </p> + </item> + <tag><marker id="sched_thread_stack_size"><c><![CDATA[+sss size]]></c></marker></tag> + <item> + <p>Suggested stack size, in kilowords, for scheduler threads. + Valid range is 4-8192 kilowords. The default stack size + is OS dependent.</p> + </item> </taglist> </item> - <tag><marker id="sched_thread_stack_size"><c><![CDATA[+sss size]]></c></marker></tag> - <item> - <p>Suggested stack size, in kilowords, for scheduler threads. - Valid range is 4-8192 kilowords. The default stack size - is OS dependent.</p> - </item> <tag><marker id="+t"><c><![CDATA[+t size]]></c></marker></tag> <item> <p>Set the maximum number of atoms the VM can handle. Default is 1048576.</p> diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 8e4d8130f5..27887cbdf6 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -4,7 +4,7 @@ <cref> <header> <copyright> - <year>2001</year><year>2009</year> + <year>2001</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -1130,7 +1130,7 @@ typedef enum { </funcs> <section> <title>SEE ALSO</title> - <p><seealso marker="erlang#load_nif-2">load_nif(3)</seealso></p> + <p><seealso marker="erlang#load_nif-2">erlang:load_nif/2</seealso></p> </section> </cref> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 1eec45e0f3..ba93fe34d3 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -147,7 +147,7 @@ iolist() = [char() | binary() | iolist()] <c>Tuple1</c>, and contains the elements in <c>Tuple1</c> followed by <c>Term</c> as the last element. Semantically equivalent to - <c>list_to_tuple(tuple_to_list(Tuple ++ [Term])</c>, but much + <c>list_to_tuple(tuple_to_list(Tuple) ++ [Term])</c>, but much faster.</p> <pre> > <input>erlang:append_element({one, two}, three).</input> @@ -2034,16 +2034,18 @@ os_prompt%</pre> <v>Text = string()</v> </type> <desc> - <warning> - <p>This BIF is still an experimental feature. The interface - may be changed in any way in future releases.</p><p>In - R13B03 the return value on failure was + <note> + <p>In releases older than OTP R14B, NIFs were an + experimental feature. Versions of OTP older than R14B might + have different and possibly incompatible NIF semantics and + interfaces. For example, in R13B03 the return value on + failure was <c>{error,Reason,Text}</c>.</p> - </warning> + </note> <p>Loads and links a dynamic library containing native implemented functions (NIFs) for a module. <c>Path</c> is a file path to the sharable object/dynamic library file minus - the OS-dependant file extension (.so for Unix and .ddl for + the OS-dependent file extension (.so for Unix and .dll for Windows). See <seealso marker="erl_nif">erl_nif</seealso> on how to implement a NIF library.</p> <p><c>LoadInfo</c> can be any term. It will be passed on to @@ -5456,6 +5458,16 @@ true</pre> <seealso marker="#system_info_allocator_tuple">erlang:system_info({allocator, Alloc})</seealso>. </p> </item> + <tag><c>build_type</c></tag> + <item> + <p>Returns an atom describing the build type of the runtime + system. This is normally the atom <c>opt</c> for optimized. + Other possible return values are <c>debug</c>, <c>purify</c>, + <c>quantify</c>, <c>purecov</c>, <c>gcov</c>, <c>valgrind</c>, + <c>gprof</c>, and <c>lcnt</c>. Possible return values + may be added and/or removed at any time without prior notice. + </p> + </item> <tag><c>c_compiler_used</c></tag> <item> <p>Returns a two-tuple describing the C compiler used when diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index ed0d1b3fa6..903abe6f5c 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -74,7 +74,7 @@ else ifeq ($(TYPE),gcov) PURIFY = TYPEMARKER = .gcov -TYPE_FLAGS = @DEBUG_CFLAGS@ -DNO_JUMP_TABLE -fprofile-arcs -ftest-coverage -O0 -DERTS_CAN_INLINE=0 -DERTS_INLINE= +TYPE_FLAGS = @DEBUG_CFLAGS@ -DERTS_GCOV -DNO_JUMP_TABLE -fprofile-arcs -ftest-coverage -O0 -DERTS_CAN_INLINE=0 -DERTS_INLINE= ifneq ($(findstring solaris,$(TARGET)),solaris) LIBS += -lgcov endif diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 0815cdbc7f..327620772f 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -119,6 +119,7 @@ atom bsl atom bsr atom bsr_anycrlf atom bsr_unicode +atom build_type atom busy_dist_port atom busy_port atom call @@ -378,6 +379,7 @@ atom old_heap_size atom on_load atom open atom open_error +atom opt atom or atom ordered_set atom orelse diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index dace5b9297..40d8dc097c 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -1955,6 +1955,35 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) : am_enabled); } #endif + } else if (BIF_ARG_1 == am_build_type) { +#if defined(DEBUG) + ERTS_DECL_AM(debug); + BIF_RET(AM_debug); +#elif defined(PURIFY) + ERTS_DECL_AM(purify); + BIF_RET(AM_purify); +#elif defined(QUANTIFY) + ERTS_DECL_AM(quantify); + BIF_RET(AM_quantify); +#elif defined(PURECOV) + ERTS_DECL_AM(purecov); + BIF_RET(AM_purecov); +#elif defined(ERTS_GCOV) + ERTS_DECL_AM(gcov); + BIF_RET(AM_gcov); +#elif defined(VALGRIND) + ERTS_DECL_AM(valgrind); + BIF_RET(AM_valgrind); +#elif defined(GPROF) + ERTS_DECL_AM(gprof); + BIF_RET(AM_gprof); +#elif defined(ERTS_ENABLE_LOCK_COUNT) + ERTS_DECL_AM(lcnt); + BIF_RET(AM_lcnt); +#else + BIF_RET(am_opt); +#endif + BIF_RET(res); } else if (BIF_ARG_1 == am_allocated_areas) { res = erts_allocated_areas(NULL, NULL, BIF_P); BIF_RET(res); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 14bd10b42c..4ae656a3ad 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -512,6 +512,8 @@ void erts_usage(void) erts_fprintf(stderr, " u|ns|ts|ps|s|nnts|nnps|tnnps|db\n"); erts_fprintf(stderr, "-sct cput set cpu topology,\n"); erts_fprintf(stderr, " see the erl(1) documentation for more info.\n"); + erts_fprintf(stderr, "-swt val set scheduler wakeup threshold, valid values are:\n"); + erts_fprintf(stderr, " very_low|low|medium|high|very_high.\n"); erts_fprintf(stderr, "-sss size suggested stack size in kilo words for scheduler threads,\n"); erts_fprintf(stderr, " valid range is [%d-%d]\n", ERTS_SCHED_THREAD_MIN_STACK_SIZE, @@ -1176,10 +1178,20 @@ erl_start(int argc, char **argv) } else if (sys_strcmp("mrq", sub_param) == 0) use_multi_run_queue = 1; - else if (sys_strcmp("srq", sub_param) == 0) - use_multi_run_queue = 0; else if (sys_strcmp("nsp", sub_param) == 0) erts_use_sender_punish = 0; + else if (sys_strcmp("srq", sub_param) == 0) + use_multi_run_queue = 0; + else if (sys_strcmp("wt", sub_param) == 0) { + arg = get_arg(sub_param+2, argv[i+1], &i); + if (erts_sched_set_wakeup_limit(arg) != 0) { + erts_fprintf(stderr, "scheduler wakeup threshold: %s\n", + arg); + erts_usage(); + } + VERBOSE(DEBUG_SYSTEM, + ("scheduler wakup threshold: %s\n", arg)); + } else if (has_prefix("ss", sub_param)) { /* suggested stack size (Kilo Words) for scheduler threads */ arg = get_arg(sub_param+2, argv[i+1], &i); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 2609457415..901167a315 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -54,7 +54,12 @@ (ERTS_SCHED_SYS_SLEEP_SPINCOUNT*ERTS_SCHED_TSE_SLEEP_SPINCOUNT_FACT) #define ERTS_SCHED_SUSPEND_SLEEP_SPINCOUNT 0 -#define ERTS_WAKEUP_OTHER_LIMIT (100*CONTEXT_REDS/2) +#define ERTS_WAKEUP_OTHER_LIMIT_VERY_HIGH (200*CONTEXT_REDS) +#define ERTS_WAKEUP_OTHER_LIMIT_HIGH (50*CONTEXT_REDS) +#define ERTS_WAKEUP_OTHER_LIMIT_MEDIUM (10*CONTEXT_REDS) +#define ERTS_WAKEUP_OTHER_LIMIT_LOW (CONTEXT_REDS) +#define ERTS_WAKEUP_OTHER_LIMIT_VERY_LOW (CONTEXT_REDS/10) + #define ERTS_WAKEUP_OTHER_DEC 10 #define ERTS_WAKEUP_OTHER_FIXED_INC (CONTEXT_REDS/10) @@ -112,6 +117,8 @@ Uint erts_no_schedulers; Uint erts_max_processes = ERTS_DEFAULT_MAX_PROCESSES; Uint erts_process_tab_index_mask; +static int wakeup_other_limit; + #ifdef ERTS_SMP Uint erts_max_main_threads; #endif @@ -2373,7 +2380,27 @@ void erts_early_init_scheduling(void) { early_cpu_bind_init(); + wakeup_other_limit = ERTS_WAKEUP_OTHER_LIMIT_MEDIUM; +} + +int +erts_sched_set_wakeup_limit(char *str) +{ + if (sys_strcmp(str, "very_high") == 0) + wakeup_other_limit = ERTS_WAKEUP_OTHER_LIMIT_VERY_HIGH; + else if (sys_strcmp(str, "high") == 0) + wakeup_other_limit = ERTS_WAKEUP_OTHER_LIMIT_HIGH; + else if (sys_strcmp(str, "medium") == 0) + wakeup_other_limit = ERTS_WAKEUP_OTHER_LIMIT_MEDIUM; + else if (sys_strcmp(str, "low") == 0) + wakeup_other_limit = ERTS_WAKEUP_OTHER_LIMIT_LOW; + else if (sys_strcmp(str, "very_low") == 0) + wakeup_other_limit = ERTS_WAKEUP_OTHER_LIMIT_VERY_LOW; + else + return EINVAL; + return 0; } + void erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) @@ -7169,7 +7196,7 @@ Process *schedule(Process *p, int calls) if (rq->wakeup_other < 0) rq->wakeup_other = 0; } - else if (rq->wakeup_other < ERTS_WAKEUP_OTHER_LIMIT) + else if (rq->wakeup_other < wakeup_other_limit) rq->wakeup_other += rq->len*wo_reds + ERTS_WAKEUP_OTHER_FIXED_INC; else { if (erts_common_run_queue) { diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index e49710a7ed..4365e409e5 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1038,6 +1038,8 @@ ErtsProcList *erts_proclist_create(Process *); void erts_proclist_destroy(ErtsProcList *); int erts_proclist_same(ErtsProcList *, Process *); +int erts_sched_set_wakeup_limit(char *str); + #ifdef DEBUG void erts_dbg_multi_scheduling_return_trap(Process *, Eterm); #endif diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 79e58beb40..3f761eeb19 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -48,6 +48,12 @@ #include <sys/uio.h> #endif +#ifdef HAVE_NET_IF_DL_H +#include <net/if_dl.h> +#endif +#ifdef HAVE_IFADDRS_H +#include <ifaddrs.h> +#endif /* All platforms fail on malloc errors. */ #define FATAL_MALLOC @@ -3905,7 +3911,7 @@ static int inet_ctl_ifget(inet_descriptor* desc, char* buf, int len, INTERFACE_INFO* ifp; long namaddr; - if ((len == 0) || ((namlen = buf[0]) > len)) + if ((len == 0) || ((namlen = get_int8(buf)) > len)) goto error; if (parse_addr(buf+1, namlen, &namaddr) < 0) goto error; @@ -4089,6 +4095,10 @@ static int inet_ctl_getiflist(inet_descriptor* desc, char** rbuf, int rsize) } +/* FIXME: temporary hack */ +#ifndef IFHWADDRLEN +#define IFHWADDRLEN 6 +#endif static int inet_ctl_ifget(inet_descriptor* desc, char* buf, int len, char** rbuf, int rsize) @@ -4099,11 +4109,11 @@ static int inet_ctl_ifget(inet_descriptor* desc, char* buf, int len, struct ifreq ifreq; int namlen; - if ((len == 0) || ((namlen = buf[0]) > len)) + if ((len == 0) || ((namlen = get_int8(buf)) > len)) goto error; sys_memset(ifreq.ifr_name, '\0', IFNAMSIZ); sys_memcpy(ifreq.ifr_name, buf+1, - (namlen > IFNAMSIZ) ? IFNAMSIZ : namlen); + (namlen >= IFNAMSIZ) ? IFNAMSIZ-1 : namlen); buf += (namlen+1); len -= (namlen+1); sptr = sbuf; @@ -4128,6 +4138,32 @@ static int inet_ctl_ifget(inet_descriptor* desc, char* buf, int len, /* raw memcpy (fix include autoconf later) */ sys_memcpy(sptr, (char*)(&ifreq.ifr_hwaddr.sa_data), IFHWADDRLEN); sptr += IFHWADDRLEN; +#elif defined(HAVE_GETIFADDRS) + struct ifaddrs *ifa, *ifp; + int found = 0; + + if (getifaddrs(&ifa) == -1) + goto error; + + for (ifp = ifa; ifp; ifp = ifp->ifa_next) { + if ((ifp->ifa_addr->sa_family == AF_LINK) && + (sys_strcmp(ifp->ifa_name, ifreq.ifr_name) == 0)) { + found = 1; + break; + } + } + + if (found == 0) { + freeifaddrs(ifa); + break; + } + + buf_check(sptr, s_end, 1+IFHWADDRLEN); + *sptr++ = INET_IFOPT_HWADDR; + sys_memcpy(sptr, ((struct sockaddr_dl *)ifp->ifa_addr)->sdl_data + + ((struct sockaddr_dl *)ifp->ifa_addr)->sdl_nlen, IFHWADDRLEN); + freeifaddrs(ifa); + sptr += IFHWADDRLEN; #endif break; } @@ -4240,10 +4276,6 @@ static int inet_ctl_ifget(inet_descriptor* desc, char* buf, int len, return ctl_error(EINVAL, rbuf, rsize); } -/* FIXME: temporary hack */ -#ifndef IFHWADDRLEN -#define IFHWADDRLEN 6 -#endif static int inet_ctl_ifset(inet_descriptor* desc, char* buf, int len, char** rbuf, int rsize) @@ -4252,11 +4284,11 @@ static int inet_ctl_ifset(inet_descriptor* desc, char* buf, int len, int namlen; char* b_end = buf + len; - if ((len == 0) || ((namlen = buf[0]) > len)) + if ((len == 0) || ((namlen = get_int8(buf)) > len)) goto error; sys_memset(ifreq.ifr_name, '\0', IFNAMSIZ); sys_memcpy(ifreq.ifr_name, buf+1, - (namlen > IFNAMSIZ) ? IFNAMSIZ : namlen); + (namlen >= IFNAMSIZ) ? IFNAMSIZ-1 : namlen); buf += (namlen+1); len -= (namlen+1); @@ -6851,13 +6883,13 @@ static int inet_ctl(inet_descriptor* desc, int cmd, char* buf, int len, if (len < 2) return ctl_error(EINVAL, rbuf, rsize); - n = buf[0]; buf++; len--; + n = get_int8(buf); buf++; len--; if (n >= len) /* the = sign makes the test inklude next length byte */ return ctl_error(EINVAL, rbuf, rsize); memcpy(namebuf, buf, n); namebuf[n] = '\0'; len -= n; buf += n; - n = buf[0]; buf++; len--; + n = get_int8(buf); buf++; len--; if (n > len) return ctl_error(EINVAL, rbuf, rsize); memcpy(protobuf, buf, n); @@ -6880,7 +6912,7 @@ static int inet_ctl(inet_descriptor* desc, int cmd, char* buf, int len, port = get_int16(buf); port = sock_htons(port); buf += 2; - n = buf[0]; buf++; len -= 3; + n = get_int8(buf); buf++; len -= 3; if (n > len) return ctl_error(EINVAL, rbuf, rsize); memcpy(protobuf, buf, n); diff --git a/erts/emulator/hipe/hipe_amd64_glue.S b/erts/emulator/hipe/hipe_amd64_glue.S index 83b7b0397b..ede762aae0 100644 --- a/erts/emulator/hipe/hipe_amd64_glue.S +++ b/erts/emulator/hipe/hipe_amd64_glue.S @@ -346,6 +346,8 @@ nbif_3_gc_after_bif: subq $(16-8), %rsp movq P, %rdi movq %rax, %rsi + xorl %edx, %edx # Pass NULL in regs + xorl %ecx, %ecx # Pass 0 in arity call CSYM(erts_gc_after_bif_call) addq $(16-8), %rsp movl $0, P_NARITY(P) # Note: narity is a 32-bit field diff --git a/erts/emulator/hipe/hipe_arm_glue.S b/erts/emulator/hipe/hipe_arm_glue.S index 5d626a5f69..2bce01954e 100644 --- a/erts/emulator/hipe/hipe_arm_glue.S +++ b/erts/emulator/hipe/hipe_arm_glue.S @@ -311,6 +311,8 @@ nbif_3_gc_after_bif: str TEMP_LR, [P, #P_NRA] str NSP, [P, #P_NSP] mov TEMP_LR, lr + mov r3, #0 /* Pass 0 in arity */ + mov r2, #0 /* Pass NULL in regs */ mov r1, r0 mov r0, P bl erts_gc_after_bif_call diff --git a/erts/emulator/hipe/hipe_ppc_glue.S b/erts/emulator/hipe/hipe_ppc_glue.S index 97b07353f9..0651963294 100644 --- a/erts/emulator/hipe/hipe_ppc_glue.S +++ b/erts/emulator/hipe/hipe_ppc_glue.S @@ -476,6 +476,8 @@ CSYM(nbif_3_gc_after_bif): STORE TEMP_LR, P_NRA(P) STORE NSP, P_NSP(P) mflr TEMP_LR + li r6, 0 /* Pass 0 in arity */ + li r5, 0 /* Pass NULL in regs */ mr r4, r3 mr r3, P bl CSYM(erts_gc_after_bif_call) diff --git a/erts/emulator/hipe/hipe_sparc_glue.S b/erts/emulator/hipe/hipe_sparc_glue.S index d1af5c43f5..73cefd4896 100644 --- a/erts/emulator/hipe/hipe_sparc_glue.S +++ b/erts/emulator/hipe/hipe_sparc_glue.S @@ -333,6 +333,8 @@ nbif_3_gc_after_bif: st TEMP_RA, [P+P_NRA] st NSP, [P+P_NSP] mov RA, TEMP_RA + mov 0, %o3 /* Pass 0 in arity */ + mov 0, %o2 /* Pass NULL in regs */ mov %o0, %o1 call erts_gc_after_bif_call mov P, %o0 /* delay slot */ diff --git a/erts/emulator/hipe/hipe_x86_glue.S b/erts/emulator/hipe/hipe_x86_glue.S index 2f7dff39f5..43392111fe 100644 --- a/erts/emulator/hipe/hipe_x86_glue.S +++ b/erts/emulator/hipe/hipe_x86_glue.S @@ -320,11 +320,13 @@ nbif_3_gc_after_bif: .align 4 .gc_after_bif: movl %edx, P_NARITY(P) - subl $(16-4), %esp + subl $(32-4), %esp movl P, (%esp) movl %eax, 4(%esp) + movl $0, 8(%esp) # Pass NULL in regs + movl $0, 12(%esp) # Pass 0 in arity call CSYM(erts_gc_after_bif_call) - addl $(16-4), %esp + addl $(32-4), %esp movl $0, P_NARITY(P) ret diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c index a4fff4ce31..0c61e7bf96 100644 --- a/erts/emulator/hipe/hipe_x86_signal.c +++ b/erts/emulator/hipe/hipe_x86_signal.c @@ -195,7 +195,7 @@ static void do_init(void) #define INIT() do { if (!init_done()) do_init(); } while (0) #endif /* __DARWIN__ */ -#if !defined(__GLIBC__) && !defined(__DARWIN__) +#if !defined(__GLIBC__) && !defined(__DARWIN__) && !defined(__NetBSD__) /* * Assume Solaris/x86 2.8. * There is a number of sigaction() procedures in libc: @@ -231,6 +231,7 @@ static void do_init(void) #define INIT() do { if (!init_done()) do_init(); } while (0) #endif /* not glibc or darwin */ +#if !defined(__NetBSD__) /* * This is our wrapper for sigaction(). sigaction() can be called before * hipe_signal_init() has been executed, especially when threads support @@ -253,7 +254,7 @@ static int my_sigaction(int signum, const struct sigaction *act, struct sigactio } return __next_sigaction(signum, act, oldact); } - +#endif /* * This overrides the C library's core sigaction() procedure, catching * all its internal calls. @@ -268,7 +269,7 @@ int __SIGACTION(int signum, const struct sigaction *act, struct sigaction *oldac /* * This catches the application's own sigaction() calls. */ -#if !defined(__DARWIN__) +#if !defined(__DARWIN__) && !defined(__NetBSD__) int sigaction(int signum, const struct sigaction *act, struct sigaction *oldact) { return my_sigaction(signum, act, oldact); @@ -326,7 +327,9 @@ void hipe_signal_init(void) struct sigaction sa; int i; +#ifndef __NetBSD__ INIT(); +#endif hipe_sigaltstack_init(); diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index 1c4c37b01a..b1ee165489 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -382,6 +382,14 @@ mseg_recreate(void *old_seg, Uint old_size, Uint new_size) new_seg = (void *) pmremap((void *) old_seg, (size_t) old_size, (size_t) new_size); +#elif defined(__NetBSD__) + new_seg = (void *) mremap((void *) old_seg, + (size_t) old_size, + NULL, + (size_t) new_size, + 0); + if (new_seg == (void *) MAP_FAILED) + new_seg = NULL; #else new_seg = (void *) mremap((void *) old_seg, (size_t) old_size, diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c index 5a682ab045..6e9376b0f3 100644 --- a/erts/emulator/sys/unix/sys_float.c +++ b/erts/emulator/sys/unix/sys_float.c @@ -476,7 +476,7 @@ static int mask_fpe(void) #endif -#if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__x86_64__) || defined(__i386__))) || (defined(__OpenBSD__) && defined(__x86_64__)) || (defined(__sun__) && defined(__x86_64__)) +#if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__x86_64__) || defined(__i386__))) || ((defined(__NetBSD__) || defined(__OpenBSD__)) && defined(__x86_64__)) || (defined(__sun__) && defined(__x86_64__)) #if defined(__linux__) && defined(__i386__) #if !defined(X86_FXSR_MAGIC) @@ -519,6 +519,10 @@ static int mask_fpe(void) #define mc_pc(mc) ((mc)->mc_rip) #elif defined(__FreeBSD__) && defined(__i386__) #define mc_pc(mc) ((mc)->mc_eip) +#elif defined(__NetBSD__) && defined(__x86_64__) +#define mc_pc(mc) ((mc)->__gregs[_REG_RIP]) +#elif defined(__NetBSD__) && defined(__i386__) +#define mc_pc(mc) ((mc)->__gregs[_REG_EIP]) #elif defined(__OpenBSD__) && defined(__x86_64__) #define mc_pc(mc) ((mc)->sc_rip) #elif defined(__sun__) && defined(__x86_64__) @@ -610,6 +614,23 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc) struct env87 *env87 = &savefpu->sv_87.sv_env; env87->en_sw &= ~0xFF; } +#elif defined(__NetBSD__) && defined(__x86_64__) + mcontext_t *mc = &uc->uc_mcontext; + struct fxsave64 *fxsave = (struct fxsave64 *)&mc->__fpregs; + pc = mc_pc(mc); + fxsave->fx_mxcsr = 0x1F80; + fxsave->fx_fsw &= ~0xFF; +#elif defined(__NetBSD__) && defined(__i386__) + mcontext_t *mc = &uc->uc_mcontext; + pc = mc_pc(mc); + if (uc->uc_flags & _UC_FXSAVE) { + struct envxmm *envxmm = (struct envxmm *)&mc->__fpregs; + envxmm->en_mxcsr = 0x1F80; + envxmm->en_sw &= ~0xFF; + } else { + struct env87 *env87 = (struct env87 *)&mc->__fpregs; + env87->en_sw &= ~0xFF; + } #elif defined(__OpenBSD__) && defined(__x86_64__) struct fxsave64 *fxsave = uc->sc_fpstate; pc = mc_pc(uc); diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 5384a32f21..8489124966 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1029,8 +1029,11 @@ static ERL_NIF_TERM make_term_list0(struct make_term_info* mti, int n) static ERL_NIF_TERM make_term_resource(struct make_term_info* mti, int n) { void* resource = enif_alloc_resource(mti->resource_type, 10); + ERL_NIF_TERM term; fill(resource, 10, n); - return enif_make_resource(mti->dst_env, resource); + term = enif_make_resource(mti->dst_env, resource); + enif_release_resource(resource); + return term; } static ERL_NIF_TERM make_term_new_binary(struct make_term_info* mti, int n) { diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 76ce0a7e3c..c1fc2aebee 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -120,6 +120,7 @@ static char *plusM_other_switches[] = { static char *pluss_val_switches[] = { "bt", "ct", + "wt", "ss", NULL }; diff --git a/lib/asn1/c_src/asn1_erl_driver.c b/lib/asn1/c_src/asn1_erl_driver.c index fd284e5800..9dd3a0fd7d 100644 --- a/lib/asn1/c_src/asn1_erl_driver.c +++ b/lib/asn1/c_src/asn1_erl_driver.c @@ -1407,7 +1407,6 @@ int decode_partial(ErlDrvBinary **drv_binary,unsigned char *in_buf, int in_buf_l int msg_index_val; int *msg_index, *tag_index, tmp_index; int tag_seq_length; - char tag_code; /* one of ASN1_SKIPPED, ASN1_OPTIONAL, ASN1_CHOOSEN */ int wanted_tag, next_tag; int buf_end_index = in_buf_len; int ret = 0, length, old_index; @@ -1600,7 +1599,7 @@ int get_value(char *out_buf, { int len, lenoflen, indef=0, skip_len; int ret=0; - int start_index, out_index = 0; + int start_index; /* printf("get_value 1\n\r"); */ if (in_buf[*msg_index] < 0x80){ /* short definite length */ diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index ae681a4a78..968468cb7f 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -1674,7 +1674,7 @@ create_pdec_inc_command(ModName, % [concat_sequential(lists:reverse(Comms), % [LastComm,CompAcc])|Acc] case lists:reverse(TagCommand) of - [Atom|Comms]�when is_atom(Atom) -> + [Atom|Comms] when is_atom(Atom) -> [concat_sequential(lists:reverse(Comms), [Atom,CompAcc])|Acc]; [[Command2,Tag2]|Comms] -> diff --git a/lib/asn1/test/test_compile_options.erl b/lib/asn1/test/test_compile_options.erl index 83f38c5e6d..5e027cdedb 100644 --- a/lib/asn1/test/test_compile_options.erl +++ b/lib/asn1/test/test_compile_options.erl @@ -132,7 +132,7 @@ verbose(Config) when is_list(Config) -> ?line ok = asn1ct:compile(Asn1File, [{i,DataDir},{outdir,OutDir},noobj,verbose]), ?line test_server:capture_stop(), ?line [Line0|_] = test_server:capture_get(), - ?line lists:prefix("Erlang ASN.1 version", Line0), + ?line true = lists:prefix("Erlang ASN.1 version", Line0), %% Test non-verbose compile ?line test_server:capture_start(), diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index f8ae7202e6..3684ff462f 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -384,11 +384,14 @@ maybe_log_timestamp() -> [{"<i>~s</i>",[log_timestamp({MS,S,US})]}]}) end. -log_timestamp(Now) -> - put(log_timestamp,Now), - {_,{H,M,S}} = calendar:now_to_local_time(Now), - lists:flatten(io_lib:format("~2.2.0w:~2.2.0w:~2.2.0w", - [H,M,S])). +log_timestamp({MS,S,US}) -> + put(log_timestamp, {MS,S,US}), + {{Year,Month,Day}, {Hour,Min,Sec}} = + calendar:now_to_local_time({MS,S,US}), + MilliSec = trunc(US/1000), + lists:flatten(io_lib:format("~4.10.0B-~2.10.0B-~2.10.0B " + "~2.10.0B:~2.10.0B:~2.10.0B.~3.10.0B", + [Year,Month,Day,Hour,Min,Sec,MilliSec])). %%%----------------------------------------------------------------- %%% The logger server diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index 3fb0d627a0..e3dc78ed75 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -92,7 +92,7 @@ release_spec: opt release_tests_spec: $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(ERL_FILES) $(COVERFILE) $(RELSYSDIR) - $(INSTALL_PROGRAM) common_test.spec $(RELSYSDIR) + $(INSTALL_DATA) common_test.spec $(RELSYSDIR) chmod -f -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in index e728db18eb..040adcfd09 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -68,13 +68,13 @@ RELSYSDIR = $(RELEASE_PATH)/lib/crypto-$(VSN) # ---------------------------------------------------- # Misc Macros # ---------------------------------------------------- -OBJS = $(OBJDIR)/crypto.o +OBJS = $(OBJDIR)/crypto$(TYPEMARKER).o NIF_MAKEFILE = $(PRIVDIR)/Makefile ifeq ($(findstring win32,$(TARGET)), win32) -NIF_LIB = $(LIBDIR)/crypto.dll +NIF_LIB = $(LIBDIR)/crypto$(TYPEMARKER).dll else -NIF_LIB = $(LIBDIR)/crypto.so +NIF_LIB = $(LIBDIR)/crypto$(TYPEMARKER).so endif ifeq ($(HOST_OS),) @@ -102,20 +102,30 @@ $(OBJDIR): $(LIBDIR): -@mkdir -p $(LIBDIR) -$(OBJDIR)/%.o: %.c +$(OBJDIR)/%$(TYPEMARKER).o: %.c $(INSTALL_DIR) $(OBJDIR) $(CC) -c -o $@ $(ALL_CFLAGS) $< -$(LIBDIR)/crypto.so: $(OBJS) +$(LIBDIR)/crypto$(TYPEMARKER).so: $(OBJS) $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $^ $(LDLIBS) $(CRYPTO_LINK_LIB) -$(LIBDIR)/crypto.dll: $(OBJS) +$(LIBDIR)/crypto$(TYPEMARKER).dll: $(OBJS) $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) $(OBJS) -llibeay32 clean: - rm -f $(NIF_LIB) $(OBJS) +ifeq ($(findstring win32,$(TARGET)), win32) + rm -f $(LIBDIR)/crypto.dll + rm -f $(LIBDIR)/crypto.debug.dll +else + rm -f $(LIBDIR)/crypto.so + rm -f $(LIBDIR)/crypto.debug.so + rm -f $(LIBDIR)/crypto.valgrind.so +endif + rm -f $(OBJDIR)/crypto.o + rm -f $(OBJDIR)/crypto.debug.o + rm -f $(OBJDIR)/crypto.valgrind.o rm -f core *~ docs: diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 8823bba3b6..85614a84c2 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -64,8 +64,8 @@ # define ERL_VALGRIND_ASSERT_MEM_DEFINED(ptr,size) \ ((void) ((VALGRIND_CHECK_MEM_IS_DEFINED(ptr,size) == 0) ? 1 : \ - (fprintf(stderr,"\r\n####### VALGRIND_ASSSERT(%p,%d) failed at %s:%d\r\n",\ - (ptr),(size), __FILE__, __LINE__), abort(), 0))) + (fprintf(stderr,"\r\n####### VALGRIND_ASSSERT(%p,%ld) failed at %s:%d\r\n",\ + (ptr),(long)(size), __FILE__, __LINE__), abort(), 0))) #else # define ERL_VALGRIND_MAKE_MEM_DEFINED(ptr,size) # define ERL_VALGRIND_ASSERT_MEM_DEFINED(ptr,size) @@ -706,12 +706,13 @@ static int get_bn_from_mpint(ErlNifEnv* env, ERL_NIF_TERM term, BIGNUM** bnp) static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Lo,Hi) */ - BIGNUM *bn_from, *bn_to, *bn_rand; + BIGNUM *bn_from = NULL, *bn_to, *bn_rand; unsigned char* data; unsigned dlen; ERL_NIF_TERM ret; if (!get_bn_from_mpint(env, argv[0], &bn_from) || !get_bn_from_mpint(env, argv[1], &bn_rand)) { + if (bn_from) BN_free(bn_from); return enif_make_badarg(env); } @@ -770,7 +771,7 @@ static int inspect_mpint(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifBinary* bin) static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (DigestType,Data,Signature,Key=[P, Q, G, Y]) */ ErlNifBinary data_bin, sign_bin; - BIGNUM *dsa_p, *dsa_q, *dsa_g, *dsa_y; + BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL, *dsa_y = NULL; unsigned char hmacbuf[SHA_DIGEST_LENGTH]; ERL_NIF_TERM head, tail; DSA *dsa; @@ -786,6 +787,11 @@ static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv || !enif_get_list_cell(env, tail, &head, &tail) || !get_bn_from_mpint(env, head, &dsa_y) || !enif_is_empty_list(env,tail)) { + badarg: + if (dsa_p) BN_free(dsa_p); + if (dsa_q) BN_free(dsa_q); + if (dsa_g) BN_free(dsa_g); + if (dsa_y) BN_free(dsa_y); return enif_make_badarg(env); } if (argv[0] == atom_sha && inspect_mpint(env, argv[1], &data_bin)) { @@ -796,7 +802,7 @@ static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv memcpy(hmacbuf, data_bin.data, SHA_DIGEST_LENGTH); } else { - return enif_make_badarg(env); + goto badarg; } dsa = DSA_new(); @@ -1119,7 +1125,7 @@ static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TER enif_alloc_binary(RSA_size(rsa), &ret_bin); if (argv[3] == atom_true) { - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf+i,data_len); + ERL_VALGRIND_ASSERT_MEM_DEFINED(data_bin.data,data_bin.size); i = RSA_public_encrypt(data_bin.size, data_bin.data, ret_bin.data, rsa, padding); if (i > 0) { @@ -1139,6 +1145,7 @@ static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TER return enif_make_binary(env,&ret_bin); } else { + enif_release_binary(&ret_bin); return atom_error; } } @@ -1167,7 +1174,7 @@ static ERL_NIF_TERM rsa_private_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TE enif_alloc_binary(RSA_size(rsa), &ret_bin); if (argv[3] == atom_true) { - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf+i,data_len); + ERL_VALGRIND_ASSERT_MEM_DEFINED(data_bin.data,data_bin.size); i = RSA_private_encrypt(data_bin.size, data_bin.data, ret_bin.data, rsa, padding); if (i > 0) { @@ -1187,6 +1194,7 @@ static ERL_NIF_TERM rsa_private_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TE return enif_make_binary(env,&ret_bin); } else { + enif_release_binary(&ret_bin); return atom_error; } } @@ -1266,7 +1274,7 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ || !enif_get_list_cell(env, tail, &head, &tail) || !get_bn_from_mpint(env, head, &dh_params->g) || !enif_is_empty_list(env, tail)) { - + DH_free(dh_params); return enif_make_badarg(env); } @@ -1293,7 +1301,7 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (OthersPublicKey, MyPrivateKey, DHParams=[P,G]) */ DH* dh_params = DH_new(); - BIGNUM* pubkey; + BIGNUM* pubkey = NULL; int i; ErlNifBinary ret_bin; ERL_NIF_TERM ret, head, tail; @@ -1321,6 +1329,7 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T ret = atom_error; } } + if (pubkey) BN_free(pubkey); DH_free(dh_params); return ret; } diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 19fa495b7d..71fd91cafd 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -93,22 +93,42 @@ -define(CRYPTO_NIF_VSN,101). on_load() -> - LibName = "crypto", + LibBaseName = "crypto", PrivDir = code:priv_dir(crypto), - Lib1 = filename:join([PrivDir, "lib", LibName]), - Status = case erlang:load_nif(Lib1, ?CRYPTO_NIF_VSN) of + 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, ?CRYPTO_NIF_VSN) of ok -> ok; {error, {load_failed, _}}=Error1 -> - LibDir2 = + ArchLibDir = filename:join([PrivDir, "lib", erlang:system_info(system_architecture)]), Candidate = - filelib:wildcard(filename:join([LibDir2,LibName ++ "*" ])), + filelib:wildcard(filename:join([ArchLibDir,LibName ++ "*" ])), case Candidate of [] -> Error1; _ -> - Lib2 = filename:join([LibDir2, LibName]), - erlang:load_nif(Lib2, ?CRYPTO_NIF_VSN) + ArchLib = filename:join([ArchLibDir, LibName]), + erlang:load_nif(ArchLib, ?CRYPTO_NIF_VSN) end; Error1 -> Error1 end, @@ -119,7 +139,6 @@ on_load() -> "OpenSSL might not be installed on this system.~n",[E,Str]), Status end. - nif_stub_error(Line) -> erlang:nif_error({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/lib/erl_interface/doc/src/ei_connect.xml b/lib/erl_interface/doc/src/ei_connect.xml index 927395d1bf..36dfb149cc 100644 --- a/lib/erl_interface/doc/src/ei_connect.xml +++ b/lib/erl_interface/doc/src/ei_connect.xml @@ -116,7 +116,7 @@ int n = 0; struct in_addr addr; ei_cnode ec; -addr = inet_addr("150.236.14.75"); +addr.s_addr = inet_addr("150.236.14.75"); if (ei_connect_xinit(&ec, "chivas", "madonna", @@ -132,7 +132,7 @@ if (ei_connect_xinit(&ec, </p> <code type="none"><![CDATA[ if (ei_connect_init(&ec, "madonna", "cookie...", n++) < 0) { - fprintf("ERROR when initializing: %d",erl_errno); + fprintf(stderr,"ERROR when initializing: %d",erl_errno); exit(-1); } ]]></code> @@ -177,7 +177,7 @@ int fd = ei_connect(&ec, NODE); /*** Variant 2 ***/ struct in_addr addr; -addr = inet_addr(IP_ADDR); +addr.s_addr = inet_addr(IP_ADDR); fd = ei_xconnect(&ec, &addr, ALIVE); ]]></code> </desc> diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index b1b79aa0e5..e191f3fbf0 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -502,10 +502,14 @@ int ei_connect_init(ei_cnode* ec, const char* this_node_name, return ERL_ERROR; } - if (this_node_name == NULL) + if (this_node_name == NULL) { sprintf(thisalivename, "c%d", (int) getpid()); - else + } else if (strlen(this_node_name) >= sizeof(thisalivename)) { + EI_TRACE_ERR0("ei_connect_init","ERROR: this_node_name too long"); + return ERL_ERROR; + } else { strcpy(thisalivename, this_node_name); + } if ((hp = ei_gethostbyname(thishostname)) == 0) { /* Looking up IP given hostname fails. We must be on a standalone diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c index 42aeab22b1..24a030c468 100644 --- a/lib/erl_interface/src/connect/ei_resolve.c +++ b/lib/erl_interface/src/connect/ei_resolve.c @@ -601,7 +601,7 @@ struct hostent *ei_gethostbyaddr_r(const char *addr, #ifndef HAVE_GETHOSTBYNAME_R return my_gethostbyaddr_r(addr,length,type,hostp,buffer,buflen,h_errnop); #else -#if (defined(__GLIBC__) || (__FreeBSD_version >= 602000)) +#if (defined(__GLIBC__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__)) struct hostent *result; gethostbyaddr_r(addr, length, type, hostp, buffer, buflen, &result, @@ -628,7 +628,7 @@ struct hostent *ei_gethostbyname_r(const char *name, #ifndef HAVE_GETHOSTBYNAME_R return my_gethostbyname_r(name,hostp,buffer,buflen,h_errnop); #else -#if (defined(__GLIBC__) || (__FreeBSD_version >= 602000)) +#if (defined(__GLIBC__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__)) struct hostent *result; gethostbyname_r(name, hostp, buffer, buflen, &result, h_errnop); diff --git a/lib/erl_interface/src/epmd/epmd_port.c b/lib/erl_interface/src/epmd/epmd_port.c index 663b38d2d4..cf6122fafa 100644 --- a/lib/erl_interface/src/epmd/epmd_port.c +++ b/lib/erl_interface/src/epmd/epmd_port.c @@ -106,6 +106,12 @@ static int ei_epmd_r3_port (struct in_addr *addr, const char *alive, char ntoabuf[32]; #endif + if (len > sizeof(buf) - 3) + { + erl_errno = ERANGE; + return -1; + } + put16be(s,len); put8(s,EI_EPMD_PORT_REQ); strcpy(s,alive); @@ -164,6 +170,12 @@ static int ei_epmd_r4_port (struct in_addr *addr, const char *alive, #if defined(VXWORKS) char ntoabuf[32]; #endif + + if (len > sizeof(buf) - 3) + { + erl_errno = ERANGE; + return -1; + } put16be(s,len); put8(s,EI_EPMD_PORT2_REQ); diff --git a/lib/erl_interface/src/prog/erl_call.c b/lib/erl_interface/src/prog/erl_call.c index 93b84cbb36..448de9aa23 100644 --- a/lib/erl_interface/src/prog/erl_call.c +++ b/lib/erl_interface/src/prog/erl_call.c @@ -123,6 +123,10 @@ static int do_connect(ei_cnode *ec, char *nodename, struct call_flags *flags); static int read_stdin(char **buf); static void split_apply_string(char *str, char **mod, char **fun, char **args); +static void* ei_chk_malloc(size_t size); +static void* ei_chk_calloc(size_t nmemb, size_t size); +static void* ei_chk_realloc(void *old, size_t size); +static char* ei_chk_strdup(char *s); /*************************************************************************** @@ -132,7 +136,6 @@ static void split_apply_string(char *str, char **mod, ***************************************************************************/ /* FIXME isn't VxWorks to handle arguments differently? */ -/* FIXME check errors from malloc */ #if !defined(VXWORKS) int main(int argc, char *argv[]) @@ -165,8 +168,7 @@ int erl_call(int argc, char **argv) usage_arg(progname, "-sname "); } - flags.node = (char *) malloc(strlen(argv[i+1]) + 1); - strcpy(flags.node, argv[i+1]); + flags.node = ei_chk_strdup(argv[i+1]); i++; flags.use_long_name = 0; } else if (strcmp(argv[i], "-name") == 0) { /* -name NAME */ @@ -174,8 +176,7 @@ int erl_call(int argc, char **argv) usage_arg(progname, "-name "); } - flags.node = (char *) malloc(strlen(argv[i+1]) + 1); - strcpy(flags.node, argv[i+1]); + flags.node = ei_chk_strdup(argv[i+1]); i++; flags.use_long_name = 1; } else { @@ -210,16 +211,14 @@ int erl_call(int argc, char **argv) usage_arg(progname, "-c "); } flags.cookiep = 1; - flags.cookie = (char *) malloc(strlen(argv[i+1]) + 1); - strcpy(flags.cookie, argv[i+1]); + flags.cookie = ei_chk_strdup(argv[i+1]); i++; break; case 'n': if (i+1 >= argc) { usage_arg(progname, "-n "); } - flags.node = (char *) malloc(strlen(argv[i+1]) + 1); - strcpy(flags.node, argv[i+1]); + flags.node = ei_chk_strdup(argv[i+1]); flags.use_long_name = 1; i++; break; @@ -227,24 +226,21 @@ int erl_call(int argc, char **argv) if (i+1 >= argc) { usage_arg(progname, "-h "); } - flags.hidden = (char *) malloc(strlen(argv[i+1]) + 1); - strcpy(flags.hidden, argv[i+1]); + flags.hidden = ei_chk_strdup(argv[i+1]); i++; break; case 'x': if (i+1 >= argc) { usage_arg(progname, "-x "); } - flags.script = (char *) malloc(strlen(argv[i+1]) + 1); - strcpy(flags.script, argv[i+1]); + flags.script = ei_chk_strdup(argv[i+1]); i++; break; case 'a': if (i+1 >= argc) { usage_arg(progname, "-a "); } - flags.apply = (char *) malloc(strlen(argv[i+1]) + 1); - strcpy(flags.apply, argv[i+1]); + flags.apply = ei_chk_strdup(argv[i+1]); i++; break; case '?': @@ -304,8 +300,7 @@ int erl_call(int argc, char **argv) if (flags.hidden == NULL) { /* As default we are c17@gethostname */ i = flags.randomp ? (time(NULL) % 997) : 17; - /* FIXME allocates to small !!! */ - flags.hidden = (char *) malloc(3 + 2 ); /* c17 or cXYZ */ + flags.hidden = (char *) ei_chk_malloc(10 + 2 ); /* c17 or cXYZ */ #if defined(VXWORKS) sprintf(flags.hidden, "c%d", i < 0 ? (int) taskIdSelf() : i); @@ -330,17 +325,25 @@ int erl_call(int argc, char **argv) initWinSock(); #endif - gethostname(h_hostname, EI_MAXHOSTNAMELEN); + if (gethostname(h_hostname, EI_MAXHOSTNAMELEN) < 0) { + fprintf(stderr,"erl_call: failed to get host name: %d\n", errno); + exit(1); + } if ((hp = ei_gethostbyname(h_hostname)) == 0) { fprintf(stderr,"erl_call: can't resolve hostname %s\n", h_hostname); exit(1); } - /* If shortnames cut of the name at first '.' */ + /* If shortnames, cut off the name at first '.' */ if (flags.use_long_name == 0 && (ct = strchr(hp->h_name, '.')) != NULL) { *ct = '\0'; } - strcpy(h_hostname, hp->h_name); + strncpy(h_hostname, hp->h_name, EI_MAXHOSTNAMELEN); + h_hostname[EI_MAXHOSTNAMELEN] = '\0'; memcpy(&h_ipadr.s_addr, *hp->h_addr_list, sizeof(struct in_addr)); + if (strlen(h_alivename) + strlen(h_hostname) + 2 > sizeof(h_nodename)) { + fprintf(stderr,"erl_call: hostname too long: %s\n", h_hostname); + exit(1); + } sprintf(h_nodename, "%s@%s", h_alivename, h_hostname); if (ei_connect_xinit(&ec, h_hostname, h_alivename, h_nodename, @@ -368,11 +371,16 @@ int erl_call(int argc, char **argv) fprintf(stderr,"erl_call: can't get_hostent(%s)\n", host); exit(1); } - /* If shortnames cut of the name at first '.' */ + /* If shortnames, cut off the name at first '.' */ if (flags.use_long_name == 0 && (ct = strchr(hp->h_name, '.')) != NULL) { *ct = '\0'; } - strcpy(host_name, hp->h_name); + strncpy(host_name, hp->h_name, EI_MAXHOSTNAMELEN); + host_name[EI_MAXHOSTNAMELEN] = '\0'; + if (strlen(flags.node) + strlen(host_name) + 2 > sizeof(nodename)) { + fprintf(stderr,"erl_call: nodename too long: %s\n", flags.node); + exit(1); + } sprintf(nodename, "%s@%s", flags.node, host_name); /* @@ -401,7 +409,7 @@ int erl_call(int argc, char **argv) ei_encode_empty_list(NULL, &i); - p = (char *)malloc(i); + p = (char *)ei_chk_malloc(i); i = 0; /* Reset */ ei_encode_empty_list(p, &i); @@ -426,6 +434,10 @@ int erl_call(int argc, char **argv) if (flags.modp && (modname != NULL)) { char fname[256]; + if (strlen(modname) + 4 + 1 > sizeof(fname)) { + fprintf(stderr,"erl_call: module name too long: %s\n", modname); + exit(1); + } strcpy(fname, modname); strcat(fname, ".erl"); @@ -443,7 +455,7 @@ int erl_call(int argc, char **argv) ei_encode_binary(NULL, &i, module, modsize); ei_encode_empty_list(NULL, &i); - p = (char *)malloc(i); + p = (char *)ei_chk_malloc(i); i = 0; /* Reset */ ei_encode_list_header(p, &i, 2); @@ -476,7 +488,7 @@ int erl_call(int argc, char **argv) ei_encode_empty_list(NULL, &i); ei_encode_empty_list(NULL, &i); - p = (char *)malloc(i); + p = (char *)ei_chk_malloc(i); i = 0; /* Reset */ ei_encode_list_header(p, &i, 2); @@ -521,7 +533,7 @@ int erl_call(int argc, char **argv) ei_encode_binary(NULL, &i, evalbuf, len); ei_encode_empty_list(NULL, &i); - p = (char *)malloc(i); + p = (char *)ei_chk_malloc(i); i = 0; /* Reset */ ei_encode_list_header(p, &i, 1); @@ -719,32 +731,28 @@ static void split_apply_string(char *str, EAT(str); len = str-begin; - *mod = (char *) calloc(len + 1, sizeof(char)); + *mod = (char *) ei_chk_calloc(len + 1, sizeof(char)); memcpy(*mod, begin, len); SKIP_SPACE(str); if (*str == '\0') { - *fun = (char *) calloc(strlen(start)+1, sizeof(char)); - strcpy(*fun, start); - *args = (char *) calloc(strlen(empty_list)+1, sizeof(char)); - strcpy(*args, empty_list); + *fun = ei_chk_strdup(start); + *args = ei_chk_strdup(empty_list); return; } begin = str; EAT(str); len = str-begin; - *fun = (char *) calloc(len + 1, sizeof(char)); + *fun = (char *) ei_chk_calloc(len + 1, sizeof(char)); memcpy(*fun, begin, len); SKIP_SPACE(str); if (*str == '\0') { - *args = (char *) calloc(strlen(empty_list)+1, sizeof(char)); - strcpy(*args, empty_list); + *args = ei_chk_strdup(empty_list); return; } - *args = (char *) calloc(strlen(str) + 1, sizeof(char)); - strcpy(*args, str); + *args = ei_chk_strdup(str); return; @@ -760,7 +768,7 @@ static int read_stdin(char **buf) int bsize = BUFSIZ; int len = 0; int i; - char *tmp = (char *) malloc(bsize); + char *tmp = (char *) ei_chk_malloc(bsize); while (1) { if ((i = read(0, &tmp[len], bsize-len)) < 0) { @@ -772,7 +780,7 @@ static int read_stdin(char **buf) len += i; if ((len+50) > bsize) { bsize = len * 2; - tmp = (char *) realloc(tmp, bsize); + tmp = (char *) ei_chk_realloc(tmp, bsize); } else { continue; } @@ -809,7 +817,7 @@ static int get_module(char **mbuf, char **mname) } } /* while */ i = tmp - start; - *mname = (char *) calloc(i+1, sizeof(char)); + *mname = (char *) ei_chk_calloc(i+1, sizeof(char)); memcpy(*mname, start, i); } if (*mbuf) @@ -905,3 +913,51 @@ static void initWinSock(void) } } #endif + + +/*************************************************************************** + * + * Utility functions + * + ***************************************************************************/ + +static void* ei_chk_malloc(size_t size) +{ + void *p = malloc(size); + if (p == NULL) { + fprintf(stderr,"erl_call: insufficient memory\n"); + exit(1); + } + return p; +} + +static void* ei_chk_calloc(size_t nmemb, size_t size) +{ + void *p = calloc(nmemb, size); + if (p == NULL) { + fprintf(stderr,"erl_call: insufficient memory\n"); + exit(1); + } + return p; +} + +static void* ei_chk_realloc(void *old, size_t size) +{ + void *p = realloc(old, size); + if (!p) { + fprintf(stderr, "erl_call: cannot reallocate %u bytes of memory from %p\n", + (unsigned) size, old); + exit (1); + } + return p; +} + +static char* ei_chk_strdup(char *s) +{ + char *p = strdup(s); + if (p == NULL) { + fprintf(stderr,"erl_call: insufficient memory\n"); + exit(1); + } + return p; +} diff --git a/lib/et/test/Makefile b/lib/et/test/Makefile index 9aedf96ce9..7227ae8fd8 100644 --- a/lib/et/test/Makefile +++ b/lib/et/test/Makefile @@ -72,7 +72,8 @@ release_spec: opt release_tests_spec: opt $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) et.spec $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR) - $(INSTALL_PROGRAM) ett $(INSTALL_PROGS) $(RELSYSDIR) + $(INSTALL_SCRIPT) ett $(RELSYSDIR) + $(INSTALL_DATA) $(INSTALL_PROGS) $(RELSYSDIR) # chmod -f -R u+w $(RELSYSDIR) # @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl index a1542ab507..cccfa75005 100644 --- a/lib/kernel/src/gen_sctp.erl +++ b/lib/kernel/src/gen_sctp.erl @@ -39,7 +39,7 @@ open() -> open([]). open(Opts) when is_list(Opts) -> - Mod = mod(Opts), + Mod = mod(Opts, undefined), case Mod:open(Opts) of {error,badarg} -> erlang:error(badarg, [Opts]); @@ -234,17 +234,27 @@ controlling_process(S, Pid) -> %% Utilites %% -%% Get the SCTP moudule -mod() -> inet_db:sctp_module(). +%% Get the SCTP module, but IPv6 address overrides default IPv4 +mod(Address) -> + case inet_db:sctp_module() of + inet_sctp when tuple_size(Address) =:= 8 -> + inet6_sctp; + Mod -> + Mod + end. %% Get the SCTP module, but option sctp_module|inet|inet6 overrides -mod([{sctp_module,Mod}|_]) -> +mod([{sctp_module,Mod}|_], _Address) -> Mod; -mod([inet|_]) -> +mod([inet|_], _Address) -> inet_sctp; -mod([inet6|_]) -> +mod([inet6|_], _Address) -> inet6_sctp; -mod([_|Opts]) -> - mod(Opts); -mod([]) -> - mod(). +mod([{ip, Address}|Opts], _) -> + mod(Opts, Address); +mod([{ifaddr, Address}|Opts], _) -> + mod(Opts, Address); +mod([_|Opts], Address) -> + mod(Opts, Address); +mod([], Address) -> + mod(Address). diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl index 7401b06a64..16a87d71b6 100644 --- a/lib/kernel/src/gen_tcp.erl +++ b/lib/kernel/src/gen_tcp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -46,7 +46,7 @@ connect(Address, Port, Opts, Time) -> end. connect1(Address,Port,Opts,Timer) -> - Mod = mod(Opts), + Mod = mod(Opts, Address), case Mod:getaddrs(Address,Timer) of {ok,IPs} -> case Mod:getserv(Port) of @@ -73,7 +73,7 @@ try_connect([], _Port, _Opts, _Timer, _Mod, Err) -> %% Listen on a tcp port %% listen(Port, Opts) -> - Mod = mod(Opts), + Mod = mod(Opts, undefined), case Mod:getserv(Port) of {ok,TP} -> Mod:listen(TP, Opts); @@ -173,20 +173,30 @@ controlling_process(S, NewOwner) -> %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - Mod = mod(Opts), + Mod = mod(Opts, undefined), Mod:fdopen(Fd, Opts). -%% Get the tcp_module -mod() -> inet_db:tcp_module(). +%% Get the tcp_module, but IPv6 address overrides default IPv4 +mod(Address) -> + case inet_db:tcp_module() of + inet_tcp when tuple_size(Address) =:= 8 -> + inet6_tcp; + Mod -> + Mod + end. %% Get the tcp_module, but option tcp_module|inet|inet6 overrides -mod([{tcp_module,Mod}|_]) -> +mod([{tcp_module,Mod}|_], _Address) -> Mod; -mod([inet|_]) -> +mod([inet|_], _Address) -> inet_tcp; -mod([inet6|_]) -> +mod([inet6|_], _Address) -> inet6_tcp; -mod([_|Opts]) -> - mod(Opts); -mod([]) -> - mod(). +mod([{ip, Address}|Opts], _) -> + mod(Opts, Address); +mod([{ifaddr, Address}|Opts], _) -> + mod(Opts, Address); +mod([_|Opts], Address) -> + mod(Opts, Address); +mod([], Address) -> + mod(Address). diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl index 6bded4bda6..99020c7b6c 100644 --- a/lib/kernel/src/gen_udp.erl +++ b/lib/kernel/src/gen_udp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -29,7 +29,7 @@ open(Port) -> open(Port, []). open(Port, Opts) -> - Mod = mod(Opts), + Mod = mod(Opts, undefined), {ok,UP} = Mod:getserv(Port), Mod:open(UP, Opts). @@ -97,21 +97,31 @@ controlling_process(S, NewOwner) -> %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - Mod = mod(), + Mod = mod(Opts, undefined), Mod:fdopen(Fd, Opts). -%% Get the udp_module -mod() -> inet_db:udp_module(). +%% Get the udp_module, but IPv6 address overrides default IPv4 +mod(Address) -> + case inet_db:udp_module() of + inet_udp when tuple_size(Address) =:= 8 -> + inet6_udp; + Mod -> + Mod + end. %% Get the udp_module, but option udp_module|inet|inet6 overrides -mod([{udp_module,Mod}|_]) -> +mod([{udp_module,Mod}|_], _Address) -> Mod; -mod([inet|_]) -> +mod([inet|_], _Address) -> inet_udp; -mod([inet6|_]) -> +mod([inet6|_], _Address) -> inet6_udp; -mod([_|Opts]) -> - mod(Opts); -mod([]) -> - mod(). +mod([{ip, Address}|Opts], _) -> + mod(Opts, Address); +mod([{ifaddr, Address}|Opts], _) -> + mod(Opts, Address); +mod([_|Opts], Address) -> + mod(Opts, Address); +mod([], Address) -> + mod(Address). diff --git a/lib/kernel/test/gen_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl index eb06d4324b..9aa94a0868 100644 --- a/lib/kernel/test/gen_sctp_SUITE.erl +++ b/lib/kernel/test/gen_sctp_SUITE.erl @@ -27,12 +27,12 @@ -export( [basic/1, api_open_close/1,api_listen/1,api_connect_init/1,api_opts/1, - xfer_min/1,xfer_active/1,def_sndrcvinfo/1]). + xfer_min/1,xfer_active/1,def_sndrcvinfo/1,implicit_inet6/1]). all(suite) -> [basic, api_open_close,api_listen,api_connect_init,api_opts, - xfer_min,xfer_active,def_sndrcvinfo]. + xfer_min,xfer_active,def_sndrcvinfo,implicit_inet6]. init_per_testcase(_Func, Config) -> Dog = test_server:timetrap(test_server:seconds(15)), @@ -551,3 +551,58 @@ api_opts(Config) when is_list(Config) -> {{error,einval},{unix,sunos}} -> ok end. + +implicit_inet6(Config) when is_list(Config) -> + ?line Hostname = ok(inet:gethostname()), + ?line + case gen_sctp:open(0, [inet6]) of + {ok,S1} -> + ?line + case inet:getaddr(Hostname, inet6) of + {ok,Host} -> + ?line Loopback = {0,0,0,0,0,0,0,1}, + ?line io:format("~s ~p~n", ["Loopback",Loopback]), + ?line implicit_inet6(S1, Loopback), + ?line ok = gen_sctp:close(S1), + %% + ?line Localhost = + ok(inet:getaddr("localhost", inet6)), + ?line io:format("~s ~p~n", ["localhost",Localhost]), + ?line S2 = + ok(gen_sctp:open(0, [{ip,Localhost}])), + ?line implicit_inet6(S2, Localhost), + ?line ok = gen_sctp:close(S2), + %% + ?line io:format("~s ~p~n", [Hostname,Host]), + ?line S3 = + ok(gen_sctp:open(0, [{ifaddr,Host}])), + ?line implicit_inet6(S3, Host), + ?line ok = gen_sctp:close(S1); + {error,eafnosupport} -> + ?line ok = gen_sctp:close(S1), + {skip,"Can not look up IPv6 address"} + end; + _ -> + {skip,"IPv6 not supported"} + end. + +implicit_inet6(S1, Addr) -> + ?line ok = gen_sctp:listen(S1, true), + ?line P1 = ok(inet:port(S1)), + ?line S2 = ok(gen_sctp:open(0, [inet6])), + ?line P2 = ok(inet:port(S2)), + ?line #sctp_assoc_change{state=comm_up} = + ok(gen_sctp:connect(S2, Addr, P1, [])), + ?line case ok(gen_sctp:recv(S1)) of + {Addr,P2,[],#sctp_assoc_change{state=comm_up}} -> + ok + end, + ?line case ok(inet:sockname(S1)) of + {Addr,P1} -> ok; + {{0,0,0,0,0,0,0,0},P1} -> ok + end, + ?line case ok(inet:sockname(S2)) of + {Addr,P2} -> ok; + {{0,0,0,0,0,0,0,0},P2} -> ok + end, + ?line ok = gen_sctp:close(S2). diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl index 11d19aaa82..94637290a1 100644 --- a/lib/kernel/test/gen_tcp_api_SUITE.erl +++ b/lib/kernel/test/gen_tcp_api_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-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 @@ -30,10 +30,11 @@ t_connect/1, t_connect_bad/1, t_recv/1, t_recv_timeout/1, t_recv_eof/1, t_shutdown_write/1, t_shutdown_both/1, t_shutdown_error/1, - t_fdopen/1]). + t_fdopen/1, t_implicit_inet6/1]). all(suite) -> [t_accept, t_connect, t_recv, t_shutdown_write, - t_shutdown_both, t_shutdown_error, t_fdopen]. + t_shutdown_both, t_shutdown_error, t_fdopen, + t_implicit_inet6]. init_per_testcase(_Func, Config) -> Dog = test_server:timetrap(test_server:seconds(60)), @@ -156,6 +157,54 @@ t_fdopen(Config) when is_list(Config) -> ok. +%%% implicit inet6 option to api functions + +t_implicit_inet6(Config) when is_list(Config) -> + ?line Hostname = ok(inet:gethostname()), + ?line + case gen_tcp:listen(0, [inet6]) of + {ok,S1} -> + ?line + case inet:getaddr(Hostname, inet6) of + {ok,Host} -> + ?line Loopback = {0,0,0,0,0,0,0,1}, + ?line io:format("~s ~p~n", ["Loopback",Loopback]), + ?line implicit_inet6(S1, Loopback), + ?line ok = gen_tcp:close(S1), + %% + ?line Localhost = + ok(inet:getaddr("localhost", inet6)), + ?line io:format("~s ~p~n", ["localhost",Localhost]), + ?line S2 = ok(gen_tcp:listen(0, [{ip,Localhost}])), + ?line implicit_inet6(S2, Localhost), + ?line ok = gen_tcp:close(S2), + %% + ?line io:format("~s ~p~n", [Hostname,Host]), + ?line S3 = ok(gen_tcp:listen(0, [{ifaddr,Host}])), + ?line implicit_inet6(S3, Host), + ?line ok = gen_tcp:close(S1); + {error,eafnosupport} -> + ?line ok = gen_tcp:close(S1), + {skip,"Can not look up IPv6 address"} + end; + _ -> + {skip,"IPv6 not supported"} + end. + +implicit_inet6(S, Addr) -> + ?line P = ok(inet:port(S)), + ?line S2 = ok(gen_tcp:connect(Addr, P, [])), + ?line P2 = ok(inet:port(S2)), + ?line S1 = ok(gen_tcp:accept(S)), + ?line P1 = P = ok(inet:port(S1)), + ?line {Addr,P2} = ok(inet:peername(S1)), + ?line {Addr,P1} = ok(inet:peername(S2)), + ?line {Addr,P1} = ok(inet:sockname(S1)), + ?line {Addr,P2} = ok(inet:sockname(S2)), + ?line ok = gen_tcp:close(S2), + ?line ok = gen_tcp:close(S1). + + %%% Utilities @@ -217,3 +266,5 @@ unused_ip(A, B, C, D) -> {ok, _} -> unused_ip(A, B, C, D+1); {error, _} -> {ok, {A, B, C, D}} end. + +ok({ok,V}) -> V. diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index fa1991872b..44dd8607b9 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-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 @@ -34,12 +34,12 @@ -export([send_to_closed/1, buffer_size/1, binary_passive_recv/1, bad_address/1, - read_packets/1, open_fd/1, connect/1]). + read_packets/1, open_fd/1, connect/1, implicit_inet6/1]). all(suite) -> [send_to_closed, buffer_size, binary_passive_recv, bad_address, read_packets, - open_fd, connect]. + open_fd, connect, implicit_inet6]. init_per_testcase(_Case, Config) -> ?line Dog=test_server:timetrap(?default_timeout), @@ -425,3 +425,57 @@ connect(Config) when is_list(Config) -> ok = gen_udp:send(S2, <<16#deadbeef:32>>), {error,econnrefused} = gen_udp:recv(S2, 0, 5), ok. + +implicit_inet6(Config) when is_list(Config) -> + ?line Hostname = ok(inet:gethostname()), + ?line Active = {active,false}, + ?line + case gen_udp:open(0, [inet6,Active]) of + {ok,S1} -> + ?line + case inet:getaddr(Hostname, inet6) of + {ok,Host} -> + ?line Loopback = {0,0,0,0,0,0,0,1}, + ?line io:format("~s ~p~n", ["Loopback",Loopback]), + ?line implicit_inet6(S1, Active, Loopback), + ?line ok = gen_udp:close(S1), + %% + ?line Localhost = + ok(inet:getaddr("localhost", inet6)), + ?line io:format("~s ~p~n", ["localhost",Localhost]), + ?line S2 = + ok(gen_udp:open(0, [{ip,Localhost},Active])), + ?line implicit_inet6(S2, Active, Localhost), + ?line ok = gen_udp:close(S2), + %% + ?line io:format("~s ~p~n", [Hostname,Host]), + ?line S3 = + ok(gen_udp:open(0, [{ifaddr,Host},Active])), + ?line implicit_inet6(S3, Active, Host), + ?line ok = gen_udp:close(S1); + {error,eafnosupport} -> + ?line ok = gen_udp:close(S1), + {skip,"Can not look up IPv6 address"} + end; + _ -> + {skip,"IPv6 not supported"} + end. + +implicit_inet6(S1, Active, Addr) -> + ?line P1 = ok(inet:port(S1)), + ?line S2 = ok(gen_udp:open(0, [inet6,Active])), + ?line P2 = ok(inet:port(S2)), + ?line ok = gen_udp:connect(S2, Addr, P1), + ?line ok = gen_udp:connect(S1, Addr, P2), + ?line {Addr,P2} = ok(inet:peername(S1)), + ?line {Addr,P1} = ok(inet:peername(S2)), + ?line {Addr,P1} = ok(inet:sockname(S1)), + ?line {Addr,P2} = ok(inet:sockname(S2)), + ?line ok = gen_udp:send(S1, Addr, P2, "ping"), + ?line {Addr,P1,"ping"} = ok(gen_udp:recv(S2, 1024, 1000)), + ?line ok = gen_udp:send(S2, Addr, P1, "pong"), + ?line {Addr,P2,"pong"} = ok(gen_udp:recv(S1, 1024)), + ?line ok = gen_udp:close(S2). + + +ok({ok,V}) -> V. diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index eb8f918491..f4f27933a5 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -26,7 +26,8 @@ t_gethostbyaddr_v6/1, t_getaddr_v6/1, t_gethostbyname_v6/1, ipv4_to_ipv6/1, host_and_addr/1, parse/1, t_gethostnative/1, gethostnative_parallell/1, cname_loop/1, - gethostnative_soft_restart/1,gethostnative_debug_level/1,getif/1]). + gethostnative_soft_restart/1,gethostnative_debug_level/1,getif/1, + getif_ifr_name_overflow/1,getservbyname_overflow/1]). -export([get_hosts/1, get_ipv6_hosts/1, parse_hosts/1, parse_address/1, kill_gethost/0, parallell_gethost/0]). @@ -39,7 +40,7 @@ all(suite) -> ipv4_to_ipv6, host_and_addr, parse,t_gethostnative, gethostnative_parallell, cname_loop, gethostnative_debug_level,gethostnative_soft_restart, - getif]. + getif,getif_ifr_name_overflow,getservbyname_overflow]. init_per_testcase(_Func, Config) -> Dog = test_server:timetrap(test_server:seconds(60)), @@ -876,6 +877,17 @@ getif(Config) when is_list(Config) -> ?line {ok,Address} = inet:getaddr(Hostname, inet), ?line {ok,Loopback} = inet:getaddr("localhost", inet), ?line {ok,Interfaces} = inet:getiflist(), + ?line HWAs = + lists:sort( + lists:foldl( + fun (I, Acc) -> + case inet:ifget(I, [hwaddr]) of + {ok,[{hwaddr,A}]} -> [A|Acc]; + {ok,[]} -> Acc + end + end, [], Interfaces)), + ?line io:format("HWAs = ~p~n", [HWAs]), + ?line length(HWAs) > 0 orelse ?t:fail(no_HWAs), ?line Addresses = lists:sort( lists:foldl( @@ -891,6 +903,20 @@ getif(Config) when is_list(Config) -> ?line true = ip_member(Loopback, Addresses), ?line ok. +getif_ifr_name_overflow(doc) -> + "Test long interface names do not overrun buffer"; +getif_ifr_name_overflow(Config) when is_list(Config) -> + %% emulator should not crash + ?line {ok,[]} = inet:ifget(lists:duplicate(128, "x"), [addr]), + ok. + +getservbyname_overflow(doc) -> + "Test long service names do not overrun buffer"; +getservbyname_overflow(Config) when is_list(Config) -> + %% emulator should not crash + ?line {error,einval} = inet:getservbyname(list_to_atom(lists:flatten(lists:duplicate(128, "x"))), tcp), + ok. + %% Works just like lists:member/2, except that any {127,_,_,_} tuple %% matches any other {127,_,_,_}. We do this to handle Linux systems %% that use (for instance) 127.0.1.1 as the IP address for the hostname. diff --git a/lib/mnesia/test/Makefile b/lib/mnesia/test/Makefile index a4f32e3f78..4f98efaed1 100644 --- a/lib/mnesia/test/Makefile +++ b/lib/mnesia/test/Makefile @@ -109,7 +109,7 @@ release_spec: opt release_tests_spec: opt $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) mnesia.spec mnesia.spec.vxworks $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR) - $(INSTALL_PROGRAM) mt $(INSTALL_PROGS) $(RELSYSDIR) + $(INSTALL_SCRIPT) mt $(INSTALL_PROGS) $(RELSYSDIR) # chmod -f -R u+w $(RELSYSDIR) # @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) diff --git a/lib/public_key/include/public_key.hrl b/lib/public_key/include/public_key.hrl index 6503321042..82681502ab 100644 --- a/lib/public_key/include/public_key.hrl +++ b/lib/public_key/include/public_key.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-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 @@ -28,6 +28,13 @@ algorithm, parameters = asn1_NOVALUE}). +-define(DEFAULT_VERIFYFUN, + {fun(_,{bad_cert, _} = Reason, _) -> + {fail, Reason}; + (_,{extension, _}, UserState) -> + {unknown, UserState} + end, []}). + -record(path_validation_state, { valid_policy_tree, explicit_policy, @@ -42,7 +49,7 @@ working_public_key_parameters, working_issuer_name, max_path_length, - acc_errors, %% If verify_none option is set + verify_fun, user_state }). diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl index 64fc8ab5bc..b3c230df25 100644 --- a/lib/public_key/src/pubkey_cert.erl +++ b/lib/public_key/src/pubkey_cert.erl @@ -27,7 +27,6 @@ validate_time/3, validate_signature/6, validate_issuer/4, validate_names/6, validate_revoked_status/3, validate_extensions/4, - validate_unknown_extensions/3, normalize_general_name/1, digest_type/1, is_self_signed/1, is_issuer/2, issuer_id/2, is_fixed_dh_cert/1, verify_data/1]). @@ -68,13 +67,14 @@ init_validation_state(#'OTPCertificate'{} = OtpCert, DefaultPathLen, Options, false)), PolicyMapping = policy_indicator(MaxLen, proplists:get_value(policy_mapping, Options, false)), - AccErrors = proplists:get_value(acc_errors, Options, []), - State = #path_validation_state{max_path_length = MaxLen, - valid_policy_tree = PolicyTree, - explicit_policy = ExplicitPolicy, - inhibit_any_policy = InhibitAnyPolicy, - policy_mapping = PolicyMapping, - acc_errors = AccErrors, + {VerifyFun, UserState} = proplists:get_value(verify_fun, Options, ?DEFAULT_VERIFYFUN), + State = #path_validation_state{max_path_length = MaxLen, + valid_policy_tree = PolicyTree, + explicit_policy = ExplicitPolicy, + inhibit_any_policy = InhibitAnyPolicy, + policy_mapping = PolicyMapping, + verify_fun = VerifyFun, + user_state = UserState, cert_num = 0}, prepare_for_next_cert(OtpCert, State). @@ -112,12 +112,12 @@ prepare_for_next_cert(OtpCert, ValidationState = #path_validation_state{ }. %%-------------------------------------------------------------------- --spec validate_time(#'OTPCertificate'{}, list(), boolean()) -> list(). +-spec validate_time(#'OTPCertificate'{}, term(), fun()) -> term(). %% %% Description: Check that the certificate validity period includes the %% current time. %%-------------------------------------------------------------------- -validate_time(OtpCert, AccErr, Verify) -> +validate_time(OtpCert, UserState, VerifyFun) -> TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, {'Validity', NotBeforeStr, NotAfterStr} = TBSCert#'OTPTBSCertificate'.validity, @@ -127,27 +127,27 @@ validate_time(OtpCert, AccErr, Verify) -> case ((NotBefore =< Now) and (Now =< NotAfter)) of true -> - AccErr; + UserState; false -> - not_valid({bad_cert, cert_expired}, Verify, AccErr) + verify_fun(OtpCert, {bad_cert, cert_expired}, UserState, VerifyFun) end. %%-------------------------------------------------------------------- --spec validate_issuer(#'OTPCertificate'{}, term(), list(), boolean()) -> list(). +-spec validate_issuer(#'OTPCertificate'{}, term(), term(), fun()) -> term(). %% %% Description: Check that the certificate issuer name is the working_issuer_name %% in path_validation_state. %%-------------------------------------------------------------------- -validate_issuer(OtpCert, Issuer, AccErr, Verify) -> +validate_issuer(OtpCert, Issuer, UserState, VerifyFun) -> TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, case is_issuer(Issuer, TBSCert#'OTPTBSCertificate'.issuer) of true -> - AccErr; + UserState; _ -> - not_valid({bad_cert, invalid_issuer}, Verify, AccErr) + verify_fun(OtpCert, {bad_cert, invalid_issuer}, UserState, VerifyFun) end. %%-------------------------------------------------------------------- -spec validate_signature(#'OTPCertificate'{}, der_encoded(), - term(),term(), list(), boolean()) -> list(). + term(),term(), term(), fun()) -> term(). %% %% Description: Check that the signature on the certificate can be verified using @@ -155,24 +155,24 @@ validate_issuer(OtpCert, Issuer, AccErr, Verify) -> %% the working_public_key_parameters in path_validation_state. %%-------------------------------------------------------------------- validate_signature(OtpCert, DerCert, Key, KeyParams, - AccErr, Verify) -> + UserState, VerifyFun) -> case verify_signature(OtpCert, DerCert, Key, KeyParams) of true -> - AccErr; + UserState; false -> - not_valid({bad_cert, invalid_signature}, Verify, AccErr) + verify_fun(OtpCert, {bad_cert, invalid_signature}, UserState, VerifyFun) end. %%-------------------------------------------------------------------- -spec validate_names(#'OTPCertificate'{}, list(), list(), - term(), list(), boolean())-> list(). + term(), term(), fun())-> term(). %% %% Description: Validate Subject Alternative Name. %%-------------------------------------------------------------------- -validate_names(OtpCert, Permit, Exclude, Last, AccErr, Verify) -> +validate_names(OtpCert, Permit, Exclude, Last, UserState, VerifyFun) -> case is_self_signed(OtpCert) andalso (not Last) of true -> - AccErr; + UserState; false -> TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, Subject = TBSCert#'OTPTBSCertificate'.subject, @@ -196,51 +196,36 @@ validate_names(OtpCert, Permit, Exclude, Last, AccErr, Verify) -> (not is_excluded(Name, Exclude)) andalso (not is_excluded(AltNames, Exclude))) of true -> - AccErr; + UserState; false -> - not_valid({bad_cert, name_not_permitted}, - Verify, AccErr) + verify_fun(OtpCert, {bad_cert, name_not_permitted}, + UserState, VerifyFun) end end. %%-------------------------------------------------------------------- --spec validate_revoked_status(#'OTPCertificate'{}, boolean(), list()) -> - list(). +-spec validate_revoked_status(#'OTPCertificate'{}, term(), fun()) -> + term(). %% %% Description: Check if certificate has been revoked. %%-------------------------------------------------------------------- -validate_revoked_status(_OtpCert, _Verify, AccErr) -> +validate_revoked_status(_OtpCert, UserState, _VerifyFun) -> %% TODO: Implement or leave for application?! - %% true | + %% valid | %% throw({bad_cert, cert_revoked}) - AccErr. + UserState. %%-------------------------------------------------------------------- -spec validate_extensions(#'OTPCertificate'{}, #path_validation_state{}, - boolean(), list())-> - {#path_validation_state{}, - UnknownExtensions :: list(), AccErrors :: list()}. + term(), fun())-> + {#path_validation_state{}, UserState :: term()}. %% %% Description: Check extensions included in basic path validation. %%-------------------------------------------------------------------- -validate_extensions(OtpCert, ValidationState, Verify, AccErr) -> +validate_extensions(OtpCert, ValidationState, UserState, VerifyFun) -> TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, Extensions = TBSCert#'OTPTBSCertificate'.extensions, - validate_extensions(Extensions, ValidationState, no_basic_constraint, - is_self_signed(OtpCert), [], Verify, AccErr). - -%-------------------------------------------------------------------- - -spec validate_unknown_extensions(list(), list(), boolean())-> list(). -%% -%% Description: Check that all critical extensions has been handled. -%%-------------------------------------------------------------------- -validate_unknown_extensions([], AccErr, _Verify) -> - AccErr; -validate_unknown_extensions([#'Extension'{critical = true} | _], - AccErr, Verify) -> - not_valid({bad_cert, unknown_critical_extension}, Verify, AccErr); -validate_unknown_extensions([#'Extension'{critical = false} | Rest], - AccErr, Verify) -> - validate_unknown_extensions(Rest, AccErr, Verify). + validate_extensions(OtpCert, Extensions, ValidationState, no_basic_constraint, + is_self_signed(OtpCert), UserState, VerifyFun). %%-------------------------------------------------------------------- -spec normalize_general_name({rdnSequence, term()}) -> {rdnSequence, term()}. @@ -330,10 +315,25 @@ extensions_list(asn1_NOVALUE) -> extensions_list(Extensions) -> Extensions. -not_valid(Error, true, _) -> - throw(Error); -not_valid(Error, false, AccErrors) -> - [Error | AccErrors]. +verify_fun(Otpcert, Result, UserState0, VerifyFun) -> + case VerifyFun(Otpcert, Result, UserState0) of + {valid,UserState} -> + UserState; + {fail, Reason} -> + case Result of + {bad_cert, _} -> + throw(Result); + _ -> + throw({bad_cert, Reason}) + end; + {unknown, UserState} -> + case Result of + {extension, #'Extension'{critical = true}} -> + throw({bad_cert, unknown_critical_extension}); + _ -> + UserState + end + end. extract_verify_data(OtpCert, DerCert) -> {0, Signature} = OtpCert#'OTPCertificate'.signature, @@ -460,198 +460,189 @@ select_extension(Id, [_ | Extensions]) -> select_extension(Id, Extensions). %% No extensions present -validate_extensions(asn1_NOVALUE, ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, AccErr) -> - validate_extensions([], ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, AccErr); - -validate_extensions([], ValidationState, basic_constraint, _SelfSigned, - UnknownExtensions, _Verify, AccErr) -> - {ValidationState, UnknownExtensions, AccErr}; -validate_extensions([], ValidationState = - #path_validation_state{max_path_length = Len, - last_cert = Last}, - no_basic_constraint, SelfSigned, UnknownExtensions, - Verify, AccErr0) -> +validate_extensions(OtpCert, asn1_NOVALUE, ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun) -> + validate_extensions(OtpCert, [], ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun); + +validate_extensions(_,[], ValidationState, basic_constraint, _SelfSigned, + UserState, _) -> + {ValidationState, UserState}; +validate_extensions(OtpCert, [], ValidationState = + #path_validation_state{max_path_length = Len, + last_cert = Last}, + no_basic_constraint, SelfSigned, UserState0, VerifyFun) -> case Last of true when SelfSigned -> - {ValidationState, UnknownExtensions, AccErr0}; + {ValidationState, UserState0}; true -> {ValidationState#path_validation_state{max_path_length = Len - 1}, - UnknownExtensions, AccErr0}; + UserState0}; %% basic_constraint must appear in certs used for digital sign %% see 4.2.1.10 in rfc 3280 false -> - AccErr = not_valid({bad_cert, missing_basic_constraint}, - Verify, AccErr0), + UserState = verify_fun(OtpCert, {bad_cert, missing_basic_constraint}, + UserState0, VerifyFun), case SelfSigned of true -> - {ValidationState, UnknownExtensions, AccErr}; + {ValidationState, UserState}; false -> {ValidationState#path_validation_state{max_path_length = - Len - 1}, - UnknownExtensions, AccErr} + Len - 1}, + UserState} end end; -validate_extensions([#'Extension'{extnID = ?'id-ce-basicConstraints', +validate_extensions(OtpCert, + [#'Extension'{extnID = ?'id-ce-basicConstraints', extnValue = - #'BasicConstraints'{cA = true, - pathLenConstraint = N}} | + #'BasicConstraints'{cA = true, + pathLenConstraint = N}} | Rest], - ValidationState = - #path_validation_state{max_path_length = Len}, _, - SelfSigned, UnknownExtensions, Verify, AccErr) -> + ValidationState = + #path_validation_state{max_path_length = Len}, _, + SelfSigned, UserState, VerifyFun) -> Length = if SelfSigned -> erlang:min(N, Len); true -> erlang:min(N, Len-1) end, - validate_extensions(Rest, + validate_extensions(OtpCert, Rest, ValidationState#path_validation_state{max_path_length = - Length}, - basic_constraint, SelfSigned, UnknownExtensions, - Verify, AccErr); + Length}, + basic_constraint, SelfSigned, + UserState, VerifyFun); %% The pathLenConstraint field is meaningful only if cA is set to %% TRUE. -validate_extensions([#'Extension'{extnID = ?'id-ce-basicConstraints', - extnValue = - #'BasicConstraints'{cA = false}} | - Rest], ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, AccErr) -> - validate_extensions(Rest, ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, AccErr); - -%% -validate_extensions([#'Extension'{extnID = ?'id-ce-keyUsage', - extnValue = KeyUse - } | Rest], - #path_validation_state{last_cert=Last} = ValidationState, - ExistBasicCon, SelfSigned, UnknownExtensions, - Verify, AccErr0) -> +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-basicConstraints', + extnValue = + #'BasicConstraints'{cA = false}} | + Rest], ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun) -> + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun); + +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-keyUsage', + extnValue = KeyUse + } | Rest], + #path_validation_state{last_cert=Last} = ValidationState, + ExistBasicCon, SelfSigned, + UserState0, VerifyFun) -> case Last orelse is_valid_key_usage(KeyUse, keyCertSign) of true -> - validate_extensions(Rest, ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, - AccErr0); + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, + SelfSigned, UserState0, VerifyFun); false -> - AccErr = not_valid({bad_cert, invalid_key_usage}, Verify, AccErr0), - validate_extensions(Rest, ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, - AccErr) + UserState = verify_fun(OtpCert, {bad_cert, invalid_key_usage}, + UserState0, VerifyFun), + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun) end; -validate_extensions([#'Extension'{extnID = ?'id-ce-subjectAltName', - extnValue = Names} | Rest], - ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, AccErr0) -> +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-subjectAltName', + extnValue = Names} | Rest], + ValidationState, ExistBasicCon, + SelfSigned, UserState0, VerifyFun) -> case validate_subject_alt_names(Names) of true when Names =/= [] -> - validate_extensions(Rest, ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, - AccErr0); + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, + SelfSigned, UserState0, VerifyFun); _ -> - AccErr = - not_valid({bad_cert, invalid_subject_altname}, - Verify, AccErr0), - validate_extensions(Rest, ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, - AccErr) + UserState = verify_fun(OtpCert, {bad_cert, invalid_subject_altname}, + UserState0, VerifyFun), + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun) end; %% This extension SHOULD NOT be marked critical. Its value %% does not have to be further validated at this point. -validate_extensions([#'Extension'{extnID = ?'id-ce-issuerAltName', - extnValue = _} | Rest], - ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, AccErr) -> - validate_extensions(Rest, ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, AccErr); +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-issuerAltName', + extnValue = _} | Rest], + ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun) -> + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun); %% This extension MUST NOT be marked critical.Its value %% does not have to be further validated at this point. -validate_extensions([#'Extension'{extnID = Id, - extnValue = _, - critical = false} | Rest], +validate_extensions(OtpCert, [#'Extension'{extnID = Id, + extnValue = _, + critical = false} | Rest], ValidationState, - ExistBasicCon, SelfSigned, UnknownExtensions, - Verify, AccErr) + ExistBasicCon, SelfSigned, + UserState, VerifyFun) when Id == ?'id-ce-subjectKeyIdentifier'; Id == ?'id-ce-authorityKeyIdentifier'-> - validate_extensions(Rest, ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, AccErr); + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun); -validate_extensions([#'Extension'{extnID = ?'id-ce-nameConstraints', +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-nameConstraints', extnValue = NameConst} | Rest], ValidationState, - ExistBasicCon, SelfSigned, UnknownExtensions, - Verify, AccErr) -> + ExistBasicCon, SelfSigned, UserState, VerifyFun) -> Permitted = NameConst#'NameConstraints'.permittedSubtrees, Excluded = NameConst#'NameConstraints'.excludedSubtrees, NewValidationState = add_name_constraints(Permitted, Excluded, ValidationState), - validate_extensions(Rest, NewValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, AccErr); + validate_extensions(OtpCert, Rest, NewValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun); -validate_extensions([#'Extension'{extnID = ?'id-ce-certificatePolicies', - critical = true} | Rest], ValidationState, - ExistBasicCon, SelfSigned, - UnknownExtensions, Verify, AccErr0) -> +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-certificatePolicies', + critical = true} = Ext| Rest], ValidationState, + ExistBasicCon, SelfSigned, UserState0, VerifyFun) -> %% TODO: Remove this clause when policy handling is %% fully implemented - AccErr = - not_valid({bad_cert, unknown_critical_extension}, Verify, AccErr0), - validate_extensions(Rest, ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, AccErr); - -validate_extensions([#'Extension'{extnID = ?'id-ce-certificatePolicies', - extnValue = #'PolicyInformation'{ - policyIdentifier = Id, - policyQualifiers = Qualifier}} - | Rest], #path_validation_state{valid_policy_tree = Tree} + UserState = verify_fun(OtpCert, {extension, Ext}, + UserState0, VerifyFun), + validate_extensions(OtpCert,Rest, ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun); + +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-certificatePolicies', + extnValue = #'PolicyInformation'{ + policyIdentifier = Id, + policyQualifiers = Qualifier}} + | Rest], #path_validation_state{valid_policy_tree = Tree} = ValidationState, - ExistBasicCon, SelfSigned, UnknownExtensions, - Verify, AccErr) -> + ExistBasicCon, SelfSigned, UserState, VerifyFun) -> %% TODO: Policy imp incomplete NewTree = process_policy_tree(Id, Qualifier, Tree), - validate_extensions(Rest, + validate_extensions(OtpCert, Rest, ValidationState#path_validation_state{ valid_policy_tree = NewTree}, - ExistBasicCon, SelfSigned, UnknownExtensions, - Verify, AccErr); + ExistBasicCon, SelfSigned, UserState, VerifyFun); -validate_extensions([#'Extension'{extnID = ?'id-ce-policyConstraints', - critical = true} | Rest], ValidationState, - ExistBasicCon, SelfSigned, UnknownExtensions, Verify, - AccErr0) -> +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-policyConstraints', + critical = true} = Ext | Rest], ValidationState, + ExistBasicCon, SelfSigned, UserState0, VerifyFun) -> %% TODO: Remove this clause when policy handling is %% fully implemented - AccErr = - not_valid({bad_cert, unknown_critical_extension}, Verify, AccErr0), - validate_extensions(Rest, ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, AccErr); -validate_extensions([#'Extension'{extnID = ?'id-ce-policyConstraints', - extnValue = #'PolicyConstraints'{ - requireExplicitPolicy = ExpPolicy, - inhibitPolicyMapping = MapPolicy}} - | Rest], ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, AccErr) -> + UserState = verify_fun(OtpCert, {extension, Ext}, + UserState0, VerifyFun), + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun); +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-policyConstraints', + extnValue = #'PolicyConstraints'{ + requireExplicitPolicy = ExpPolicy, + inhibitPolicyMapping = MapPolicy}} + | Rest], ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun) -> %% TODO: Policy imp incomplete - NewValidationState = add_policy_constraints(ExpPolicy, MapPolicy, + NewValidationState = add_policy_constraints(ExpPolicy, MapPolicy, ValidationState), - validate_extensions(Rest, NewValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, AccErr); + validate_extensions(OtpCert, Rest, NewValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun); -validate_extensions([Extension | Rest], ValidationState, - ExistBasicCon, SelfSigned, UnknownExtensions, - Verify, AccErr) -> - validate_extensions(Rest, ValidationState, ExistBasicCon, SelfSigned, - [Extension | UnknownExtensions], Verify, AccErr). +validate_extensions(OtpCert, [#'Extension'{} = Extension | Rest], + ValidationState, ExistBasicCon, + SelfSigned, UserState0, VerifyFun) -> + UserState = verify_fun(OtpCert, {extension, Extension}, UserState0, VerifyFun), + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, SelfSigned, + UserState, VerifyFun). is_valid_key_usage(KeyUse, Use) -> lists:member(Use, KeyUse). diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index f9b992afd3..68bf04eeff 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -109,7 +109,8 @@ pem_entry_decode({Asn1Type, CryptDer, {Cipher, Salt}} = PemEntry, %%-------------------------------------------------------------------- -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(). + {{Cipher :: string(), Salt :: binary()}, string()}) -> + pem_entry(). % %% Description: Creates a pem entry that can be feed to pem_encode/1. %%-------------------------------------------------------------------- @@ -440,17 +441,25 @@ pkix_normalize_name(Issuer) -> CertChain :: [der_encoded()] , Options :: list()) -> {ok, {PublicKeyInfo :: term(), - PolicyTree :: term(), - [{bad_cert, Reason :: term()}]}} | + PolicyTree :: term()}} | {error, {bad_cert, Reason :: term()}}. %% Description: Performs a basic path validation according to RFC 5280. %%-------------------------------------------------------------------- -pkix_path_validation(unknown_ca, [Cert | Chain], Options) -> - case proplists:get_value(verify, Options, true) of - true -> - {error, {bad_cert, unknown_ca}}; - false -> - pkix_path_validation(Cert, Chain, [{acc_errors, [{bad_cert, unknown_ca}]}]) +pkix_path_validation(unknown_ca, [Cert | Chain], Options0) -> + {VerifyFun, Userstat0} = + proplists:get_value(verify_fun, Options0, ?DEFAULT_VERIFYFUN), + Otpcert = pkix_decode_cert(Cert, otp), + Reason = {bad_cert, unknown_ca}, + try VerifyFun(Otpcert, Reason, Userstat0) of + {valid, Userstate} -> + Options = proplists:delete(verify_fun, Options0), + pkix_path_validation(Otpcert, Chain, [{verify_fun, + {VerifyFun, Userstate}}| Options]); + {fail, _} -> + {error, Reason} + catch + _:_ -> + {error, Reason} end; pkix_path_validation(TrustedCert, CertChain, Options) when is_binary(TrustedCert) -> OtpCert = pkix_decode_cert(TrustedCert, @@ -462,12 +471,7 @@ pkix_path_validation(#'OTPCertificate'{} = TrustedCert, CertChain, Options) ValidationState = pubkey_cert:init_validation_state(TrustedCert, MaxPathDefault, Options), - Fun = proplists:get_value(validate_extensions_fun, Options, - fun(Extensions, State, _, AccError) -> - {Extensions, State, AccError} - end), - Verify = proplists:get_value(verify, Options, true), - path_validation(CertChain, ValidationState, Fun, Verify). + path_validation(CertChain, ValidationState). %%-------------------------------------------------------------------- %%% Internal functions @@ -490,38 +494,40 @@ path_validation([], #path_validation_state{working_public_key_algorithm PublicKey, working_public_key_parameters = PublicKeyParams, - valid_policy_tree = Tree, - acc_errors = AccErrors - }, _, _) -> - {ok, {{Algorithm, PublicKey, PublicKeyParams}, Tree, AccErrors}}; + valid_policy_tree = Tree + }) -> + {ok, {{Algorithm, PublicKey, PublicKeyParams}, Tree}}; path_validation([DerCert | Rest], ValidationState = #path_validation_state{ - max_path_length = Len}, - Fun, Verify) when Len >= 0 -> - try validate(DerCert, - ValidationState#path_validation_state{last_cert=Rest=:=[]}, - Fun, Verify) of + max_path_length = Len}) when Len >= 0 -> + try validate(DerCert, + ValidationState#path_validation_state{last_cert=Rest=:=[]}) of #path_validation_state{} = NewValidationState -> - path_validation(Rest, NewValidationState, Fun, Verify) + path_validation(Rest, NewValidationState) catch throw:Reason -> {error, Reason} end; -path_validation(_, _, _, true) -> - {error, {bad_cert, max_path_length_reached}}; +path_validation([DerCert | _] = Path, + #path_validation_state{user_state = UserState0, + verify_fun = VerifyFun} = + ValidationState) -> + Reason = {bad_cert, max_path_length_reached}, + OtpCert = pkix_decode_cert(DerCert, otp), + try VerifyFun(OtpCert, Reason, UserState0) of + {valid, UserState} -> + path_validation(Path, + ValidationState#path_validation_state{ + max_path_length = 0, + user_state = UserState}); + {fail, _} -> + {error, Reason} + catch + _:_ -> + {error, Reason} + end. -path_validation(_, #path_validation_state{working_public_key_algorithm - = Algorithm, - working_public_key = - PublicKey, - working_public_key_parameters - = PublicKeyParams, - valid_policy_tree = Tree, - acc_errors = AccErrors - }, _, false) -> - {ok, {{Algorithm, PublicKey, PublicKeyParams}, Tree, - [{bad_cert, max_path_length_reached}|AccErrors]}}. validate(DerCert, #path_validation_state{working_issuer_name = Issuer, working_public_key = Key, @@ -531,40 +537,29 @@ validate(DerCert, #path_validation_state{working_issuer_name = Issuer, excluded_subtrees = Exclude, last_cert = Last, user_state = UserState0, - acc_errors = AccErr0} = - ValidationState0, ValidateExtensionFun, Verify) -> + verify_fun = VerifyFun} = + ValidationState0) -> OtpCert = pkix_decode_cert(DerCert, otp), - %% All validate functions will throw {bad_cert, Reason} if they - %% fail and Verify = true if Verify = false errors - %% will be accumulated in the validationstate - AccErr1 = pubkey_cert:validate_time(OtpCert, AccErr0, Verify), - AccErr2 = pubkey_cert:validate_issuer(OtpCert, Issuer, AccErr1, Verify), + UserState1 = pubkey_cert:validate_time(OtpCert, UserState0, VerifyFun), + + UserState2 = pubkey_cert:validate_issuer(OtpCert, Issuer, UserState1, VerifyFun), - AccErr3 = pubkey_cert:validate_names(OtpCert, Permit, Exclude, Last, - AccErr2, Verify), - AccErr4 = - pubkey_cert:validate_revoked_status(OtpCert, Verify, AccErr3), + UserState3 = pubkey_cert:validate_names(OtpCert, Permit, Exclude, Last, + UserState2,VerifyFun), + + UserState4 = pubkey_cert:validate_revoked_status(OtpCert, UserState3, VerifyFun), - {ValidationState1, UnknownExtensions0, AccErr5} = - pubkey_cert:validate_extensions(OtpCert, ValidationState0, Verify, - AccErr4), - %% We want the key_usage extension to be checked before we validate + {ValidationState1, UserState5} = + pubkey_cert:validate_extensions(OtpCert, ValidationState0, UserState4, + VerifyFun), + + %% We want the key_usage extension to be checked before we validate %% the signature. - AccErr6 = - pubkey_cert:validate_signature(OtpCert, DerCert, Key, KeyParams, - AccErr5, Verify), - - {UnknownExtensions, UserState, AccErr7} = - ValidateExtensionFun(UnknownExtensions0, UserState0, Verify, AccErr6), - - %% Check that all critical extensions have been handled - AccErr = - pubkey_cert:validate_unknown_extensions(UnknownExtensions, AccErr7, - Verify), + UserState = pubkey_cert:validate_signature(OtpCert, DerCert, + Key, KeyParams, UserState5, VerifyFun), ValidationState = - ValidationState1#path_validation_state{user_state = UserState, - acc_errors = AccErr}, + ValidationState1#path_validation_state{user_state = UserState}, pubkey_cert:prepare_for_next_cert(OtpCert, ValidationState). sized_binary(Binary) when is_binary(Binary) -> diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl index 09235ff460..46b8c3db8b 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -369,16 +369,35 @@ pkix_path_validation(Config) when is_list(Config) -> CertK3 = {Cert3,_} = erl_make_certs:make_cert([{issuer, CertK1}, {extensions, [{basic_constraints, false}]}]), {Cert4,_} = erl_make_certs:make_cert([{issuer, CertK3}]), - {error, E={bad_cert,missing_basic_constraint}} = + {error, {bad_cert,missing_basic_constraint}} = public_key:pkix_path_validation(Trusted, [Cert1, Cert3,Cert4], []), - - {ok, {_,_,[E]}} = public_key:pkix_path_validation(Trusted, [Cert1, Cert3,Cert4], - [{verify,false}]), - - {error, {bad_cert,unknown_ca}} = public_key:pkix_path_validation(unknown_ca, [Cert1, Cert3, Cert4], []), - {ok, {_,_,[{bad_cert,unknown_ca}]}} = - public_key:pkix_path_validation(unknown_ca, [Cert1], [{verify, false}]), + VerifyFunAndState0 = {fun(_,{bad_cert, missing_basic_constraint}, UserState) -> + {valid, UserState}; + (_,{bad_cert, _} = Reason, _) -> + {fail, Reason}; + (_,{extension, _}, UserState) -> + {unknown, UserState} + end, []}, + {ok, _} = + public_key:pkix_path_validation(Trusted, [Cert1, Cert3,Cert4], + [{verify_fun, VerifyFunAndState0}]), + + {error, {bad_cert, unknown_ca}} = + public_key:pkix_path_validation(unknown_ca, [Cert1, Cert3, Cert4], []), + + VerifyFunAndState1 = + {fun(_,{bad_cert, unknown_ca}, UserState) -> + {valid, UserState}; + (_,{bad_cert, _} = Reason, _) -> + {fail, Reason}; + (_,{extension, _}, UserState) -> + {unknown, UserState} + end, []}, + + {ok, _} = + public_key:pkix_path_validation(unknown_ca, [Cert1], [{verify_fun, + VerifyFunAndState1}]), ok. %%-------------------------------------------------------------------- diff --git a/lib/reltool/test/Makefile b/lib/reltool/test/Makefile index 34781ae720..5109058797 100644 --- a/lib/reltool/test/Makefile +++ b/lib/reltool/test/Makefile @@ -74,7 +74,8 @@ release_spec: opt release_tests_spec: opt $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) reltool.spec $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR) - $(INSTALL_PROGRAM) rtt $(INSTALL_PROGS) $(RELSYSDIR) + $(INSTALL_SCRIPT) rtt $(INSTALL_PROGS) $(RELSYSDIR) + $(INSTALL_DATA) $(INSTALL_PROGS) $(RELSYSDIR) # chmod -f -R u+w $(RELSYSDIR) # @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) diff --git a/lib/runtime_tools/c_src/trace_file_drv.c b/lib/runtime_tools/c_src/trace_file_drv.c index 482fcc0288..cd54f36af0 100644 --- a/lib/runtime_tools/c_src/trace_file_drv.c +++ b/lib/runtime_tools/c_src/trace_file_drv.c @@ -520,7 +520,7 @@ static int do_write(FILETYPE fd, unsigned char *buff, int siz) { */ static int my_write(TraceFileData *data, unsigned char *buff, int siz) { - int wrote, w; + int wrote; if (data->buff_siz - data->buff_pos >= siz) { memcpy(data->buff + data->buff_pos, buff, siz); diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index e3b6ffa125..cb78acb84c 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -415,14 +415,12 @@ start_shell(ConnectionManager, State) -> Shell = State#state.shell, ShellFun = case is_function(Shell) of true -> + {ok, User} = + ssh_userreg:lookup_user(ConnectionManager), case erlang:fun_info(Shell, arity) of {arity, 1} -> - {ok, User} = - ssh_userreg:lookup_user(ConnectionManager), fun() -> Shell(User) end; {arity, 2} -> - {ok, User} = - ssh_userreg:lookup_user(ConnectionManager), {ok, PeerAddr} = ssh_connection_manager:peer_addr(ConnectionManager), fun() -> Shell(User, PeerAddr) end; @@ -437,10 +435,28 @@ start_shell(ConnectionManager, State) -> State#state{group = Group, buf = empty_buf()}. start_shell(_ConnectionManager, Cmd, #state{exec={M, F, A}} = State) -> - Group = group:start(self(), {M, F, A++[Cmd]}, [{echo,false}]), + Group = group:start(self(), {M, F, A++[Cmd]}, [{echo, false}]), + State#state{group = Group, buf = empty_buf()}; +start_shell(ConnectionManager, Cmd, #state{exec=Shell} = State) when is_function(Shell) -> + {ok, User} = + ssh_userreg:lookup_user(ConnectionManager), + ShellFun = + case erlang:fun_info(Shell, arity) of + {arity, 1} -> + fun() -> Shell(Cmd) end; + {arity, 2} -> + fun() -> Shell(Cmd, User) end; + {arity, 3} -> + {ok, PeerAddr} = + ssh_connection_manager:peer_addr(ConnectionManager), + fun() -> Shell(Cmd, User, PeerAddr) end; + _ -> + Shell + end, + Echo = get_echo(State#state.pty), + Group = group:start(self(), ShellFun, [{echo,Echo}]), State#state{group = Group, buf = empty_buf()}. - % Pty can be undefined if the client never sets any pty options before % starting the shell. get_echo(undefined) -> diff --git a/lib/ssh/src/ssh_connection_controler.erl b/lib/ssh/src/ssh_connection_controler.erl index 636ecba532..ca3e62dc83 100644 --- a/lib/ssh/src/ssh_connection_controler.erl +++ b/lib/ssh/src/ssh_connection_controler.erl @@ -126,8 +126,8 @@ handle_cast(_, State) -> %% handle_info(ssh_connected, State) -> %% {stop, normal, State}; %% Servant termination. -handle_info({'EXIT', _Pid, normal}, State) -> - {stop, normal, State}. +handle_info({'EXIT', _Pid, Reason}, State) -> + {stop, Reason, State}. %%----------------------------------------------------------------- %% Func: code_change/3 diff --git a/lib/ssh/src/ssh_connection_manager.erl b/lib/ssh/src/ssh_connection_manager.erl index 9e55312e5f..6bf89224cf 100644 --- a/lib/ssh/src/ssh_connection_manager.erl +++ b/lib/ssh/src/ssh_connection_manager.erl @@ -560,13 +560,18 @@ handle_info({'EXIT', _, _}, State) -> %% The return value is ignored. %%-------------------------------------------------------------------- terminate(Reason, #state{connection_state = - #connection{requests = Requests}, + #connection{requests = Requests, + sub_system_supervisor = SubSysSup}, opts = Opts}) -> SSHOpts = proplists:get_value(ssh_opts, Opts), disconnect_fun(Reason, SSHOpts), (catch lists:foreach(fun({_, From}) -> gen_server:reply(From, {error, connection_closed}) end, Requests)), + Address = proplists:get_value(address, Opts), + Port = proplists:get_value(port, Opts), + SystemSup = ssh_system_sup:system_supervisor(Address, Port), + ssh_system_sup:stop_subsystem(SystemSup, SubSysSup), ok. %%-------------------------------------------------------------------- diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl index 40db2e4adf..f4570b8a48 100644 --- a/lib/ssh/src/ssh_system_sup.erl +++ b/lib/ssh/src/ssh_system_sup.erl @@ -33,7 +33,8 @@ stop_system/2, system_supervisor/2, subsystem_supervisor/1, channel_supervisor/1, connection_supervisor/1, - acceptor_supervisor/1, start_subsystem/2, restart_subsystem/2, restart_acceptor/2]). + acceptor_supervisor/1, start_subsystem/2, restart_subsystem/2, + restart_acceptor/2, stop_subsystem/2]). %% Supervisor callback -export([init/1]). @@ -83,6 +84,23 @@ start_subsystem(SystemSup, Options) -> Spec = ssh_subsystem_child_spec(Options), supervisor:start_child(SystemSup, Spec). +stop_subsystem(SystemSup, SubSys) -> + case lists:keyfind(SubSys, 2, supervisor:which_children(SystemSup)) of + false -> + {error, not_found}; + {Id, _, _, _} -> + spawn(fun() -> supervisor:terminate_child(SystemSup, Id), + supervisor:delete_child(SystemSup, Id) end), + ok; + {'EXIT', {noproc, _}} -> + %% Already terminated; probably shutting down. + ok; + {'EXIT', {shutdown, _}} -> + %% Already shutting down. + ok + end. + + restart_subsystem(Address, Port) -> SysSupName = make_name(Address, Port), SubSysName = id(ssh_subsystem_sup, Address, Port), diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 6e26f05c3d..cc01b35b64 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -80,6 +80,7 @@ stop() -> -spec connect(host() | port(), list()) -> {ok, #sslsocket{}}. -spec connect(host() | port(), list() | port_num(), timeout() | list()) -> {ok, #sslsocket{}}. -spec connect(host() | port(), port_num(), list(), timeout()) -> {ok, #sslsocket{}}. + %% %% Description: Connect to a ssl server. %%-------------------------------------------------------------------- @@ -375,7 +376,7 @@ cipher_suites(openssl) -> [ssl_cipher:openssl_suite_name(S) || S <- ssl_cipher:suites(Version)]. %%-------------------------------------------------------------------- --spec getopts(#sslsocket{}, [atom()]) -> {ok, [{atom(), term()}]}| {error, reason()}. +-spec getopts(#sslsocket{}, [atom()]) -> {ok, [{atom(), term()}]}| {error, reason()}. %% %% Description: %%-------------------------------------------------------------------- @@ -522,59 +523,64 @@ old_listen(Port, Options) -> {ok, Pid} = ssl_broker:start_broker(listener), ssl_broker:listen(Pid, Port, Options). -handle_options(Opts0, Role) -> +handle_options(Opts0, _Role) -> Opts = proplists:expand([{binary, [{mode, binary}]}, {list, [{mode, list}]}], Opts0), ReuseSessionFun = fun(_, _, _, _) -> true end, - AcceptBadCa = fun({bad_cert,unknown_ca}, Acc) -> Acc; - (Other, Acc) -> [Other | Acc] - end, - - VerifyFun = - fun(ErrorList) -> - case lists:foldl(AcceptBadCa, [], ErrorList) of - [] -> true; - [_|_] -> false - end - end, + VerifyNoneFun = + {fun(_,{bad_cert, unknown_ca}, UserState) -> + {valid, UserState}; + (_,{bad_cert, _} = Reason, _) -> + {fail, Reason}; + (_,{extension, _}, UserState) -> + {unknown, UserState} + end, []}, - UserFailIfNoPeerCert = validate_option(fail_if_no_peer_cert, - proplists:get_value(fail_if_no_peer_cert, Opts, false)), + UserFailIfNoPeerCert = handle_option(fail_if_no_peer_cert, Opts, false), + UserVerifyFun = handle_option(verify_fun, Opts, undefined), + CaCerts = handle_option(cacerts, Opts, undefined), - {Verify, FailIfNoPeerCert, CaCertDefault} = + {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} = %% Handle 0, 1, 2 for backwards compatibility case proplists:get_value(verify, Opts, verify_none) of 0 -> - {verify_none, false, ca_cert_default(verify_none, Role)}; + {verify_none, false, + ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; 1 -> - {verify_peer, false, ca_cert_default(verify_peer, Role)}; + {verify_peer, false, + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; 2 -> - {verify_peer, true, ca_cert_default(verify_peer, Role)}; + {verify_peer, true, + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; verify_none -> - {verify_none, false, ca_cert_default(verify_none, Role)}; + {verify_none, false, + ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; verify_peer -> - {verify_peer, UserFailIfNoPeerCert, ca_cert_default(verify_peer, Role)}; + {verify_peer, UserFailIfNoPeerCert, + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; Value -> throw({error, {eoptions, {verify, Value}}}) - end, + end, CertFile = handle_option(certfile, Opts, ""), SSLOptions = #ssl_options{ versions = handle_option(versions, Opts, []), verify = validate_option(verify, Verify), - verify_fun = handle_option(verify_fun, Opts, VerifyFun), + verify_fun = VerifyFun, fail_if_no_peer_cert = FailIfNoPeerCert, verify_client_once = handle_option(verify_client_once, Opts, false), - validate_extensions_fun = handle_option(validate_extensions_fun, Opts, undefined), depth = handle_option(depth, Opts, 1), + cert = handle_option(cert, Opts, undefined), certfile = CertFile, - keyfile = handle_option(keyfile, Opts, CertFile), key = handle_option(key, Opts, undefined), + keyfile = handle_option(keyfile, Opts, CertFile), password = handle_option(password, Opts, ""), + cacerts = CaCerts, cacertfile = handle_option(cacertfile, Opts, CaCertDefault), + dh = handle_option(dh, Opts, undefined), dhfile = handle_option(dhfile, Opts, undefined), ciphers = handle_option(ciphers, Opts, []), %% Server side option @@ -586,10 +592,10 @@ handle_options(Opts0, Role) -> }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), - SslOptions = [versions, verify, verify_fun, validate_extensions_fun, + SslOptions = [versions, verify, verify_fun, fail_if_no_peer_cert, verify_client_once, - depth, certfile, keyfile, - key, password, cacertfile, dhfile, ciphers, + depth, cert, certfile, key, keyfile, + password, cacerts, cacertfile, dh, dhfile, ciphers, debug, reuse_session, reuse_sessions, ssl_imp, cb_info, renegotiate_at, secure_renegotiate], @@ -613,7 +619,21 @@ validate_option(ssl_imp, Value) when Value == new; Value == old -> validate_option(verify, Value) when Value == verify_none; Value == verify_peer -> Value; -validate_option(verify_fun, Value) when is_function(Value) -> +validate_option(verify_fun, undefined) -> + undefined; +%% Backwards compatibility +validate_option(verify_fun, Fun) when is_function(Fun) -> + {fun(_,{bad_cert, _} = Reason, OldFun) -> + case OldFun([Reason]) of + true -> + {valid, OldFun}; + false -> + {fail, Reason} + end; + (_,{extension, _}, UserState) -> + {unknown, UserState} + end, Fun}; +validate_option(verify_fun, {Fun, _} = Value) when is_function(Fun) -> Value; validate_option(fail_if_no_peer_cert, Value) when Value == true; Value == false -> @@ -621,29 +641,38 @@ validate_option(fail_if_no_peer_cert, Value) validate_option(verify_client_once, Value) when Value == true; Value == false -> Value; - -validate_option(validate_extensions_fun, Value) when Value == undefined; is_function(Value) -> - Value; validate_option(depth, Value) when is_integer(Value), Value >= 0, Value =< 255-> Value; +validate_option(cert, Value) when Value == undefined; + is_binary(Value) -> + Value; validate_option(certfile, Value) when is_list(Value) -> Value; + +validate_option(key, undefined) -> + undefined; +validate_option(key, {KeyType, Value}) when is_binary(Value), + KeyType == rsa; + KeyType == dsa -> + {KeyType, Value}; validate_option(keyfile, Value) when is_list(Value) -> Value; -validate_option(key, Value) when Value == undefined; - is_tuple(Value) -> - %% element(1, Value)=='RSAPrivateKey' -> - Value; validate_option(password, Value) when is_list(Value) -> Value; +validate_option(cacerts, Value) when Value == undefined; + is_list(Value) -> + Value; %% certfile must be present in some cases otherwhise it can be set %% to the empty string. validate_option(cacertfile, undefined) -> ""; validate_option(cacertfile, Value) when is_list(Value), Value =/= "" -> Value; +validate_option(dh, Value) when Value == undefined; + is_binary(Value) -> + Value; validate_option(dhfile, undefined = Value) -> Value; validate_option(dhfile, Value) when is_list(Value), Value =/= "" -> @@ -701,14 +730,16 @@ validate_inet_option(active, Value) validate_inet_option(_, _) -> ok. -ca_cert_default(verify_none, _) -> +%% The option cacerts overrides cacertsfile +ca_cert_default(_,_, [_|_]) -> + undefined; +ca_cert_default(verify_none, _, _) -> undefined; -%% Client may leave verification up to the user -ca_cert_default(verify_peer, client) -> +ca_cert_default(verify_peer, {Fun,_}, _) when is_function(Fun) -> undefined; -%% Server that wants to verify_peer must have +%% Server that wants to verify_peer and has no verify_fun must have %% some trusted certs. -ca_cert_default(verify_peer, server) -> +ca_cert_default(verify_peer, undefined, _) -> "". emulated_options() -> diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 5026c760bd..6cf57ced81 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -34,7 +34,8 @@ -export([trusted_cert_and_path/2, certificate_chain/2, file_to_certificats/1, - validate_extensions/6, + %validate_extensions/6, + validate_extension/3, is_valid_extkey_usage/2, is_valid_key_usage/2, select_extension/2, @@ -110,32 +111,25 @@ file_to_certificats(File) -> {ok, List} = ssl_manager:cache_pem_file(File), [Bin || {'Certificate', Bin, not_encrypted} <- List]. %%-------------------------------------------------------------------- --spec validate_extensions([#'Extension'{}], term(), [#'Extension'{}], - boolean(), list(), client | server) -> {[#'Extension'{}], term(), list()}. +-spec validate_extension(term(), #'Extension'{}, term()) -> {valid, term()} | + {fail, tuple()} | + {unknown, term()}. %% %% Description: Validates ssl/tls specific extensions %%-------------------------------------------------------------------- -validate_extensions([], ValidationState, UnknownExtensions, _, AccErr, _) -> - {UnknownExtensions, ValidationState, AccErr}; - -validate_extensions([#'Extension'{extnID = ?'id-ce-extKeyUsage', - extnValue = KeyUse, - critical = true} | Rest], - ValidationState, UnknownExtensions, Verify, AccErr0, Role) -> +validate_extension(_,{extension, #'Extension'{extnID = ?'id-ce-extKeyUsage', + extnValue = KeyUse, + critical = true}}, Role) -> case is_valid_extkey_usage(KeyUse, Role) of true -> - validate_extensions(Rest, ValidationState, UnknownExtensions, - Verify, AccErr0, Role); + {valid, Role}; false -> - AccErr = - not_valid_extension({bad_cert, invalid_ext_key_usage}, Verify, AccErr0), - validate_extensions(Rest, ValidationState, UnknownExtensions, Verify, AccErr, Role) + {fail, {bad_cert, invalid_ext_key_usage}} end; - -validate_extensions([Extension | Rest], ValidationState, UnknownExtensions, - Verify, AccErr, Role) -> - validate_extensions(Rest, ValidationState, [Extension | UnknownExtensions], - Verify, AccErr, Role). +validate_extension(_, {bad_cert, _} = Reason, _) -> + {fail, Reason}; +validate_extension(_, _, Role) -> + {unknown, Role}. %%-------------------------------------------------------------------- -spec is_valid_key_usage(list(), term()) -> boolean(). @@ -248,8 +242,3 @@ is_valid_extkey_usage(KeyUse, client) -> is_valid_extkey_usage(KeyUse, server) -> %% Server wants to verify client is_valid_key_usage(KeyUse, ?'id-kp-clientAuth'). - -not_valid_extension(Error, true, _) -> - throw(Error); -not_valid_extension(Error, false, AccErrors) -> - [Error | AccErrors]. diff --git a/lib/ssl/src/ssl_certificate_db.erl b/lib/ssl/src/ssl_certificate_db.erl index 00d3079cb3..86477f369d 100644 --- a/lib/ssl/src/ssl_certificate_db.erl +++ b/lib/ssl/src/ssl_certificate_db.erl @@ -74,12 +74,16 @@ lookup_cached_certs(File) -> ets:lookup(certificate_db_name(), {file, File}). %%-------------------------------------------------------------------- --spec add_trusted_certs(pid(), string(), certdb_ref()) -> {ok, certdb_ref()}. +-spec add_trusted_certs(pid(), string() | {der, list()}, certdb_ref()) -> {ok, certdb_ref()}. %% %% Description: Adds the trusted certificates from file <File> to the %% runtime database. Returns Ref that should be handed to lookup_trusted_cert %% together with the cert serialnumber and issuer. %%-------------------------------------------------------------------- +add_trusted_certs(_Pid, {der, DerList}, [CerDb, _,_]) -> + NewRef = make_ref(), + add_certs_from_der(DerList, NewRef, CerDb), + {ok, NewRef}; add_trusted_certs(Pid, File, [CertsDb, FileToRefDb, PidToFileDb]) -> Ref = case lookup(File, FileToRefDb) of undefined -> @@ -93,7 +97,6 @@ add_trusted_certs(Pid, File, [CertsDb, FileToRefDb, PidToFileDb]) -> end, insert(Pid, File, PidToFileDb), {ok, Ref}. - %%-------------------------------------------------------------------- -spec cache_pem_file(pid(), string(), certdb_ref()) -> term(). %% @@ -202,16 +205,20 @@ lookup(Key, Db) -> remove_certs(Ref, CertsDb) -> ets:match_delete(CertsDb, {{Ref, '_', '_'}, '_'}). +add_certs_from_der(DerList, Ref, CertsDb) -> + Add = fun(Cert) -> add_certs(Cert, Ref, CertsDb) end, + [Add(Cert) || Cert <- DerList]. + add_certs_from_file(File, Ref, CertsDb) -> - Add = fun(Cert) -> - ErlCert = public_key:pkix_decode_cert(Cert, otp), - TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate, - SerialNumber = TBSCertificate#'OTPTBSCertificate'.serialNumber, - Issuer = public_key:pkix_normalize_name( - TBSCertificate#'OTPTBSCertificate'.issuer), - insert({Ref, SerialNumber, Issuer}, {Cert,ErlCert}, CertsDb) - end, + Add = fun(Cert) -> add_certs(Cert, Ref, CertsDb) end, {ok, PemBin} = file:read_file(File), PemEntries = public_key:pem_decode(PemBin), [Add(Cert) || {'Certificate', Cert, not_encrypted} <- PemEntries]. +add_certs(Cert, Ref, CertsDb) -> + ErlCert = public_key:pkix_decode_cert(Cert, otp), + TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate, + SerialNumber = TBSCertificate#'OTPTBSCertificate'.serialNumber, + Issuer = public_key:pkix_normalize_name( + TBSCertificate#'OTPTBSCertificate'.issuer), + insert({Ref, SerialNumber, Issuer}, {Cert,ErlCert}, CertsDb). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index dd8f77a0ca..c94199c336 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -500,8 +500,7 @@ certify(#certificate{} = Cert, ssl_options = Opts} = State) -> case ssl_handshake:certify(Cert, CertDbRef, Opts#ssl_options.depth, Opts#ssl_options.verify, - Opts#ssl_options.verify_fun, - Opts#ssl_options.validate_extensions_fun, Role) of + Opts#ssl_options.verify_fun, Role) of {PeerCert, PublicKeyInfo} -> handle_peer_cert(PeerCert, PublicKeyInfo, State#state{client_certificate_requested = false}); @@ -1035,23 +1034,32 @@ ssl_init(SslOpts, Role) -> PrivateKey = init_private_key(SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile, SslOpts#ssl_options.password, Role), - DHParams = init_diffie_hellman(SslOpts#ssl_options.dhfile, Role), + DHParams = init_diffie_hellman(SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role), {ok, CertDbRef, CacheRef, OwnCert, PrivateKey, DHParams}. -init_certificates(#ssl_options{cacertfile = CACertFile, - certfile = CertFile}, Role) -> + +init_certificates(#ssl_options{cacerts = CaCerts, + cacertfile = CACertFile, + certfile = CertFile, + cert = Cert}, Role) -> {ok, CertDbRef, CacheRef} = try - {ok, _, _} = ssl_manager:connection_init(CACertFile, Role) + Certs = case CaCerts of + undefined -> + CACertFile; + _ -> + {der, CaCerts} + end, + {ok, _, _} = ssl_manager:connection_init(Certs, Role) catch Error:Reason -> handle_file_error(?LINE, Error, Reason, CACertFile, ecacertfile, erlang:get_stacktrace()) end, - init_certificates(CertDbRef, CacheRef, CertFile, Role). + init_certificates(Cert, CertDbRef, CacheRef, CertFile, Role). -init_certificates(CertDbRef, CacheRef, CertFile, client) -> +init_certificates(undefined, CertDbRef, CacheRef, CertFile, client) -> try [OwnCert] = ssl_certificate:file_to_certificats(CertFile), {ok, CertDbRef, CacheRef, OwnCert} @@ -1059,7 +1067,7 @@ init_certificates(CertDbRef, CacheRef, CertFile, client) -> {ok, CertDbRef, CacheRef, undefined} end; -init_certificates(CertDbRef, CacheRef, CertFile, server) -> +init_certificates(undefined, CertDbRef, CacheRef, CertFile, server) -> try [OwnCert] = ssl_certificate:file_to_certificats(CertFile), {ok, CertDbRef, CacheRef, OwnCert} @@ -1067,7 +1075,9 @@ init_certificates(CertDbRef, CacheRef, CertFile, server) -> Error:Reason -> handle_file_error(?LINE, Error, Reason, CertFile, ecertfile, erlang:get_stacktrace()) - end. + end; +init_certificates(Cert, CertDbRef, CacheRef, _, _) -> + {ok, CertDbRef, CacheRef, Cert}. init_private_key(undefined, "", _Password, client) -> undefined; @@ -1084,8 +1094,10 @@ init_private_key(undefined, KeyFile, Password, _) -> erlang:get_stacktrace()) end; -init_private_key(PrivateKey, _, _,_) -> - PrivateKey. +init_private_key({rsa, PrivateKey}, _, _,_) -> + public_key:der_decode('RSAPrivateKey', PrivateKey); +init_private_key({dsa, PrivateKey},_,_,_) -> + public_key:der_decode('DSAPrivateKey', PrivateKey). handle_file_error(Line, Error, {badmatch, Reason}, File, Throw, Stack) -> file_error(Line, Error, Reason, File, Throw, Stack); @@ -1099,11 +1111,13 @@ file_error(Line, Error, Reason, File, Throw, Stack) -> error_logger:error_report(Report), throw(Throw). -init_diffie_hellman(_, client) -> +init_diffie_hellman(Params, _,_) when is_binary(Params)-> + public_key:der_decode('DHParameter', Params); +init_diffie_hellman(_,_, client) -> undefined; -init_diffie_hellman(undefined, _) -> +init_diffie_hellman(_,undefined, _) -> ?DEFAULT_DIFFIE_HELLMAN_PARAMS; -init_diffie_hellman(DHParamFile, server) -> +init_diffie_hellman(_, DHParamFile, server) -> try {ok, List} = ssl_manager:cache_pem_file(DHParamFile), case [Entry || Entry = {'DHParameter', _ , _} <- List] of diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index add5147fb4..99bc47f04b 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -32,15 +32,13 @@ -include_lib("public_key/include/public_key.hrl"). -export([master_secret/4, client_hello/5, server_hello/4, hello/4, - hello_request/0, certify/7, certificate/3, - client_certificate_verify/6, - certificate_verify/6, certificate_request/2, - key_exchange/2, server_key_exchange_hash/2, finished/4, - verify_connection/5, - get_tls_handshake/2, decode_client_key/3, - server_hello_done/0, sig_alg/1, - encode_handshake/3, init_hashes/0, - update_hashes/2, decrypt_premaster_secret/2]). + hello_request/0, certify/6, certificate/3, + client_certificate_verify/6, certificate_verify/6, + certificate_request/2, key_exchange/2, server_key_exchange_hash/2, + finished/4, verify_connection/5, get_tls_handshake/2, + decode_client_key/3, server_hello_done/0, sig_alg/1, + encode_handshake/3, init_hashes/0, update_hashes/2, + decrypt_premaster_secret/2]). -type tls_handshake() :: #client_hello{} | #server_hello{} | #server_hello_done{} | #certificate{} | #certificate_request{} | @@ -177,59 +175,55 @@ hello(#client_hello{client_version = ClientVersion, random = Random, %%-------------------------------------------------------------------- -spec certify(#certificate{}, term(), integer() | nolimit, - verify_peer | verify_none, fun(), fun(), + verify_peer | verify_none, {fun(), term}, client | server) -> {der_cert(), public_key_info()} | #alert{}. %% %% Description: Handles a certificate handshake message %%-------------------------------------------------------------------- -certify(#certificate{asn1_certificates = ASN1Certs}, CertDbRef, - MaxPathLen, Verify, VerifyFun, ValidateFun, Role) -> +certify(#certificate{asn1_certificates = ASN1Certs}, CertDbRef, + MaxPathLen, _Verify, VerifyFunAndState, Role) -> [PeerCert | _] = ASN1Certs, - VerifyBool = verify_bool(Verify), - ValidateExtensionFun = - case ValidateFun of + ValidationFunAndState = + case VerifyFunAndState of undefined -> - fun(Extensions, ValidationState, Verify0, AccError) -> - ssl_certificate:validate_extensions(Extensions, ValidationState, - [], Verify0, AccError, Role) - end; - Fun -> - fun(Extensions, ValidationState, Verify0, AccError) -> - {NewExtensions, NewValidationState, NewAccError} - = ssl_certificate:validate_extensions(Extensions, ValidationState, - [], Verify0, AccError, Role), - Fun(NewExtensions, NewValidationState, Verify0, NewAccError) - end + {fun(OtpCert, ExtensionOrError, SslState) -> + ssl_certificate:validate_extension(OtpCert, + ExtensionOrError, SslState) + end, Role}; + {Fun, UserState0} -> + {fun(OtpCert, ExtensionOrError, {SslState, UserState}) -> + case ssl_certificate:validate_extension(OtpCert, + ExtensionOrError, + SslState) of + {valid, _} -> + apply_user_fun(Fun, OtpCert, + ExtensionOrError, UserState, + SslState); + {fail, Reason} -> + apply_user_fun(Fun, OtpCert, Reason, UserState, + SslState); + {unknown, _} -> + apply_user_fun(Fun, OtpCert, + ExtensionOrError, UserState, SslState) + end + end, {Role, UserState0}} end, - try - ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbRef) of - {TrustedErlCert, CertPath} -> - Result = public_key:pkix_path_validation(TrustedErlCert, - CertPath, - [{max_path_length, - MaxPathLen}, - {verify, VerifyBool}, - {validate_extensions_fun, - ValidateExtensionFun}]), - case Result of - {error, Reason} -> - path_validation_alert(Reason, Verify); - {ok, {PublicKeyInfo,_, []}} -> - {PeerCert, PublicKeyInfo}; - {ok, {PublicKeyInfo,_, AccErrors = [Error | _]}} -> - case VerifyFun(AccErrors) of - true -> - {PeerCert, PublicKeyInfo}; - false -> - path_validation_alert(Error, Verify) - end - end - catch - throw:Alert -> - Alert + + {TrustedErlCert, CertPath} = + ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbRef), + + case public_key:pkix_path_validation(TrustedErlCert, + CertPath, + [{max_path_length, + MaxPathLen}, + {verify_fun, ValidationFunAndState}]) of + {ok, {PublicKeyInfo,_}} -> + {PeerCert, PublicKeyInfo}; + {error, Reason} -> + path_validation_alert(Reason) end. - + %%-------------------------------------------------------------------- -spec certificate(der_cert(), term(), client | server) -> #certificate{} | #alert{}. %% @@ -490,26 +484,21 @@ get_tls_handshake_aux(<<?BYTE(Type), ?UINT24(Length), get_tls_handshake_aux(Data, Acc) -> {lists:reverse(Acc), Data}. -verify_bool(verify_peer) -> - true; -verify_bool(verify_none) -> - false. - -path_validation_alert({bad_cert, cert_expired}, _) -> +path_validation_alert({bad_cert, cert_expired}) -> ?ALERT_REC(?FATAL, ?CERTIFICATE_EXPIRED); -path_validation_alert({bad_cert, invalid_issuer}, _) -> +path_validation_alert({bad_cert, invalid_issuer}) -> ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE); -path_validation_alert({bad_cert, invalid_signature} , _) -> +path_validation_alert({bad_cert, invalid_signature}) -> ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE); -path_validation_alert({bad_cert, name_not_permitted}, _) -> +path_validation_alert({bad_cert, name_not_permitted}) -> ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE); -path_validation_alert({bad_cert, unknown_critical_extension}, _) -> +path_validation_alert({bad_cert, unknown_critical_extension}) -> ?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE); -path_validation_alert({bad_cert, cert_revoked}, _) -> +path_validation_alert({bad_cert, cert_revoked}) -> ?ALERT_REC(?FATAL, ?CERTIFICATE_REVOKED); -path_validation_alert({bad_cert, unknown_ca}, _) -> +path_validation_alert({bad_cert, unknown_ca}) -> ?ALERT_REC(?FATAL, ?UNKNOWN_CA); -path_validation_alert(_, _) -> +path_validation_alert(_) -> ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE). select_session(Hello, Port, Session, Version, @@ -1132,3 +1121,13 @@ key_exchange_alg(Alg) when Alg == dhe_rsa; Alg == dhe_dss; ?KEY_EXCHANGE_DIFFIE_HELLMAN; key_exchange_alg(_) -> ?NULL. + +apply_user_fun(Fun, OtpCert, ExtensionOrError, UserState0, SslState) -> + case Fun(OtpCert, ExtensionOrError, UserState0) of + {valid, UserState} -> + {valid, {SslState, UserState}}; + {fail, _} = Fail -> + Fail; + {unknown, UserState} -> + {unknown, {SslState, UserState}} + end. diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 337403531e..ddb05e70f6 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -63,10 +63,13 @@ validate_extensions_fun, depth, % integer() certfile, % file() + cert, % der_encoded() keyfile, % file() - key, % + key, % der_encoded() password, % + cacerts, % [der_encoded()] cacertfile, % file() + dh, % der_encoded() dhfile, % file() ciphers, % %% Local policy for the server if it want's to reuse the session diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 459dcefb79..0116466677 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -69,12 +69,12 @@ start_link(Opts) -> gen_server:start_link({local, ?MODULE}, ?MODULE, [Opts], []). %%-------------------------------------------------------------------- --spec connection_init(string(), client | server) -> {ok, reference(), cache_ref()}. +-spec connection_init(string()| {der, list()}, client | server) -> {ok, reference(), cache_ref()}. %% %% Description: Do necessary initializations for a new connection. %%-------------------------------------------------------------------- -connection_init(TrustedcertsFile, Role) -> - call({connection_init, TrustedcertsFile, Role}). +connection_init(Trustedcerts, Role) -> + call({connection_init, Trustedcerts, Role}). %%-------------------------------------------------------------------- -spec cache_pem_file(string()) -> {ok, term()}. %% @@ -185,13 +185,13 @@ handle_call({{connection_init, "", _Role}, Pid}, _From, Result = {ok, make_ref(), Cache}, {reply, Result, State}; -handle_call({{connection_init, TrustedcertsFile, _Role}, Pid}, _From, +handle_call({{connection_init, Trustedcerts, _Role}, Pid}, _From, #state{certificate_db = Db, session_cache = Cache} = State) -> erlang:monitor(process, Pid), Result = try - {ok, Ref} = ssl_certificate_db:add_trusted_certs(Pid, TrustedcertsFile, Db), + {ok, Ref} = ssl_certificate_db:add_trusted_certs(Pid, Trustedcerts, Db), {ok, Ref, Cache} catch _:Reason -> diff --git a/lib/ssl/src/ssl_session.erl b/lib/ssl/src/ssl_session.erl index 6db13e5b7a..25e7445180 100644 --- a/lib/ssl/src/ssl_session.erl +++ b/lib/ssl/src/ssl_session.erl @@ -1,7 +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 @@ -113,7 +113,7 @@ select_session(Sessions, #ssl_options{ciphers = Ciphers, List -> hd(List) end. - + %% If we can not generate a not allready in use session ID in %% ?GEN_UNIQUE_ID_MAX_TRIES we make the new session uncacheable The %% value of ?GEN_UNIQUE_ID_MAX_TRIES is stolen from open SSL which diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index d50b34b6ac..1e96880801 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -232,10 +232,11 @@ all(suite) -> server_renegotiate, client_renegotiate_reused_session, server_renegotiate_reused_session, client_no_wrap_sequence_number, server_no_wrap_sequence_number, extended_key_usage, - validate_extensions_fun, no_authority_key_identifier, + no_authority_key_identifier, invalid_signature_client, invalid_signature_server, cert_expired, client_with_cert_cipher_suites_handshake, unknown_server_ca_fail, - unknown_server_ca_accept + der_input, unknown_server_ca_accept_verify_none, unknown_server_ca_accept_verify_peer, + unknown_server_ca_accept_backwardscompatibilty ]. %% Test cases starts here. @@ -1260,7 +1261,6 @@ eoptions(Config) when is_list(Config) -> {verify_fun, function}, {fail_if_no_peer_cert, 0}, {verify_client_once, 1}, - {validate_extensions_fun, function}, {depth, four}, {certfile, 'cert.pem'}, {keyfile,'key.pem' }, @@ -2271,14 +2271,7 @@ client_verify_none_active_once(Config) when is_list(Config) -> {mfa, {?MODULE, send_recv_result_active_once, []}}, {options, [{active, once} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), - %% TODO: send message to test process to make sure - %% verifyfun has beeen run as it has the same behavior as - %% the default fun - VerifyFun = fun([{bad_cert, unknown_ca}]) -> - true; - (_) -> - false - end, + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, @@ -2286,8 +2279,7 @@ client_verify_none_active_once(Config) when is_list(Config) -> send_recv_result_active_once, []}}, {options, [{active, once}, - {verify, verify_none}, - {verify_fun, VerifyFun} + {verify, verify_none} | ClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -2578,41 +2570,6 @@ extended_key_usage(Config) when is_list(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- -validate_extensions_fun(doc) -> - ["Test that it is possible to specify a validate_extensions_fun"]; - -validate_extensions_fun(suite) -> - []; - -validate_extensions_fun(Config) when is_list(Config) -> - ClientOpts = ?config(client_verification_opts, Config), - ServerOpts = ?config(server_verification_opts, Config), - - Fun = fun(Extensions, State, _, AccError) -> - {Extensions, State, AccError} - end, - - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - - Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {?MODULE, send_recv_result_active, []}}, - {options, [{validate_extensions_fun, Fun}, - {verify, verify_peer} | ServerOpts]}]), - Port = ssl_test_lib:inet_port(Server), - - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {?MODULE, send_recv_result_active, []}}, - {options,[{validate_extensions_fun, Fun} | ClientOpts]}]), - - ssl_test_lib:check_result(Server, ok, Client, ok), - - ssl_test_lib:close(Server), - ssl_test_lib:close(Client). - -%%-------------------------------------------------------------------- no_authority_key_identifier(doc) -> ["Test cert that does not have authorityKeyIdentifier extension" " but are present in trusted certs db."]; @@ -2749,7 +2706,7 @@ invalid_signature_client(Config) when is_list(Config) -> tcp_delivery_workaround(Server, {error, "bad certificate"}, Client, {error,"bad certificate"}). -tcp_delivery_workaround(Server, ServMsg, Client, ClientMsg) -> +tcp_delivery_workaround(Server, ServerMsg, Client, ClientMsg) -> receive {Server, ServerMsg} -> receive @@ -2899,24 +2856,34 @@ unknown_server_ca_fail(Config) when is_list(Config) -> no_result, []}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), + + FunAndState = {fun(_,{bad_cert, _} = Reason, _) -> + {fail, Reason}; + (_,{extension, _}, UserState) -> + {unknown, UserState} + end, []}, + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, {mfa, {ssl_test_lib, no_result, []}}, {options, - [{verify, verify_peer}| ClientOpts]}]), + [{verify, verify_peer}, + {verify_fun, FunAndState} + | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error,"unknown ca"}, Client, {error, "unknown ca"}), + ssl_test_lib:check_result(Server, {error,"unknown ca"}, + Client, {error, "unknown ca"}), ssl_test_lib:close(Server), ssl_test_lib:close(Client). %%-------------------------------------------------------------------- -unknown_server_ca_accept(doc) -> +unknown_server_ca_accept_verify_none(doc) -> ["Test that the client succeds if the ca is unknown in verify_none mode"]; -unknown_server_ca_accept(suite) -> +unknown_server_ca_accept_verify_none(suite) -> []; -unknown_server_ca_accept(Config) when is_list(Config) -> +unknown_server_ca_accept_verify_none(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), ServerOpts = ?config(server_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -2937,6 +2904,137 @@ unknown_server_ca_accept(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), ssl_test_lib:close(Client). +%%-------------------------------------------------------------------- +unknown_server_ca_accept_verify_peer(doc) -> + ["Test that the client succeds if the ca is unknown in verify_peer mode" + " with a verify_fun that accepts the unknown ca error"]; +unknown_server_ca_accept_verify_peer(suite) -> + []; +unknown_server_ca_accept_verify_peer(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, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, + send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + FunAndState = {fun(_,{bad_cert, unknown_ca}, UserState) -> + {valid, UserState}; + (_,{bad_cert, _} = Reason, _) -> + {fail, Reason}; + (_,{extension, _}, UserState) -> + {unknown, UserState} + end, []}, + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + send_recv_result_active, []}}, + {options, + [{verify, verify_peer}, + {verify_fun, FunAndState}| ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- +unknown_server_ca_accept_backwardscompatibilty(doc) -> + ["Test that the client succeds if the ca is unknown in verify_none mode"]; +unknown_server_ca_accept_backwardscompatibilty(suite) -> + []; +unknown_server_ca_accept_backwardscompatibilty(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, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, + send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + AcceptBadCa = fun({bad_cert,unknown_ca}, Acc) -> Acc; + (Other, Acc) -> [Other | Acc] + end, + VerifyFun = + fun(ErrorList) -> + case lists:foldl(AcceptBadCa, [], ErrorList) of + [] -> true; + [_|_] -> false + end + end, + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + send_recv_result_active, []}}, + {options, + [{verify, verify_peer}, + {verify_fun, VerifyFun}| ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- +der_input(doc) -> + ["Test to input certs and key as der"]; + +der_input(suite) -> + []; + +der_input(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + DHParamFile = filename:join(DataDir, "dHParam.pem"), + + SeverVerifyOpts = ?config(server_verification_opts, Config), + {ServerCert, ServerKey, ServerCaCerts, DHParams} = der_input_opts([{dhfile, DHParamFile} | + SeverVerifyOpts]), + ClientVerifyOpts = ?config(client_verification_opts, Config), + {ClientCert, ClientKey, ClientCaCerts, DHParams} = der_input_opts([{dhfile, DHParamFile} | + ClientVerifyOpts]), + ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true}, + {dh, DHParams}, + {cert, ServerCert}, {key, ServerKey}, {cacerts, ServerCaCerts}], + ClientOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true}, + {dh, DHParams}, + {cert, ClientCert}, {key, ClientKey}, {cacerts, ClientCaCerts}], + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result, []}}, + {options, [{active, false} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result, []}}, + {options, [{active, false} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +der_input_opts(Opts) -> + Certfile = proplists:get_value(certfile, Opts), + CaCertsfile = proplists:get_value(cacertfile, 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), + [{_, 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}. %%-------------------------------------------------------------------- %%% Internal functions diff --git a/lib/stdlib/doc/src/erl_id_trans.xml b/lib/stdlib/doc/src/erl_id_trans.xml index 7c821d2efc..cfb18ec131 100644 --- a/lib/stdlib/doc/src/erl_id_trans.xml +++ b/lib/stdlib/doc/src/erl_id_trans.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>1996</year> - <year>2007</year> + <year>2010</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -70,7 +70,8 @@ <section> <title>See Also</title> - <p><seealso marker="erl_parse">erl_parse(3)</seealso>, compile(3).</p> + <p><seealso marker="erl_parse">erl_parse(3)</seealso>, + <seealso marker="compiler:compile">compile(3)</seealso>.</p> </section> </erlref> diff --git a/lib/stdlib/doc/src/erl_lint.xml b/lib/stdlib/doc/src/erl_lint.xml index 6a7d37765c..8639d678fa 100644 --- a/lib/stdlib/doc/src/erl_lint.xml +++ b/lib/stdlib/doc/src/erl_lint.xml @@ -96,8 +96,8 @@ <p>The <c>AbsForms</c> of a module which comes from a file that is read through <c>epp</c>, the Erlang pre-processor, can come from many files. This means that any references to - errors must include the file name (see <seealso marker="epp">epp(3)</seealso>, or parser <seealso marker="erl_parse">erl_parse(3)</seealso> The warnings and - errors returned have the following format: + errors must include the file name (see <seealso marker="epp">epp(3)</seealso>, or parser <seealso marker="erl_parse">erl_parse(3)</seealso>). + The warnings and errors returned have the following format: </p> <code type="none"> [{FileName2,[ErrorInfo]}] </code> diff --git a/lib/stdlib/doc/src/erl_parse.xml b/lib/stdlib/doc/src/erl_parse.xml index ae8a8afd5c..18b592deea 100644 --- a/lib/stdlib/doc/src/erl_parse.xml +++ b/lib/stdlib/doc/src/erl_parse.xml @@ -39,7 +39,7 @@ expressions, or terms. The Abstract Format is described in the ERTS User's Guide. Note that a token list must end with the <em>dot</em> token in order - to be acceptable to the parse functions (see erl_scan).</p> + to be acceptable to the parse functions (see <seealso marker="erl_scan">erl_scan(3)</seealso>).</p> </description> <funcs> <func> diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml index b3ad7aaf46..92c4eb4f4c 100644 --- a/lib/stdlib/doc/src/lists.xml +++ b/lib/stdlib/doc/src/lists.xml @@ -220,7 +220,7 @@ follows:</p> <code type="none"> flatmap(Fun, List1) -> - append(map(Fun, List1))</code> + append(map(Fun, List1)).</code> <p>Example:</p> <pre> > <input>lists:flatmap(fun(X)->[X,X] end, [a,b,c]).</input> @@ -523,7 +523,7 @@ flatmap(Fun, List1) -> <v> A = B = term()</v> </type> <desc> - <p><c>mapfold</c> combines the operations of <c>map/2</c> and + <p><c>mapfoldl</c> combines the operations of <c>map/2</c> and <c>foldl/3</c> into one pass. An example, summing the elements in a list and double them at the same time:</p> <pre> @@ -543,7 +543,7 @@ flatmap(Fun, List1) -> <v> A = B = term()</v> </type> <desc> - <p><c>mapfold</c> combines the operations of <c>map/2</c> and + <p><c>mapfoldr</c> combines the operations of <c>map/2</c> and <c>foldr/3</c> into one pass.</p> </desc> </func> diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml index 10ead62073..8cbfb9387b 100644 --- a/lib/stdlib/doc/src/sys.xml +++ b/lib/stdlib/doc/src/sys.xml @@ -34,7 +34,7 @@ <module>sys</module> <modulesummary>A Functional Interface to System Messages</modulesummary> <description> - <p>This module contains functions for sending system messages used by programs, and messaged used for debugging purposes. + <p>This module contains functions for sending system messages used by programs, and messages used for debugging purposes. </p> <p>Functions used for implementation of processes should also understand system messages such as debugging diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile index d55a3a597d..3dca55178d 100644 --- a/lib/test_server/src/Makefile +++ b/lib/test_server/src/Makefile @@ -139,7 +139,7 @@ release_tests_spec: opt $(TARGET_FILES) $(TS_TARGET_FILES) \ $(AUTOCONF_FILES) $(C_FILES) $(COVER_FILES) $(CONFIG) \ $(RELEASE_PATH)/test_server - $(INSTALL_PROGRAM) $(PROGRAMS) $(RELEASE_PATH)/test_server + $(INSTALL_SCRIPT) $(PROGRAMS) $(RELEASE_PATH)/test_server release_docs_spec: diff --git a/lib/test_server/test/Makefile b/lib/test_server/test/Makefile index 702d73f5af..fcb1282d16 100644 --- a/lib/test_server/test/Makefile +++ b/lib/test_server/test/Makefile @@ -88,7 +88,7 @@ release_spec: opt release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) $(COVERFILE) $(RELSYSDIR) - $(INSTALL_PROGRAM) test_server.spec $(RELSYSDIR) + $(INSTALL_DATA) test_server.spec $(RELSYSDIR) chmod -f -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) diff --git a/lib/tools/doc/src/erlang_mode.xml b/lib/tools/doc/src/erlang_mode.xml index 912c442153..c21afc1f9b 100644 --- a/lib/tools/doc/src/erlang_mode.xml +++ b/lib/tools/doc/src/erlang_mode.xml @@ -173,7 +173,7 @@ sum(L) -> sum(L, 0). sum([H|T], Sum) -> sum(T, Sum + H); - sum([], Sum) -> Sum."</code> + sum([], Sum) -> Sum.</code> </item> </list> </section> diff --git a/lib/tools/doc/src/erlang_mode_chapter.xml b/lib/tools/doc/src/erlang_mode_chapter.xml index b22c6b1809..8aabd6ae74 100644 --- a/lib/tools/doc/src/erlang_mode_chapter.xml +++ b/lib/tools/doc/src/erlang_mode_chapter.xml @@ -45,7 +45,7 @@ <section> <title>Elisp</title> - <p>There are two Elsip modules include in this tool package + <p>There are two Elisp modules included in this tool package for Emacs. There is erlang.el that defines the actual erlang mode and there is erlang-start.el that makes some nice initializations.</p> </section> diff --git a/lib/wx/test/Makefile b/lib/wx/test/Makefile index 71b79aa272..dfec4bb695 100644 --- a/lib/wx/test/Makefile +++ b/lib/wx/test/Makefile @@ -63,7 +63,7 @@ release_spec: release_tests_spec: opt $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) wx.spec wx_test_lib.hrl $(ErlSrc) $(ErlTargets) $(RELSYSDIR) - $(INSTALL_PROGRAM) wxt $(RELSYSDIR) + $(INSTALL_SCRIPT) wxt $(RELSYSDIR) release_docs_spec: diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 4e5cc59d8f..e2e6f95c4a 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. -%% +%% +%% 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% %% @@ -2602,8 +2602,7 @@ scan_reference("#x" ++ T, S0) -> %% [66] CharRef ?bump_col(1), if hd(T) /= $; -> - {[Ch], T2, S2} = scan_char_ref_hex(T, S, 0), - {to_char_set(S2#xmerl_scanner.encoding,Ch),T2,S2}; + scan_char_ref_hex(T, S, 0); true -> ?fatal(invalid_char_ref, S) end; @@ -3452,14 +3451,14 @@ scan_entity_value("%" ++ T, S0, Delim, Acc, PEName,Namespace,PENesting) -> %% {system,URI} or {public,URI} %% Included in literal. {ExpRef,Sx}=fetch_not_parse(Tuple,S1), - {EntV,_,_S2} = - scan_entity_value(ExpRef, Sx, no_delim,[], + {EntV, _, S5} = + scan_entity_value(ExpRef, Sx, no_delim,[], PERefName,parameter,[]), %% should do an update Write(parameter_entity) %% so next expand_pe_reference is faster - {EntV,_S2}; + {string_to_char_set(S5#xmerl_scanner.encoding, EntV), S5}; ExpRef -> - {ExpRef,S1} + {string_to_char_set(S1#xmerl_scanner.encoding, ExpRef) ,S1} end, %% single or duoble qoutes are not treated as delimeters %% in passages "included in literal" @@ -4020,12 +4019,12 @@ utf8_2_ucs([A|Rest]) when A < 16#80 -> utf8_2_ucs([A|Rest]) -> {{error,{bad_character,A}},Rest}. -to_char_set("iso-10646-utf-1",Ch) -> - [Ch]; -to_char_set(UTF8,Ch) when UTF8 =:= "utf-8"; UTF8 =:= undefined -> - ucs_2_utf8(Ch); -to_char_set(_,Ch) -> - [Ch]. +%% to_char_set("iso-10646-utf-1",Ch) -> +%% [Ch]; +%% to_char_set(UTF8,Ch) when UTF8 =:= "utf-8"; UTF8 =:= undefined -> +%% ucs_2_utf8(Ch); +%% to_char_set(_,Ch) -> +%% [Ch]. ucs_2_utf8(Ch) when Ch < 128 -> %% 0vvvvvvv diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml index 52dc0c943e..f08639f9a1 100755 --- a/system/doc/reference_manual/typespec.xml +++ b/system/doc/reference_manual/typespec.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2009</year> + <year>2003</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -32,29 +32,24 @@ <section> <title>Introduction of Types</title> <p> - Although Erlang is a dynamically typed language this section describes - an extension to the Erlang language for declaring sets of Erlang terms - to form a particular type, effectively forming a specific sub-type of the - set of all Erlang terms. + Erlang is a dynamically typed language. Still, it comes with a + language extension for declaring sets of Erlang terms to form a + particular type, effectively forming a specific sub-type of the set + of all Erlang terms. </p> <p> - Subsequently, these types can be used to specify types of record fields - and the argument and return types of functions. + Subsequently, these types can be used to specify types of record fields + and the argument and return types of functions. </p> <p> - Type information can be used to document function interfaces, - provide more information for bug detection tools such as <c>Dialyzer</c>, - and can be exploited by documentation tools such as <c>Edoc</c> for - generating program documentation of various forms. - It is expected that the type language described in this document will - supersede and replace the purely comment-based <c>@type</c> and + Type information can be used to document function interfaces, + provide more information for bug detection tools such as <c>Dialyzer</c>, + and can be exploited by documentation tools such as <c>Edoc</c> for + generating program documentation of various forms. + It is expected that the type language described in this document will + supersede and replace the purely comment-based <c>@type</c> and <c>@spec</c> declarations used by <c>Edoc</c>. </p> - <warning> - The syntax and semantics described here is still preliminary and might be - slightly changed and extended before it becomes officially supported. - The plan is that this will happen in R14B. - </warning> </section> <section> <marker id="syntax"></marker> @@ -139,326 +134,334 @@ Tuple :: tuple() %% stands for a tuple of any size TList :: Type | Type, TList ]]></pre> - <p> - Because lists are commonly used, they have shorthand type notations. - The type <c>list(T)</c> has the shorthand <c>[T]</c>. The shorthand <c>[T,...]</c> stands for - the set of non-empty proper lists whose elements are of type <c>T</c>. - The only difference between the two shorthands is that <c>[T]</c> may be an - empty list but <c>[T,...]</c> may not. - </p> - <p> - Notice that the shorthand for <c>list()</c>, i.e. the list of elements of unknown type, - is <c>[_]</c> (or <c>[any()]</c>), not <c>[]</c>. - The notation <c>[]</c> specifies the singleton type for the empty list. - </p> - <p> - For convenience, the following types are also built-in. - They can be thought as predefined aliases for the type unions also shown in - the table. (Some type unions below slightly abuse the syntax of types.) - </p> - <table> - <row> - <cell><b>Built-in type</b></cell><cell><b>Stands for</b></cell> - </row> - <row> - <cell><c>term()</c></cell><cell><c>any()</c></cell> - </row> - <row> - <cell><c>bool()</c></cell><cell><c>'false' | 'true'</c></cell> - </row> - <row> - <cell><c>byte()</c></cell><cell><c>0..255</c></cell> - </row> - <row> - <cell><c>char()</c></cell><cell><c>0..16#10ffff</c></cell> - </row> - <row> - <cell><c>non_neg_integer()</c></cell><cell><c>0..</c></cell> - </row> - <row> - <cell><c>pos_integer()</c></cell><cell><c>1..</c></cell> - </row> - <row> - <cell><c>neg_integer()</c></cell><cell><c>..-1</c></cell> - </row> - <row> - <cell><c>number()</c></cell><cell><c>integer() | float()</c></cell> - </row> - <row> - <cell><c>list()</c></cell><cell><c>[any()]</c></cell> - </row> - <row> - <cell><c>maybe_improper_list()</c></cell><cell><c>maybe_improper_list(any(), any())</c></cell> - </row> - <row> - <cell><c>maybe_improper_list(T)</c></cell><cell><c>maybe_improper_list(T, any())</c></cell> - </row> - <row> - <cell><c>string()</c></cell><cell><c>[char()]</c></cell> - </row> - <row> - <cell><c>nonempty_string()</c></cell><cell><c>[char(),...]</c></cell> - </row> - <row> - <cell><c>iolist()</c></cell><cell><c>maybe_improper_list( -char() | binary() | iolist(), binary() | [])</c></cell> - </row> - <row> - <cell><c>module()</c></cell><cell><c>atom()</c></cell> - </row> - <row> - <cell><c>mfa()</c></cell><cell><c>{atom(),atom(),byte()}</c></cell> - </row> - <row> - <cell><c>node()</c></cell><cell><c>atom()</c></cell> - </row> - <row> - <cell><c>timeout()</c></cell><cell><c>'infinity' | non_neg_integer()</c></cell> - </row> - <row> - <cell><c>no_return()</c></cell><cell><c>none()</c></cell> - </row> - </table> - - <p> - Users are not allowed to define types with the same names as the predefined or - built-in ones. - This is checked by the compiler and its violation results in a compilation - error. - (For bootstrapping purposes, it can also result to just a warning if this - involves a built-in type which has just been introduced.) - </p> - <note> - The following built-in list types also exist, - but they are expected to be rarely used. Hence, they have long names: - </note> - <pre> + <p> + Because lists are commonly used, they have shorthand type notations. + The type <c>list(T)</c> has the shorthand <c>[T]</c>. + The shorthand <c>[T,...]</c> stands for + the set of non-empty proper lists whose elements are of type <c>T</c>. + The only difference between the two shorthands is that <c>[T]</c> may be an + empty list but <c>[T,...]</c> may not. + </p> + <p> + Notice that the shorthand for <c>list()</c>, i.e. the list of + elements of unknown type, is <c>[_]</c> (or <c>[any()]</c>), not <c>[]</c>. + The notation <c>[]</c> specifies the singleton type for the empty list. + </p> + <p> + For convenience, the following types are also built-in. + They can be thought as predefined aliases for the type unions also shown in + the table. (Some type unions below slightly abuse the syntax of types.) + </p> + <table> + <row> + <cell><b>Built-in type</b></cell><cell><b>Stands for</b></cell> + </row> + <row> + <cell><c>term()</c></cell><cell><c>any()</c></cell> + </row> + <row> + <cell><c>boolean()</c></cell><cell><c>'false' | 'true'</c></cell> + </row> + <row> + <cell><c>byte()</c></cell><cell><c>0..255</c></cell> + </row> + <row> + <cell><c>char()</c></cell><cell><c>0..16#10ffff</c></cell> + </row> + <row> + <cell><c>non_neg_integer()</c></cell><cell><c>0..</c></cell> + </row> + <row> + <cell><c>pos_integer()</c></cell><cell><c>1..</c></cell> + </row> + <row> + <cell><c>neg_integer()</c></cell><cell><c>..-1</c></cell> + </row> + <row> + <cell><c>number()</c></cell><cell><c>integer() | float()</c></cell> + </row> + <row> + <cell><c>list()</c></cell><cell><c>[any()]</c></cell> + </row> + <row> + <cell><c>maybe_improper_list()</c></cell><cell><c>maybe_improper_list(any(), any())</c></cell> + </row> + <row> + <cell><c>maybe_improper_list(T)</c></cell><cell><c>maybe_improper_list(T, any())</c></cell> + </row> + <row> + <cell><c>string()</c></cell><cell><c>[char()]</c></cell> + </row> + <row> + <cell><c>nonempty_string()</c></cell><cell><c>[char(),...]</c></cell> + </row> + <row> + <cell><c>iolist()</c></cell><cell><c>maybe_improper_list(char() | binary() | iolist(), binary() | [])</c></cell> + </row> + <row> + <cell><c>module()</c></cell><cell><c>atom()</c></cell> + </row> + <row> + <cell><c>mfa()</c></cell><cell><c>{atom(),atom(),byte()}</c></cell> + </row> + <row> + <cell><c>node()</c></cell><cell><c>atom()</c></cell> + </row> + <row> + <cell><c>timeout()</c></cell><cell><c>'infinity' | non_neg_integer()</c></cell> + </row> + <row> + <cell><c>no_return()</c></cell><cell><c>none()</c></cell> + </row> + </table> + + <p> + Users are not allowed to define types with the same names as the + predefined or built-in ones. This is checked by the compiler and + its violation results in a compilation error. + (For bootstrapping purposes, it can also result to just a warning if this + involves a built-in type which has just been introduced.) + </p> + <note> + The following built-in list types also exist, + but they are expected to be rarely used. Hence, they have long names: + </note> + <pre> nonempty_maybe_improper_list(Type) :: nonempty_maybe_improper_list(Type, any()) -nonempty_maybe_improper_list() :: nonempty_maybe_improper_list(any()) - </pre> - <p> - where the following two types - define the set of Erlang terms one would expect: - </p> - <pre> +nonempty_maybe_improper_list() :: nonempty_maybe_improper_list(any())</pre> + <p> + where the following two types + define the set of Erlang terms one would expect: + </p> + <pre> nonempty_improper_list(Type1, Type2) -nonempty_maybe_improper_list(Type1, Type2) - </pre> - <p> - Also for convenience, we allow for record notation to be used. - Records are just shorthands for the corresponding tuples. - </p> - <pre> +nonempty_maybe_improper_list(Type1, Type2)</pre> + <p> + Also for convenience, we allow for record notation to be used. + Records are just shorthands for the corresponding tuples. + </p> + <pre> Record :: #Erlang_Atom{} - | #Erlang_Atom{Fields} - </pre> + | #Erlang_Atom{Fields}</pre> + <p> + Records have been extended to possibly contain type information. + This is described in the sub-section <seealso marker="#typeinrecords">"Type information in record declarations"</seealso> below. + </p> + </section> + + <section> + <title>Type declarations of user-defined types</title> <p> - Records have been extended to possibly contain type information. - This is described in the sub-section <seealso marker="#typeinrecords">"Type information in record declarations"</seealso> below. - </p> - </section> - - <section> - <title>Type declarations of user-defined types</title> - <p> - As seen, the basic syntax of a type is an atom followed by closed - parentheses. New types are declared using '-type' compiler attributes - as in the following: - </p> - <pre> --type my_type() :: Type. - </pre> - <p> - where the type name is an atom (<c>'my_type'</c> in the above) followed by - parenthesis. Type is a type as defined in the previous section. - A current restriction is that Type can contain only predefined types - or user-defined types which have been previously defined. - This restriction is enforced by the compiler and results in a - compilation error. (A similar restriction currently exists for records). - </p> - <p> - This means that currently general recursive types cannot be defined. - Lifting this restriction is future work. - </p> - <p> - Type declarations can also be parameterized by including type variables - between the parentheses. The syntax of type variables is the same as - Erlang variables (starts with an upper case letter). - Naturally, these variables can - and should - appear on the RHS of the - definition. A concrete example appears below: - </p> - <pre> --type orddict(Key, Val) :: [{Key, Val}]. - </pre> - - </section> - - <marker id="typeinrecords"/> - <section> - <title> - Type information in record declarations - </title> - <p> - The types of record fields can be specified in the declaration of the - record. The syntax for this is: - </p> - <pre> --record(rec, {field1 :: Type1, field2, field3 :: Type3}). - </pre> - <p> - For fields without type annotations, their type defaults to any(). - I.e., the above is a shorthand for: - </p> - <pre> --record(rec, {field1 :: Type1, field2 :: any(), field3 :: Type3}). - </pre> - <p> - In the presence of initial values for fields, - the type must be declared after the initialization as in the following: - </p> - <pre> --record(rec, {field1 = [] :: Type1, field2, field3 = 42 :: Type3}). - </pre> - <p> - Naturally, the initial values for fields should be compatible - with (i.e. a member of) the corresponding types. - This is checked by the compiler and results in a compilation error - if a violation is detected. For fields without initial values, - the singleton type <c>'undefined'</c> is added to all declared types. - In other words, the following two record declarations have identical - effects: - </p> - <pre> + As seen, the basic syntax of a type is an atom followed by closed + parentheses. New types are declared using '-type' and '-opaque' + compiler attributes as in the following: + </p> + <pre> +-type my_struct_type() :: Type. +-opaque my_opaq_type() :: Type.</pre> + <p> + where the type name is an atom (<c>'my_struct_type'</c> in the above) + followed by parentheses. Type is a type as defined in the + previous section. + A current restriction is that Type can contain only predefined types, + or user-defined types which are either module-local (i.e., with a + definition that is present in the code of the module) or are remote + types (i.e., types defined in and exported by other modules; see below). + For module-local types, the restriction that their definition + exists in the module is enforced by the compiler and results in a + compilation error. (A similar restriction currently exists for records.) + </p> + <p> + Type declarations can also be parameterized by including type variables + between the parentheses. The syntax of type variables is the same as + Erlang variables (starts with an upper case letter). + Naturally, these variables can - and should - appear on the RHS of the + definition. A concrete example appears below: + </p> + <pre> +-type orddict(Key, Val) :: [{Key, Val}].</pre> + <p> + A module can export some types in order to declare that other modules + are allowed to refer to them as <em>remote types</em>. + This declaration has the following form: + <pre> +-export_type([T1/A1, ..., Tk/Ak]).</pre> + where the Ti's are atoms (the name of the type) and the Ai's are their + arguments. An example is given below: + <pre> +-export_type([my_struct_type/0, orddict/2]).</pre> + Assuming that these types are exported from module <c>'mod'</c> then + one can refer to them from other modules using remote type expressions + like those below: + <pre> +mod:my_struct_type() +mod:orddict(atom(), term())</pre> + One is not allowed to refer to types which are not declared as exported. + </p> + <p> + Types declared as <c>opaque</c> represent sets of terms whose + structure is not supposed to be visible in any way outside of + their defining module (i.e., only the module defining them is + allowed to depend on their term structure). Consequently, such + types do not make much sense as module local - module local + types are not accessible by other modules anyway - and should + always be exported. + </p> + </section> + + <marker id="typeinrecords"/> + <section> + <title>Type information in record declarations</title> + <p> + The types of record fields can be specified in the declaration of the + record. The syntax for this is: + </p> + <pre> +-record(rec, {field1 :: Type1, field2, field3 :: Type3}).</pre> + <p> + For fields without type annotations, their type defaults to any(). + I.e., the above is a shorthand for: + </p> + <pre> +-record(rec, {field1 :: Type1, field2 :: any(), field3 :: Type3}).</pre> + <p> + In the presence of initial values for fields, + the type must be declared after the initialization as in the following: + </p> + <pre> +-record(rec, {field1 = [] :: Type1, field2, field3 = 42 :: Type3}).</pre> + <p> + Naturally, the initial values for fields should be compatible + with (i.e. a member of) the corresponding types. + This is checked by the compiler and results in a compilation error + if a violation is detected. For fields without initial values, + the singleton type <c>'undefined'</c> is added to all declared types. + In other words, the following two record declarations have identical + effects: + </p> + <pre> -record(rec, {f1 = 42 :: integer(), f2 :: float(), - f3 :: 'a' | 'b'). + f3 :: 'a' | 'b'}). -record(rec, {f1 = 42 :: integer(), f2 :: 'undefined' | float(), - f3 :: 'undefined' | 'a' | 'b'). - </pre> - <p> - For this reason, it is recommended that records contain initializers, - whenever possible. - </p> - <p> - Any record, containing type information or not, once defined, - can be used as a type using the syntax: - </p> - <pre> -#rec{} - </pre> - <p> - In addition, the record fields can be further specified when using - a record type by adding type information about the field in the following - manner: - </p> - <pre> -#rec{some_field :: Type} - </pre> - <p> - Any unspecified fields are assumed to have the type in the original - record declaration. - </p> - </section> + f3 :: 'undefined' | 'a' | 'b'}).</pre> + <p> + For this reason, it is recommended that records contain initializers, + whenever possible. + </p> + <p> + Any record, containing type information or not, once defined, + can be used as a type using the syntax: + </p> + <pre> +#rec{}</pre> + <p> + In addition, the record fields can be further specified when using + a record type by adding type information about the field in + the following manner: + </p> + <pre> +#rec{some_field :: Type}</pre> + <p> + Any unspecified fields are assumed to have the type in the original + record declaration. + </p> + </section> - <section> - <title>Specifications (contracts) for functions</title> - <p> - A contract (or specification) for a function is given using the new - compiler attribute <c>'-spec'</c>. The basic format is as follows: - </p> - <pre> --spec Module:Function(ArgType1, ..., ArgTypeN) -> ReturnType. - </pre> - <p> - The arity of the function has to match the number of arguments, - or else a compilation error occurs. - </p> - <p> - This form can also be used in header files (.hrl) to declare type - information for exported functions. - Then these header files can be included in files that (implicitly or - explicitly) import these functions. - </p> - <p> - For most uses within a given module, the following shorthand is allowed: - </p> - <pre> --spec Function(ArgType1, ..., ArgTypeN) -> ReturnType. - </pre> - <p> - Also, for documentation purposes, argument names can be given: - </p> - <pre> --spec Function(ArgName1 :: Type1, ..., ArgNameN :: TypeN) -> RT. - </pre> - <p> - A function specification can be overloaded. - That is, it can have several types, separated by a semicolon (<c>;</c>): - </p> - <pre> + <section> + <title>Specifications for functions</title> + <p> + A specification (or contract) for a function is given using the new + compiler attribute <c>'-spec'</c>. The general format is as follows: + </p> + <pre> +-spec Module:Function(ArgType1, ..., ArgTypeN) -> ReturnType.</pre> + <p> + The arity of the function has to match the number of arguments, + or else a compilation error occurs. + </p> + <p> + This form can also be used in header files (.hrl) to declare type + information for exported functions. + Then these header files can be included in files that (implicitly or + explicitly) import these functions. + </p> + <p> + For most uses within a given module, the following shorthand suffices: + </p> + <pre> +-spec Function(ArgType1, ..., ArgTypeN) -> ReturnType.</pre> + <p> + Also, for documentation purposes, argument names can be given: + </p> + <pre> +-spec Function(ArgName1 :: Type1, ..., ArgNameN :: TypeN) -> RT.</pre> + <p> + A function specification can be overloaded. + That is, it can have several types, separated by a semicolon (<c>;</c>): + </p> + <pre> -spec foo(T1, T2) -> T3 - ; (T4, T5) -> T6. - </pre> - <p> - A current restriction, which currently results in a warning - (OBS: not an error) by the compiler, is that the domains of the argument - types cannot be overlapping. - For example, the following specification results in a warning: - </p> - <pre> + ; (T4, T5) -> T6.</pre> + <p> + A current restriction, which currently results in a warning + (OBS: not an error) by the compiler, is that the domains of + the argument types cannot be overlapping. + For example, the following specification results in a warning: + </p> + <pre> -spec foo(pos_integer()) -> pos_integer() - ; (integer()) -> integer(). - </pre> - <p> - Type variables can be used in specifications to specify relations for - the input and output arguments of a function. - For example, the following specification defines the type of a - polymorphic identity function: - </p> - <pre> --spec id(X) -> X. - </pre> - <p> - However, note that the above specification does not restrict the input - and output type in any way. - We can constrain these types by guard-like subtype constraints: - </p> - <pre> --spec id(X) -> X when is_subtype(X, tuple()). - </pre> - <p> - and provide bounded quantification. Currently, - the <c>is_subtype/2</c> guard is the only guard which can - be used in a <c>'-spec'</c> attribute. - </p> - <p> - The scope of an <c>is_subtype/2</c> constraint is the - <c>(...) -> RetType</c> - specification after which it appears. To avoid confusion, - we suggest that different variables are used in different constituents of - an overloaded contract as in the example below: - </p> - <pre> --spec foo({X, integer()}) -> X when is_subtype(X, atom()) - ; ([Y]) -> Y when is_subtype(Y, number()). - </pre> - <p> - Some functions in Erlang are not meant to return; - either because they define servers or because they are used to - throw exceptions as the function below: - </p> - <pre> -my_error(Err) -> erlang:throw({error, Err}). - </pre> - <p> - For such functions we recommend the use of the special no_return() - type for their "return", via a contract of the form: - </p> - <pre> --spec my_error(term()) -> no_return(). - </pre> - </section> + ; (integer()) -> integer().</pre> + <p> + Type variables can be used in specifications to specify relations for + the input and output arguments of a function. + For example, the following specification defines the type of a + polymorphic identity function: + </p> + <pre> +-spec id(X) -> X.</pre> + <p> + However, note that the above specification does not restrict the input + and output type in any way. + We can constrain these types by guard-like subtype constraints: + </p> + <pre> +-spec id(X) -> X when is_subtype(X, tuple()).</pre> + <p> + or equivalently by the more succinct and more modern form of the above: + </p> + <pre> +-spec id(X) -> X when X :: tuple().</pre> + <p> + and provide bounded quantification. Currently, the <c>::</c> constraint + (the <c>is_subtype/2</c> guard) is the only guard constraint which can + be used in the <c>'when'</c> part of a <c>'-spec'</c> attribute. + </p> + <p> + The scope of an <c>::</c> constraint is the + <c>(...) -> RetType</c> + specification after which it appears. To avoid confusion, + we suggest that different variables are used in different + constituents of an overloaded contract as in the example below: + </p> + <pre> +-spec foo({X, integer()}) -> X when X :: atom() + ; ([Y]) -> Y when Y :: number().</pre> + <p> + Some functions in Erlang are not meant to return; + either because they define servers or because they are used to + throw exceptions as the function below: + </p> + <pre> +my_error(Err) -> erlang:throw({error, Err}).</pre> + <p> + For such functions we recommend the use of the special no_return() + type for their "return", via a contract of the form: + </p> + <pre> +-spec my_error(term()) -> no_return().</pre> + </section> </chapter> |