diff options
77 files changed, 1439 insertions, 967 deletions
diff --git a/.gitignore b/.gitignore index 71c7b9b33d..6034a21f87 100644 --- a/.gitignore +++ b/.gitignore @@ -191,6 +191,11 @@ a.out.dSYM/ /lib/kernel/src/inet_dns_record_adts.hrl +# kernel + +/lib/mnesia/test/Mnesia.* +/lib/mnesia/test/test_log* + # otp_mibs /lib/otp_mibs/include/[A-Z]*.hrl @@ -221,9 +226,6 @@ a.out.dSYM/ # ssl /lib/ssl/pkix/*.asn1db -/lib/ssl/examples/certs/done -/lib/ssl/examples/certs/ebin/make_certs.beam -/lib/ssl/examples/certs/etc/ /lib/ssl/include/OTP-PKIX.hrl /lib/ssl/pkix/OTP-PKIX.erl /lib/ssl/pkix/OTP-PKIX.hrl diff --git a/erts/configure.in b/erts/configure.in index 6b494ef127..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; @@ -3419,7 +3427,6 @@ AC_SUBST(SSL_LINK_WITH_KERBEROS) AC_SUBST(STATIC_KERBEROS_LIBS) AC_SUBST(SSL_LINK_WITH_ZLIB) AC_SUBST(STATIC_ZLIB_LIBS) -AC_SUBST(OPENSSL_CMD) std_ssl_locations="/usr/local /usr/sfw /opt/local /usr /usr/pkg /usr/local/openssl /usr/lib/openssl /usr/openssl /usr/local/ssl /usr/lib/ssl /usr/ssl" @@ -3611,25 +3618,7 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in SSL_DYNAMIC_ONLY=yes fi SSL_BINDIR="$rdir/bin" -dnl Should one use EXEEXT or ac_exeext? - if test -f "$erl_xcomp_sysroot$SSL_BINDIR/openssl$EXEEXT"; then - if test "$cross_compiling" = "yes"; then - dnl Cannot test it; hope it is working... - OPENSSL_CMD="$erl_xcomp_sysroot$SSL_BINDIR/openssl$EXEEXT" - else - if "$SSL_BINDIR/openssl$EXEEXT" version > /dev/null 2>&1; then - OPENSSL_CMD="$SSL_BINDIR/openssl$EXEEXT" - else - is_real_ssl=no - fi - fi - else - is_real_ssl=no - fi if test "x$is_real_ssl" = "xyes" ; then - if test "$MIXED_CYGWIN" = "yes"; then - OPENSSL_CMD=`cygpath -s -m "$OPENSSL_CMD"` 2> /dev/null - fi SSL_INCLUDE="-I$dir/include" old_CPPFLAGS=$CPPFLAGS CPPFLAGS=$SSL_INCLUDE @@ -3692,7 +3681,6 @@ dnl Should one use EXEEXT or ac_exeext? SSL_RUNTIME_LIB="/usr/lib" SSL_LIB="$erl_xcomp_sysroot/usr/lib" SSL_BINDIR="/usr/sbin" - OPENSSL_CMD="$SSL_BINDIR/openssl" dnl OpenBSD requires us to link with -L and -l SSL_DYNAMIC_ONLY="yes" fi @@ -3778,7 +3766,6 @@ dnl so it is - be adoptable SSL_DYNAMIC_ONLY=yes fi SSL_INCLUDE="-I$with_ssl/include" - OPENSSL_CMD="$with_ssl/bin/openssl" SSL_APP=ssl CRYPTO_APP=crypto SSH_APP=ssh @@ -4175,7 +4162,6 @@ dnl ../lib/ic/c_src/$host/Makefile:../lib/ic/c_src/Makefile.in ../lib/os_mon/c_src/$host/Makefile:../lib/os_mon/c_src/Makefile.in ../lib/ssl/c_src/$host/Makefile:../lib/ssl/c_src/Makefile.in - ../lib/ssl/examples/certs/$host/Makefile:../lib/ssl/examples/certs/Makefile.in ../lib/crypto/c_src/$host/Makefile:../lib/crypto/c_src/Makefile.in ../lib/orber/c_src/$host/Makefile:../lib/orber/c_src/Makefile.in ../lib/runtime_tools/c_src/$host/Makefile:../lib/runtime_tools/c_src/Makefile.in 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..ce7fde05d9 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -2034,12 +2034,14 @@ 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, NIF's where an + experimental feature. Versions of OTP older than R14B might + have different and possibly incompatible NIF semanticts 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 @@ -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 761096e9ad..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) @@ -4009,7 +4036,7 @@ signal_schedulers_bind_change(erts_cpu_topology_t *cpudata, int size) int s_ix = 1; int cpu_ix; - if (cpu_bind_order != ERTS_CPU_BIND_NONE) { + if (cpu_bind_order != ERTS_CPU_BIND_NONE && size) { cpu_bind_order_sort(cpudata, size, cpu_bind_order, 1); @@ -5523,7 +5550,6 @@ late_cpu_bind_init(void) erts_cpu_topology_t *cpudata; int cpudata_size; create_tmp_cpu_topology_copy(&cpudata, &cpudata_size); - ASSERT(cpudata); signal_schedulers_bind_change(cpudata, cpudata_size); destroy_tmp_cpu_topology_copy(cpudata); } @@ -5538,23 +5564,29 @@ erts_update_cpu_info(void) if (changed) { erts_cpu_topology_t *cpudata; int cpudata_size; - erts_free(ERTS_ALC_T_CPUDATA, system_cpudata); - system_cpudata_size = erts_get_cpu_topology_size(erts_cpuinfo); - system_cpudata = erts_alloc(ERTS_ALC_T_CPUDATA, - (sizeof(erts_cpu_topology_t) - * system_cpudata_size)); - - if (!erts_get_cpu_topology(erts_cpuinfo, system_cpudata) - || ERTS_INIT_CPU_TOPOLOGY_OK != verify_topology(system_cpudata, - system_cpudata_size)) { + if (system_cpudata) erts_free(ERTS_ALC_T_CPUDATA, system_cpudata); + + system_cpudata_size = erts_get_cpu_topology_size(erts_cpuinfo); + if (!system_cpudata_size) system_cpudata = NULL; - system_cpudata_size = 0; + else { + system_cpudata = erts_alloc(ERTS_ALC_T_CPUDATA, + (sizeof(erts_cpu_topology_t) + * system_cpudata_size)); + + if (!erts_get_cpu_topology(erts_cpuinfo, system_cpudata) + || (ERTS_INIT_CPU_TOPOLOGY_OK + != verify_topology(system_cpudata, + system_cpudata_size))) { + erts_free(ERTS_ALC_T_CPUDATA, system_cpudata); + system_cpudata = NULL; + system_cpudata_size = 0; + } } create_tmp_cpu_topology_copy(&cpudata, &cpudata_size); - ASSERT(cpudata); signal_schedulers_bind_change(cpudata, cpudata_size); destroy_tmp_cpu_topology_copy(cpudata); } @@ -7164,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/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 4f4458802c..06442bfad6 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -47,6 +47,7 @@ scheduler_bind/1, scheduler_bind_types/1, cpu_topology/1, + update_cpu_info/1, sct_cmd/1, sbt_cmd/1, scheduler_suspend/1, @@ -249,6 +250,7 @@ bound_loop(NS, N, M, Sched) -> scheduler_bind(suite) -> [scheduler_bind_types, cpu_topology, + update_cpu_info, sct_cmd, sbt_cmd]. @@ -772,6 +774,137 @@ cpu_topology_cmdline_test(Config, Topology, Cmd) -> ?line stop_node(Node), ?line ok. +update_cpu_info(Config) when is_list(Config) -> + ?line OldOnline = erlang:system_info(schedulers_online), + ?line OldAff = get_affinity_mask(), + ?line ?t:format("START - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", + [OldAff, OldOnline, erlang:system_info(scheduler_bindings)]), + ?line case {erlang:system_info(logical_processors_available), OldAff} of + {Avail, _} when Avail == unknown; OldAff == unknown -> + %% Nothing much to test; just a smoke test + case erlang:system_info(update_cpu_info) of + unchanged -> ?line ok; + changed -> ?line ok + end; + _ -> + try + ?line adjust_schedulers_online(), + case erlang:system_info(schedulers_online) of + 1 -> + %% Nothing much to test; just a smoke test + ?line ok; + Onln0 -> + %% unset least significant bit + ?line Aff = (OldAff band (OldAff - 1)), + ?line set_affinity_mask(Aff), + ?line Onln1 = Onln0 - 1, + ?line case adjust_schedulers_online() of + {Onln0, Onln1} -> + ?line Onln1 = erlang:system_info(schedulers_online), + ?line receive after 500 -> ok end, + ?line ?t:format("TEST - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", + [Aff, Onln1, erlang:system_info(scheduler_bindings)]), + ?line unchanged = adjust_schedulers_online(), + ?line ok; + Fail -> + ?line ?t:fail(Fail) + end + end + after + set_affinity_mask(OldAff), + adjust_schedulers_online(), + erlang:system_flag(schedulers_online, OldOnline), + receive after 500 -> ok end, + ?t:format("END - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", + [get_affinity_mask(), + erlang:system_info(schedulers_online), + erlang:system_info(scheduler_bindings)]) + end + end. + +adjust_schedulers_online() -> + case erlang:system_info(update_cpu_info) of + unchanged -> + unchanged; + changed -> + Avail = erlang:system_info(logical_processors_available), + {erlang:system_flag(schedulers_online, Avail), Avail} + end. + +read_affinity(Data) -> + Exp = "pid " ++ os:getpid() ++ "'s current affinity mask", + case string:tokens(Data, ":") of + [Exp, DirtyAffinityStr] -> + AffinityStr = string:strip(string:strip(DirtyAffinityStr, + both, $ ), + both, $\n), + case catch erlang:list_to_integer(AffinityStr, 16) of + Affinity when is_integer(Affinity) -> + Affinity; + _ -> + bad + end; + _ -> + bad + end. + +get_affinity_mask(Port, Status, Affinity) when Status == unknown; + Affinity == unknown -> + receive + {Port,{data, Data}} -> + get_affinity_mask(Port, Status, read_affinity(Data)); + {Port,{exit_status,S}} -> + get_affinity_mask(Port, S, Affinity) + end; +get_affinity_mask(Port, Status, bad) -> + unknown; +get_affinity_mask(Port, Status, Affinity) -> + Affinity. + +get_affinity_mask() -> + case ?t:os_type() of + {unix, linux} -> + case catch open_port({spawn, "taskset -p " ++ os:getpid()}, + [exit_status]) of + Port when is_port(Port) -> + get_affinity_mask(Port, unknown, unknown); + _ -> + unknown + end; + _ -> + unknown + end. + +set_affinity_mask(Port, unknown) -> + receive + {Port,{data, _}} -> + set_affinity_mask(Port, unknown); + {Port,{exit_status,Status}} -> + set_affinity_mask(Port, Status) + end; +set_affinity_mask(Port, Status) -> + receive + {Port,{data, _}} -> + set_affinity_mask(Port, unknown) + after 0 -> + Status + end. + +set_affinity_mask(Mask) -> + Cmd = lists:flatten(["taskset -p ", + io_lib:format("~.16b", [Mask]), + " ", + os:getpid()]), + case catch open_port({spawn, Cmd}, [exit_status]) of + Port when is_port(Port) -> + case set_affinity_mask(Port, unknown) of + 0 -> ok; + _ -> exit(failed_to_set_affinity) + end; + _ -> + exit(failed_to_set_affinity) + end. + sct_cmd(Config) when is_list(Config) -> ?line Topology = ?TOPOLOGY_A_TERM, ?line OldRelFlags = clear_erl_rel_flags(), 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/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/net_kernel.erl b/lib/kernel/src/net_kernel.erl index 0e5cc8c2c6..f5e2820bbe 100644 --- a/lib/kernel/src/net_kernel.erl +++ b/lib/kernel/src/net_kernel.erl @@ -500,8 +500,8 @@ handle_call({new_ticktime,T,TP}, From, #state{tick = #tick{ticker = Tckr, time = T, how = How}}}, From); -handle_call({new_ticktime,From,_}, - _, +handle_call({new_ticktime,_T,_TP}, + From, #state{tick = #tick_change{time = T}} = State) -> async_reply({reply, {ongoing_change_to, T}, State}, From); diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index d15f6aa0d5..21a96f804a 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -273,6 +273,7 @@ tick_change(Config) when is_list(Config) -> ?line PaDir = filename:dirname(code:which(?MODULE)), ?line [BN, CN] = get_nodenames(2, tick_change), ?line DefaultTT = net_kernel:get_net_ticktime(), + ?line unchanged = net_kernel:set_net_ticktime(DefaultTT, 60), ?line case DefaultTT of I when is_integer(I) -> ?line ok; _ -> ?line ?t:fail(DefaultTT) @@ -377,6 +378,7 @@ run_tick_change_test(B, C, PrevTT, TT, PaDir) -> end, ?line change_initiated = net_kernel:set_net_ticktime(TT,20), + ?line {ongoing_change_to,_} = net_kernel:set_net_ticktime(TT,20), ?line sleep(3), ?line change_initiated = rpc:call(B,net_kernel,set_net_ticktime,[TT,15]), ?line sleep(7), 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/Makefile b/lib/ssl/Makefile index 8c9d78d4bc..daad7dc3e6 100644 --- a/lib/ssl/Makefile +++ b/lib/ssl/Makefile @@ -25,11 +25,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # Macros # -SUB_DIRECTORIES = src c_src doc/src - -ifeq ($(CROSS_COMPILING),no) -SUB_DIRECTORIES += examples/certs examples/src -endif +SUB_DIRECTORIES = src c_src doc/src examples/certs examples/src include vsn.mk VSN = $(SSL_VSN) diff --git a/lib/ssl/examples/certs/Makefile b/lib/ssl/examples/certs/Makefile index 121fcc6950..b811b461dc 100644 --- a/lib/ssl/examples/certs/Makefile +++ b/lib/ssl/examples/certs/Makefile @@ -1,7 +1,7 @@ # # %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 @@ -21,4 +21,41 @@ # Invoke with GNU make or clearmake -C gnu. # -include $(ERL_TOP)/make/run_make.mk +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../../vsn.mk +VSN=$(SSL_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/ssl-$(VSN) + +TARGET_FILES= + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) + +clean: + rm -fr $(TARGET_FILES) *~ *.beam + +docs: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/examples/certs + tar cf - etc | \ + (cd $(RELSYSDIR)/examples/certs; tar xf -) + chmod -f -R ug+rw $(RELSYSDIR)/examples +release_docs_spec: diff --git a/lib/ssl/examples/certs/Makefile.in b/lib/ssl/examples/certs/Makefile.in deleted file mode 100644 index 4ea7aaf6dc..0000000000 --- a/lib/ssl/examples/certs/Makefile.in +++ /dev/null @@ -1,80 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2003-2009. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% -# - -# - -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -include ../../vsn.mk -VSN=$(SSL_VSN) - -RELSYSDIR = $(RELEASE_PATH)/lib/ssl-$(VSN) - -EBIN = ebin -ETC = etc -SRC = src - -OPENSSL_CMD = @OPENSSL_CMD@ - -# We are generating more files than in the following list, but we take -# there existence as successful execution of make rules - -PEMS = cacerts.pem cert.pem key.pem - -PEMFILES = $(PEMS:%=$(ETC)/client/%) $(PEMS:%=$(ETC)/server/%) - -debug opt: $(PEMFILES) - -$(PEMFILES): done - -done: $(EBIN)/make_certs.beam - erl -noinput -pa $(EBIN) -run make_certs all $(OPENSSL_CMD) \ - -s erlang halt - echo >done - -$(EBIN)/make_certs.beam: $(SRC)/make_certs.erl - cd src; erlc -W -o ../$(EBIN) make_certs.erl - -clean: - rm -fr $(EBIN)/* $(SRC)/*~ $(SRC)/*.beam $(ETC) done \ - stderr.txt erl_crash.dump *~ - -docs: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/examples/certs - tar cf - Makefile ebin etc rnd src | \ - (cd $(RELSYSDIR)/examples/certs; tar xf -) - chmod -f -R ug+rw $(RELSYSDIR)/examples - -release_docs_spec: - - - - - - - - diff --git a/lib/ssl/examples/certs/ebin/.gitignore b/lib/ssl/examples/certs/ebin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/ssl/examples/certs/ebin/.gitignore +++ /dev/null diff --git a/lib/ssl/examples/certs/etc/client/cacerts.pem b/lib/ssl/examples/certs/etc/client/cacerts.pem new file mode 100644 index 0000000000..cb19d3d41e --- /dev/null +++ b/lib/ssl/examples/certs/etc/client/cacerts.pem @@ -0,0 +1,34 @@ +-----BEGIN CERTIFICATE----- +MIICizCCAfSgAwIBAgIFdMMs9fEwDQYJKoZIhvcNAQEFBQAwfTERMA8GA1UEAxMI +ZXJsYW5nQ0ExIDAeBgkqhkiG9w0BCQEWEXRlc3RlckBlcmxhbmcub3JnMRIwEAYD +VQQHEwlTdG9ja2hvbG0xCzAJBgNVBAYTAlNFMQ8wDQYDVQQKEwZlcmxhbmcxFDAS +BgNVBAsTC3Rlc3RpbmcgZGVwMCIYDzIwMTAwOTAxMDAwMDAwWhgPMjAyNTA4Mjgw +MDAwMDBaMH0xETAPBgNVBAMTCGVybGFuZ0NBMSAwHgYJKoZIhvcNAQkBFhF0ZXN0 +ZXJAZXJsYW5nLm9yZzESMBAGA1UEBxMJU3RvY2tob2xtMQswCQYDVQQGEwJTRTEP +MA0GA1UEChMGZXJsYW5nMRQwEgYDVQQLEwt0ZXN0aW5nIGRlcDCBnzANBgkqhkiG +9w0BAQEFAAOBjQAwgYkCgYEAgmHw2xApZqdzZOOPTzwHr1hRYd1OqbLOsXbAq6kJ +Kuu+qe5jAlMF3vnUhiHomuZeNZVJe3SP+JfBt3BHMjm2CLChCuNgfctKURMlEc/L +xo8fO1Jk9MD5mbG2Utx3m3gM6Liwt9fHVABlCTyB6/jXrK1tYpEG5CrwUXyy8Htl +jHECAwEAAaMTMBEwDwYDVR0TAQH/BAUwAwEB/zANBgkqhkiG9w0BAQUFAAOBgQAl +0tMEXWPgzXTpDuNmuKh6aGq9CuExUuEXXQQWPThzEuluA3aHFmObziQlMY1+KeO1 +AL0kpx0Yhvju/rfAJ+OF6MMni6hJoKlYTVml+fCY89A3nmY1rJHJavjHp0OIPGxh +4Sr+EcjROkqe8jE0DmbwmM6lzpwSJscxte+V6HvGRw== +-----END CERTIFICATE----- + +-----BEGIN CERTIFICATE----- +MIICiDCCAfGgAwIBAgIFSHyFNTEwDQYJKoZIhvcNAQEFBQAwfTERMA8GA1UEAxMI +ZXJsYW5nQ0ExIDAeBgkqhkiG9w0BCQEWEXRlc3RlckBlcmxhbmcub3JnMRIwEAYD +VQQHEwlTdG9ja2hvbG0xCzAJBgNVBAYTAlNFMQ8wDQYDVQQKEwZlcmxhbmcxFDAS +BgNVBAsTC3Rlc3RpbmcgZGVwMCIYDzIwMTAwOTAxMDAwMDAwWhgPMjAyNTA4Mjgw +MDAwMDBaMHoxDjAMBgNVBAMTBW90cENBMSAwHgYJKoZIhvcNAQkBFhF0ZXN0ZXJA +ZXJsYW5nLm9yZzESMBAGA1UEBxMJU3RvY2tob2xtMQswCQYDVQQGEwJTRTEPMA0G +A1UEChMGZXJsYW5nMRQwEgYDVQQLEwt0ZXN0aW5nIGRlcDCBnzANBgkqhkiG9w0B +AQEFAAOBjQAwgYkCgYEAjEt9iy365+mTialKDKb3l2QPg71yavJA1ZC6aGC14X7x +KCm1FhUYsVKOlWjmC1VYJiCS01gvKqMXiogreHJGM93E+URlKkOm9kmOWQwLfFb8 +JLzafPi3/8TUdjl8UuIDHyPsoQiM2ZBDUVWezfl+CBsTYFO3U4Lqf9OKbCxTF78C +AwEAAaMTMBEwDwYDVR0TAQH/BAUwAwEB/zANBgkqhkiG9w0BAQUFAAOBgQAv6vHw +wK3MvxzlhDJIx7rUasOYJDZJyOt71KdOKeA7+ocbvDIblmV7sTbe3oQNqbSATZ6H +RUqHZdPhKIZ9wjEBSKdBTL8rc0TvbztMvd+i0rkTCL/bspQYchA2zCcjgkWqpaN4 +OhOjQR1+9/ntmaU/r5Ca7KmrXEf5XSQIGLSMag== +-----END CERTIFICATE----- + diff --git a/lib/ssl/examples/certs/etc/client/cert.pem b/lib/ssl/examples/certs/etc/client/cert.pem new file mode 100644 index 0000000000..a2f53aaf82 --- /dev/null +++ b/lib/ssl/examples/certs/etc/client/cert.pem @@ -0,0 +1,17 @@ +-----BEGIN CERTIFICATE----- +MIIChzCCAfCgAwIBAgIGAIsapa8BMA0GCSqGSIb3DQEBBQUAMHoxDjAMBgNVBAMT +BW90cENBMSAwHgYJKoZIhvcNAQkBFhF0ZXN0ZXJAZXJsYW5nLm9yZzESMBAGA1UE +BxMJU3RvY2tob2xtMQswCQYDVQQGEwJTRTEPMA0GA1UEChMGZXJsYW5nMRQwEgYD +VQQLEwt0ZXN0aW5nIGRlcDAiGA8yMDEwMDkwMTAwMDAwMFoYDzIwMjUwODI4MDAw +MDAwWjB7MQ8wDQYDVQQDEwZjbGllbnQxIDAeBgkqhkiG9w0BCQEWEXRlc3RlckBl +cmxhbmcub3JnMRIwEAYDVQQHEwlTdG9ja2hvbG0xCzAJBgNVBAYTAlNFMQ8wDQYD +VQQKEwZlcmxhbmcxFDASBgNVBAsTC3Rlc3RpbmcgZGVwMIGfMA0GCSqGSIb3DQEB +AQUAA4GNADCBiQKBgQCTFBPkOO98fDY3j6MIxIGKp+rampfIay50Lx4+EnCnRSSV +wC+n0VVmP7V5SGFJpuXJzN0hvqPUWOOjiMTNlNRaGy0pqu2oMXWAPLOxHWL1wT53 +h2Zr3FUNU/N0Rvnkttse1KZJ9uYCLKUiuXXsv2rR62nH3OhRIiBHSAcSv0NRWwID +AQABoxMwETAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3DQEBBQUAA4GBAG8t6f1A +PF7xayGxtUpG2r6W5ETylC3ZIKPS2kfJk9aYi7AZNTp7/xTU6SgqvFBN8aBPzxCD +4jHrSNC8DSb4X1x9uimarb6qdZDHEdij+DRAd2eygJHZxEf7+8B4Fx34thQeU9hZ +S1Izke5AlsyFMkvB7h0anE4k9BfuU70vl6v5 +-----END CERTIFICATE----- + diff --git a/lib/ssl/examples/certs/etc/client/key.pem b/lib/ssl/examples/certs/etc/client/key.pem new file mode 100644 index 0000000000..4d55b08f4c --- /dev/null +++ b/lib/ssl/examples/certs/etc/client/key.pem @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQCTFBPkOO98fDY3j6MIxIGKp+rampfIay50Lx4+EnCnRSSVwC+n +0VVmP7V5SGFJpuXJzN0hvqPUWOOjiMTNlNRaGy0pqu2oMXWAPLOxHWL1wT53h2Zr +3FUNU/N0Rvnkttse1KZJ9uYCLKUiuXXsv2rR62nH3OhRIiBHSAcSv0NRWwIDAQAB +AoGACdIVYe/LTeydUihtInC8lZ2QuPgJmoBNocRjqJFipEihoL4scHAx25n1bBvB +I0HZphffzBkGp28oBAtl2LRPWXqu527unc/RWRfLMqSK1xNSq1DxD1a30zkrZPna +QiV65vEJuNSJTtlDy/Zqc/BVZXCpxWlzYQedZgkmf0Qse8ECQQCmaz02Yur8zC9f +eSQKU5OSzGw3bSIumEzziCfHdTheK6MEoccf5TCAyLXhZwA7QlKja4tFXfeyVxws +/LlnUJN9AkEA4j+xnOeYUyGKXL5i+BAbnqpI4MzPiq+IoCYkaRlD/wAws24r5HNI +ZQmEHWqD/NNzOf/A2XuyLtMiTGJPW/DftwJBAKKpJP6Ytuh6xz8BUCnLwO12Y7vV +LtjuQiCzD3aUa5EYA9HOMqxJPxxRkf0LyR0i2VUkE8+sZiPpov+R0cJa7p0CQQCj +40GUiArGRSiF7/+e84QeVfl+pb29F1QftiFv5DZmFEwy3Z572KpbTh5edJbxYHY6 +UDHxGHJFCvnwXNJhpkVXAkBJqfEfiMJ3Q/E5Gpf3sQizacouW92iiN8ojlF1oB80 +t34RysJH7SgI3gdMhTribCo2UUaV0StjR6yodPN+TB2J +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssl/examples/certs/etc/erlangCA/cert.pem b/lib/ssl/examples/certs/etc/erlangCA/cert.pem new file mode 100644 index 0000000000..c4386494dc --- /dev/null +++ b/lib/ssl/examples/certs/etc/erlangCA/cert.pem @@ -0,0 +1,17 @@ +-----BEGIN CERTIFICATE----- +MIICizCCAfSgAwIBAgIFdMMs9fEwDQYJKoZIhvcNAQEFBQAwfTERMA8GA1UEAxMI +ZXJsYW5nQ0ExIDAeBgkqhkiG9w0BCQEWEXRlc3RlckBlcmxhbmcub3JnMRIwEAYD +VQQHEwlTdG9ja2hvbG0xCzAJBgNVBAYTAlNFMQ8wDQYDVQQKEwZlcmxhbmcxFDAS +BgNVBAsTC3Rlc3RpbmcgZGVwMCIYDzIwMTAwOTAxMDAwMDAwWhgPMjAyNTA4Mjgw +MDAwMDBaMH0xETAPBgNVBAMTCGVybGFuZ0NBMSAwHgYJKoZIhvcNAQkBFhF0ZXN0 +ZXJAZXJsYW5nLm9yZzESMBAGA1UEBxMJU3RvY2tob2xtMQswCQYDVQQGEwJTRTEP +MA0GA1UEChMGZXJsYW5nMRQwEgYDVQQLEwt0ZXN0aW5nIGRlcDCBnzANBgkqhkiG +9w0BAQEFAAOBjQAwgYkCgYEAgmHw2xApZqdzZOOPTzwHr1hRYd1OqbLOsXbAq6kJ +Kuu+qe5jAlMF3vnUhiHomuZeNZVJe3SP+JfBt3BHMjm2CLChCuNgfctKURMlEc/L +xo8fO1Jk9MD5mbG2Utx3m3gM6Liwt9fHVABlCTyB6/jXrK1tYpEG5CrwUXyy8Htl +jHECAwEAAaMTMBEwDwYDVR0TAQH/BAUwAwEB/zANBgkqhkiG9w0BAQUFAAOBgQAl +0tMEXWPgzXTpDuNmuKh6aGq9CuExUuEXXQQWPThzEuluA3aHFmObziQlMY1+KeO1 +AL0kpx0Yhvju/rfAJ+OF6MMni6hJoKlYTVml+fCY89A3nmY1rJHJavjHp0OIPGxh +4Sr+EcjROkqe8jE0DmbwmM6lzpwSJscxte+V6HvGRw== +-----END CERTIFICATE----- + diff --git a/lib/ssl/examples/certs/etc/otpCA/cert.pem b/lib/ssl/examples/certs/etc/otpCA/cert.pem new file mode 100644 index 0000000000..8610621695 --- /dev/null +++ b/lib/ssl/examples/certs/etc/otpCA/cert.pem @@ -0,0 +1,17 @@ +-----BEGIN CERTIFICATE----- +MIICiDCCAfGgAwIBAgIFSHyFNTEwDQYJKoZIhvcNAQEFBQAwfTERMA8GA1UEAxMI +ZXJsYW5nQ0ExIDAeBgkqhkiG9w0BCQEWEXRlc3RlckBlcmxhbmcub3JnMRIwEAYD +VQQHEwlTdG9ja2hvbG0xCzAJBgNVBAYTAlNFMQ8wDQYDVQQKEwZlcmxhbmcxFDAS +BgNVBAsTC3Rlc3RpbmcgZGVwMCIYDzIwMTAwOTAxMDAwMDAwWhgPMjAyNTA4Mjgw +MDAwMDBaMHoxDjAMBgNVBAMTBW90cENBMSAwHgYJKoZIhvcNAQkBFhF0ZXN0ZXJA +ZXJsYW5nLm9yZzESMBAGA1UEBxMJU3RvY2tob2xtMQswCQYDVQQGEwJTRTEPMA0G +A1UEChMGZXJsYW5nMRQwEgYDVQQLEwt0ZXN0aW5nIGRlcDCBnzANBgkqhkiG9w0B +AQEFAAOBjQAwgYkCgYEAjEt9iy365+mTialKDKb3l2QPg71yavJA1ZC6aGC14X7x +KCm1FhUYsVKOlWjmC1VYJiCS01gvKqMXiogreHJGM93E+URlKkOm9kmOWQwLfFb8 +JLzafPi3/8TUdjl8UuIDHyPsoQiM2ZBDUVWezfl+CBsTYFO3U4Lqf9OKbCxTF78C +AwEAAaMTMBEwDwYDVR0TAQH/BAUwAwEB/zANBgkqhkiG9w0BAQUFAAOBgQAv6vHw +wK3MvxzlhDJIx7rUasOYJDZJyOt71KdOKeA7+ocbvDIblmV7sTbe3oQNqbSATZ6H +RUqHZdPhKIZ9wjEBSKdBTL8rc0TvbztMvd+i0rkTCL/bspQYchA2zCcjgkWqpaN4 +OhOjQR1+9/ntmaU/r5Ca7KmrXEf5XSQIGLSMag== +-----END CERTIFICATE----- + diff --git a/lib/ssl/examples/certs/etc/server/cacerts.pem b/lib/ssl/examples/certs/etc/server/cacerts.pem new file mode 100644 index 0000000000..cb19d3d41e --- /dev/null +++ b/lib/ssl/examples/certs/etc/server/cacerts.pem @@ -0,0 +1,34 @@ +-----BEGIN CERTIFICATE----- +MIICizCCAfSgAwIBAgIFdMMs9fEwDQYJKoZIhvcNAQEFBQAwfTERMA8GA1UEAxMI +ZXJsYW5nQ0ExIDAeBgkqhkiG9w0BCQEWEXRlc3RlckBlcmxhbmcub3JnMRIwEAYD +VQQHEwlTdG9ja2hvbG0xCzAJBgNVBAYTAlNFMQ8wDQYDVQQKEwZlcmxhbmcxFDAS +BgNVBAsTC3Rlc3RpbmcgZGVwMCIYDzIwMTAwOTAxMDAwMDAwWhgPMjAyNTA4Mjgw +MDAwMDBaMH0xETAPBgNVBAMTCGVybGFuZ0NBMSAwHgYJKoZIhvcNAQkBFhF0ZXN0 +ZXJAZXJsYW5nLm9yZzESMBAGA1UEBxMJU3RvY2tob2xtMQswCQYDVQQGEwJTRTEP +MA0GA1UEChMGZXJsYW5nMRQwEgYDVQQLEwt0ZXN0aW5nIGRlcDCBnzANBgkqhkiG +9w0BAQEFAAOBjQAwgYkCgYEAgmHw2xApZqdzZOOPTzwHr1hRYd1OqbLOsXbAq6kJ +Kuu+qe5jAlMF3vnUhiHomuZeNZVJe3SP+JfBt3BHMjm2CLChCuNgfctKURMlEc/L +xo8fO1Jk9MD5mbG2Utx3m3gM6Liwt9fHVABlCTyB6/jXrK1tYpEG5CrwUXyy8Htl +jHECAwEAAaMTMBEwDwYDVR0TAQH/BAUwAwEB/zANBgkqhkiG9w0BAQUFAAOBgQAl +0tMEXWPgzXTpDuNmuKh6aGq9CuExUuEXXQQWPThzEuluA3aHFmObziQlMY1+KeO1 +AL0kpx0Yhvju/rfAJ+OF6MMni6hJoKlYTVml+fCY89A3nmY1rJHJavjHp0OIPGxh +4Sr+EcjROkqe8jE0DmbwmM6lzpwSJscxte+V6HvGRw== +-----END CERTIFICATE----- + +-----BEGIN CERTIFICATE----- +MIICiDCCAfGgAwIBAgIFSHyFNTEwDQYJKoZIhvcNAQEFBQAwfTERMA8GA1UEAxMI +ZXJsYW5nQ0ExIDAeBgkqhkiG9w0BCQEWEXRlc3RlckBlcmxhbmcub3JnMRIwEAYD +VQQHEwlTdG9ja2hvbG0xCzAJBgNVBAYTAlNFMQ8wDQYDVQQKEwZlcmxhbmcxFDAS +BgNVBAsTC3Rlc3RpbmcgZGVwMCIYDzIwMTAwOTAxMDAwMDAwWhgPMjAyNTA4Mjgw +MDAwMDBaMHoxDjAMBgNVBAMTBW90cENBMSAwHgYJKoZIhvcNAQkBFhF0ZXN0ZXJA +ZXJsYW5nLm9yZzESMBAGA1UEBxMJU3RvY2tob2xtMQswCQYDVQQGEwJTRTEPMA0G +A1UEChMGZXJsYW5nMRQwEgYDVQQLEwt0ZXN0aW5nIGRlcDCBnzANBgkqhkiG9w0B +AQEFAAOBjQAwgYkCgYEAjEt9iy365+mTialKDKb3l2QPg71yavJA1ZC6aGC14X7x +KCm1FhUYsVKOlWjmC1VYJiCS01gvKqMXiogreHJGM93E+URlKkOm9kmOWQwLfFb8 +JLzafPi3/8TUdjl8UuIDHyPsoQiM2ZBDUVWezfl+CBsTYFO3U4Lqf9OKbCxTF78C +AwEAAaMTMBEwDwYDVR0TAQH/BAUwAwEB/zANBgkqhkiG9w0BAQUFAAOBgQAv6vHw +wK3MvxzlhDJIx7rUasOYJDZJyOt71KdOKeA7+ocbvDIblmV7sTbe3oQNqbSATZ6H +RUqHZdPhKIZ9wjEBSKdBTL8rc0TvbztMvd+i0rkTCL/bspQYchA2zCcjgkWqpaN4 +OhOjQR1+9/ntmaU/r5Ca7KmrXEf5XSQIGLSMag== +-----END CERTIFICATE----- + diff --git a/lib/ssl/examples/certs/etc/server/cert.pem b/lib/ssl/examples/certs/etc/server/cert.pem new file mode 100644 index 0000000000..f26adb7f5c --- /dev/null +++ b/lib/ssl/examples/certs/etc/server/cert.pem @@ -0,0 +1,17 @@ +-----BEGIN CERTIFICATE----- +MIIChzCCAfCgAwIBAgIGANUxXM9BMA0GCSqGSIb3DQEBBQUAMHoxDjAMBgNVBAMT +BW90cENBMSAwHgYJKoZIhvcNAQkBFhF0ZXN0ZXJAZXJsYW5nLm9yZzESMBAGA1UE +BxMJU3RvY2tob2xtMQswCQYDVQQGEwJTRTEPMA0GA1UEChMGZXJsYW5nMRQwEgYD +VQQLEwt0ZXN0aW5nIGRlcDAiGA8yMDEwMDkwMTAwMDAwMFoYDzIwMjUwODI4MDAw +MDAwWjB7MQ8wDQYDVQQDEwZzZXJ2ZXIxIDAeBgkqhkiG9w0BCQEWEXRlc3RlckBl +cmxhbmcub3JnMRIwEAYDVQQHEwlTdG9ja2hvbG0xCzAJBgNVBAYTAlNFMQ8wDQYD +VQQKEwZlcmxhbmcxFDASBgNVBAsTC3Rlc3RpbmcgZGVwMIGfMA0GCSqGSIb3DQEB +AQUAA4GNADCBiQKBgQCf4Htxr99lLs5W8QQw7jdakqyAkIjOW4aqH8sr4va4SvZ9 +Adq67k8jMHefCVZo+F8x4cwsBgB4aWzFIGBnvFTi6YsH27XW7f9O9IPCej8fdhRZ +4UAtNHa253buOWpDGla2JmIdkmfFvXFJycMIKbG5tYilVXoWKBMKmCwWaXz0nQID +AQABoxMwETAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3DQEBBQUAA4GBAGF5Pfwk +QDdwJup/mVITPxbBls4Yl7anDooUQsq8066lA1g54H/PRfXscGkyCFGh1ifXvf1L +psMRoBAdDHL/wSJplk3rRavkC94eBgnTFZmfKL6844g1j53yameiYL8IEVExYMBg +/XGyc0qwq57WT8B/K4aElrvlBlQ0wF3wN54M +-----END CERTIFICATE----- + diff --git a/lib/ssl/examples/certs/etc/server/key.pem b/lib/ssl/examples/certs/etc/server/key.pem new file mode 100644 index 0000000000..c1392ca557 --- /dev/null +++ b/lib/ssl/examples/certs/etc/server/key.pem @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQCf4Htxr99lLs5W8QQw7jdakqyAkIjOW4aqH8sr4va4SvZ9Adq6 +7k8jMHefCVZo+F8x4cwsBgB4aWzFIGBnvFTi6YsH27XW7f9O9IPCej8fdhRZ4UAt +NHa253buOWpDGla2JmIdkmfFvXFJycMIKbG5tYilVXoWKBMKmCwWaXz0nQIDAQAB +AoGAQIlma0r6W6bcRj4+Wd4fXCFvHuq5Psu1fYEeC5Yvz8761xVjjSfbrDHJZ9pm +FjOEgedK+s5lbDXqYVyjbdyZSugStBRocSmbG8SQHcAsxR2ZIkNzX2hYzB+lslWo +T3YJojDyB134O7XJznCu+ZFXP86jyJ1JT6k6a+OIHcwnJ+ECQQDYn57dY4Px3mEd +VBLStN3YkRF5oFyT+xk7IaKeLLB6n4gCnoVbBoHut7PFbPYPzoNzEwPk3MQKDIHb +Kig3S5CpAkEAvPA1VmoJWAlN6kUi+F2L8HXEArzE8x7vwdsslrwMKUe4dFS+ZC/7 +5iDOaxcZ7TYkCgwzBt341++DCgP6j3fY1QJBALB6AcOcwi52m6l4B8mu3ZkEPjdX +BHTuONTqhv/TqoaLlxODL2NDvvDKqeMp7KBd/srt79swW2lQXS4+fvrlTdkCQQCm +zxj4O1QWkthkfje6ubSkTwUIOatUzrp1F9GNH2dJRtX2dx9FCwxGCC7WY6XzRXqa +GF0wsedSllbGD+82nWQlAkAicMGqCqRq4hKR/cVmFatOqKVWCVkx6OFF2FhuiI5Z +h5eIOPGCt8dVRs1P9DNSld/D98Sfm65m85z8BtXovvYV +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssl/examples/certs/rnd/RAND b/lib/ssl/examples/certs/rnd/RAND Binary files differdeleted file mode 100644 index 70997bd01f..0000000000 --- a/lib/ssl/examples/certs/rnd/RAND +++ /dev/null diff --git a/lib/ssl/examples/certs/src/make_certs.erl b/lib/ssl/examples/certs/src/make_certs.erl index c374836568..fe267bed28 100644 --- a/lib/ssl/examples/certs/src/make_certs.erl +++ b/lib/ssl/examples/certs/src/make_certs.erl @@ -1,261 +1,48 @@ -%% The purpose of this module is to create example certificates for -%% testing. -%% Run it as: -%% -%% erl -noinput -run make_certs all "/path/to/openssl" -s erlang halt -%% +%% The purpose of this module is to log how the example certs where created, +%% it requires erl_make_certs found in the test directory. -module(make_certs). --export([all/0, all/1]). - --record(dn, {commonName, - organizationalUnitName = "Erlang OTP", - organizationName = "Ericsson AB", - localityName = "Stockholm", - countryName = "SE", - emailAddress = "[email protected]"}). +-export([all/0]). all() -> - all(["openssl"]). - -all([OpenSSLCmd]) -> - Root = filename:dirname(filename:dirname((code:which(?MODULE)))), - %% io:fwrite("Root : ~s~n", [Root]), - NRoot = filename:join([Root, "etc"]), - file:make_dir(NRoot), - create_rnd(Root, "etc"), % For all requests - rootCA(NRoot, OpenSSLCmd, "erlangCA"), - intermediateCA(NRoot, OpenSSLCmd, "otpCA", "erlangCA"), - endusers(NRoot, OpenSSLCmd, "otpCA", ["client", "server"]), - collect_certs(NRoot, ["erlangCA", "otpCA"], ["client", "server"]), - remove_rnd(Root, "etc"). - -rootCA(Root, OpenSSLCmd, Name) -> - create_ca_dir(Root, Name, ca_cnf(Name)), - DN = #dn{commonName = Name}, - create_self_signed_cert(Root, OpenSSLCmd, Name, req_cnf(DN)), - ok. - -intermediateCA(Root, OpenSSLCmd, CA, ParentCA) -> - CA = "otpCA", - create_ca_dir(Root, CA, ca_cnf(CA)), - CARoot = filename:join([Root, CA]), - DN = #dn{commonName = CA}, - CnfFile = filename:join([CARoot, "req.cnf"]), - file:write_file(CnfFile, req_cnf(DN)), - KeyFile = filename:join([CARoot, "private", "key.pem"]), - ReqFile = filename:join([CARoot, "req.pem"]), - create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile), - CertFile = filename:join([CARoot, "cert.pem"]), - sign_req(Root, OpenSSLCmd, ParentCA, "ca_cert", ReqFile, CertFile). - -endusers(Root, OpenSSLCmd, CA, Users) -> - lists:foreach(fun(User) -> enduser(Root, OpenSSLCmd, CA, User) end, Users). - -enduser(Root, OpenSSLCmd, CA, User) -> - UsrRoot = filename:join([Root, User]), - file:make_dir(UsrRoot), - CnfFile = filename:join([UsrRoot, "req.cnf"]), - DN = #dn{commonName = User}, - file:write_file(CnfFile, req_cnf(DN)), - KeyFile = filename:join([UsrRoot, "key.pem"]), - ReqFile = filename:join([UsrRoot, "req.pem"]), - create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile), - CertFile = filename:join([UsrRoot, "cert.pem"]), - sign_req(Root, OpenSSLCmd, CA, "user_cert", ReqFile, CertFile). - -collect_certs(Root, CAs, Users) -> - Bins = lists:foldr( - fun(CA, Acc) -> - File = filename:join([Root, CA, "cert.pem"]), - {ok, Bin} = file:read_file(File), - [Bin, "\n" | Acc] - end, [], CAs), - lists:foreach( - fun(User) -> - File = filename:join([Root, User, "cacerts.pem"]), - file:write_file(File, Bins) - end, Users). - -create_self_signed_cert(Root, OpenSSLCmd, CAName, Cnf) -> - CARoot = filename:join([Root, CAName]), - CnfFile = filename:join([CARoot, "req.cnf"]), - file:write_file(CnfFile, Cnf), - KeyFile = filename:join([CARoot, "private", "key.pem"]), - CertFile = filename:join([CARoot, "cert.pem"]), - Cmd = [OpenSSLCmd, " req" - " -new" - " -x509" - " -config ", CnfFile, - " -keyout ", KeyFile, - " -out ", CertFile], - Env = [{"ROOTDIR", Root}], - cmd(Cmd, Env). - -create_ca_dir(Root, CAName, Cnf) -> - CARoot = filename:join([Root, CAName]), - file:make_dir(CARoot), - create_dirs(CARoot, ["certs", "crl", "newcerts", "private"]), - create_rnd(Root, filename:join([CAName, "private"])), - create_files(CARoot, [{"serial", "01\n"}, - {"index.txt", ""}, - {"ca.cnf", Cnf}]). - -create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile) -> - Cmd = [OpenSSLCmd, " req" - " -new" - " -config ", CnfFile, - " -keyout ", KeyFile, - " -out ", ReqFile], - Env = [{"ROOTDIR", Root}], - cmd(Cmd, Env). - -sign_req(Root, OpenSSLCmd, CA, CertType, ReqFile, CertFile) -> - CACnfFile = filename:join([Root, CA, "ca.cnf"]), - Cmd = [OpenSSLCmd, " ca" - " -batch" - " -notext" - " -config ", CACnfFile, - " -extensions ", CertType, - " -in ", ReqFile, - " -out ", CertFile], - Env = [{"ROOTDIR", Root}], - cmd(Cmd, Env). + LongTime = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())+15*365), + Validity = {date(), LongTime}, + Subject = [{email, "[email protected]"}, + {city, "Stockholm"}, + {country, "SE"}, + {org, "erlang"}, + {org_unit, "testing dep"}], + + RootCa = erl_make_certs:make_cert([{validity, Validity}, {subject, [{name, "erlangCA"}|Subject]}]), + ImedCa = erl_make_certs:make_cert([{issuer, RootCa}, {validity, Validity}, + {subject, [{name, "otpCA"}|Subject]}]), + ClientCa = erl_make_certs:make_cert([{issuer, ImedCa}, {validity, Validity}, + {subject, [{name, "client"}|Subject]}]), + ServerCa = erl_make_certs:make_cert([{issuer, ImedCa}, {validity, Validity}, + {subject, [{name, "server"}|Subject]}]), + + Root0 = filename:dirname(filename:dirname((code:which(?MODULE)))), + Root = filename:join([Root0, "etc"]), file:make_dir(Root), + CaPath = filename:join([Root, "erlangCA"]), file:make_dir(CaPath), + IPath = filename:join([Root, "otpCA"]), file:make_dir(IPath), + CPath = filename:join([Root, "client"]), file:make_dir(CPath), + SPath = filename:join([Root, "server"]), file:make_dir(SPath), + + erl_make_certs:write_pem(CaPath,"cert", RootCa), + erl_make_certs:write_pem(IPath, "cert", ImedCa), + + {ok, CaBin0} = file:read_file(filename:join(CaPath, "cert.pem")), + {ok, CaBin1} = file:read_file(filename:join(IPath, "cert.pem")), + CaBin = <<CaBin0/binary, CaBin1/binary>>, + + erl_make_certs:write_pem(CPath, "cert", ClientCa), + ok = file:write_file(filename:join(CPath, "cacerts.pem"), CaBin), + erl_make_certs:write_pem(SPath, "cert", ServerCa), + ok = file:write_file(filename:join(SPath, "cacerts.pem"), CaBin), -%% -%% Misc -%% - -create_dirs(Root, Dirs) -> - lists:foreach(fun(Dir) -> - file:make_dir(filename:join([Root, Dir])) end, - Dirs). - -create_files(Root, NameContents) -> - lists:foreach( - fun({Name, Contents}) -> - file:write_file(filename:join([Root, Name]), Contents) end, - NameContents). - -create_rnd(Root, Dir) -> - From = filename:join([Root, "rnd", "RAND"]), - To = filename:join([Root, Dir, "RAND"]), - file:copy(From, To). - -remove_rnd(Root, Dir) -> - File = filename:join([Root, Dir, "RAND"]), - file:delete(File). - -cmd(Cmd, Env) -> - FCmd = lists:flatten(Cmd), - Port = open_port({spawn, FCmd}, [stream, eof, exit_status, - {env, Env}]), - eval_cmd(Port). - -eval_cmd(Port) -> - receive - {Port, {data, _}} -> - eval_cmd(Port); - {Port, eof} -> - ok - end, - receive - {Port, {exit_status, Status}} when Status /= 0 -> - %% io:fwrite("exit status: ~w~n", [Status]), - erlang:halt(Status) - after 0 -> - ok - end. - -%% -%% Contents of configuration files -%% - -req_cnf(DN) -> - ["# Purpose: Configuration for requests (end users and CAs)." - "\n" - "ROOTDIR = $ENV::ROOTDIR\n" - "\n" - - "[req]\n" - "input_password = secret\n" - "output_password = secret\n" - "default_bits = 1024\n" - "RANDFILE = $ROOTDIR/RAND\n" - "encrypt_key = no\n" - "default_md = sha1\n" - "#string_mask = pkix\n" - "x509_extensions = ca_ext\n" - "prompt = no\n" - "distinguished_name= name\n" - "\n" - - "[name]\n" - "commonName = ", DN#dn.commonName, "\n" - "organizationalUnitName = ", DN#dn.organizationalUnitName, "\n" - "organizationName = ", DN#dn.organizationName, "\n" - "localityName = ", DN#dn.localityName, "\n" - "countryName = ", DN#dn.countryName, "\n" - "emailAddress = ", DN#dn.emailAddress, "\n" - "\n" - - "[ca_ext]\n" - "basicConstraints = critical, CA:true\n" - "keyUsage = cRLSign, keyCertSign\n" - "subjectKeyIdentifier = hash\n" - "subjectAltName = email:copy\n"]. - - -ca_cnf(CA) -> - ["# Purpose: Configuration for CAs.\n" - "\n" - "ROOTDIR = $ENV::ROOTDIR\n" - "default_ca = ca\n" - "\n" - - "[ca]\n" - "dir = $ROOTDIR/", CA, "\n" - "certs = $dir/certs\n" - "crl_dir = $dir/crl\n" - "database = $dir/index.txt\n" - "new_certs_dir = $dir/newcerts\n" - "certificate = $dir/cert.pem\n" - "serial = $dir/serial\n" - "crl = $dir/crl.pem\n" - "private_key = $dir/private/key.pem\n" - "RANDFILE = $dir/private/RAND\n" - "\n" - "x509_extensions = user_cert\n" - "default_days = 3600\n" - "default_md = sha1\n" - "preserve = no\n" - "policy = policy_match\n" - "\n" - - "[policy_match]\n" - "commonName = supplied\n" - "organizationalUnitName = optional\n" - "organizationName = match\n" - "countryName = match\n" - "localityName = match\n" - "emailAddress = supplied\n" - "\n" - - "[user_cert]\n" - "basicConstraints = CA:false\n" - "keyUsage = nonRepudiation, digitalSignature, keyEncipherment\n" - "subjectKeyIdentifier = hash\n" - "authorityKeyIdentifier = keyid,issuer:always\n" - "subjectAltName = email:copy\n" - "issuerAltName = issuer:copy\n" - "\n" - - "[ca_cert]\n" - "basicConstraints = critical,CA:true\n" - "keyUsage = cRLSign, keyCertSign\n" - "subjectKeyIdentifier = hash\n" - "authorityKeyIdentifier = keyid:always,issuer:always\n" - "subjectAltName = email:copy\n" - "issuerAltName = issuer:copy\n"]. - + file:delete(filename:join(CaPath, "cert_key.pem")), + file:delete(filename:join(IPath, "cert_key.pem")), + file:rename(filename:join(CPath, "cert_key.pem"), filename:join(CPath, "key.pem")), + file:rename(filename:join(SPath, "cert_key.pem"), filename:join(SPath, "key.pem")), + ok. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 6e26f05c3d..dbc5faff14 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,58 +523,62 @@ 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), dhfile = handle_option(dhfile, Opts, undefined), ciphers = handle_option(ciphers, Opts, []), @@ -586,10 +591,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, dhfile, ciphers, debug, reuse_session, reuse_sessions, ssl_imp, cb_info, renegotiate_at, secure_renegotiate], @@ -613,7 +618,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,23 +640,29 @@ 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) -> @@ -701,14 +726,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..7689976ff6 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}); @@ -1038,20 +1037,29 @@ ssl_init(SslOpts, Role) -> DHParams = init_diffie_hellman(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); 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..3862dc75de 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -63,9 +63,11 @@ validate_extensions_fun, depth, % integer() certfile, % file() + cert, % der_encoded() keyfile, % file() - key, % + key, % der_encoded() password, % + cacerts, % [der_encoded()] cacertfile, % file() dhfile, % file() ciphers, % 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..47c7407a2e 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,129 @@ 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) -> + + SeverVerifyOpts = ?config(server_verification_opts, Config), + {ServerCert, ServerKey, ServerCaCerts} = der_input_opts(SeverVerifyOpts), + ClientVerifyOpts = ?config(client_verification_opts, Config), + {ClientCert, ClientKey, ClientCaCerts} = der_input_opts(ClientVerifyOpts), + ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true}, + {cert, ServerCert}, {key, ServerKey}, {cacerts, ServerCaCerts}], + ClientOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true}, + {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), + [{_, Cert, _}] = ssl_test_lib:pem_to_der(Certfile), + [{_, Key, _}] = ssl_test_lib:pem_to_der(Keyfile), + CaCerts = + lists:map(fun(Entry) -> + {_, CaCert, _} = Entry, + CaCert + end, ssl_test_lib:pem_to_der(CaCertsfile)), + {Cert, {rsa, Key}, CaCerts}. %%-------------------------------------------------------------------- %%% Internal functions 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/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 |