aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--erts/configure.in7
-rw-r--r--erts/emulator/beam/sys.h16
-rw-r--r--erts/emulator/drivers/common/efile_drv.c57
-rw-r--r--erts/emulator/drivers/common/erl_efile.h13
-rw-r--r--erts/emulator/drivers/common/ram_file_drv.c17
-rw-r--r--erts/emulator/drivers/unix/unix_efile.c22
-rw-r--r--erts/emulator/drivers/win32/win_efile.c28
-rw-r--r--erts/preloaded/ebin/erl_prim_loader.beambin50816 -> 50708 bytes
-rw-r--r--erts/preloaded/ebin/erlang.beambin23808 -> 23788 bytes
-rw-r--r--erts/preloaded/ebin/init.beambin44500 -> 44352 bytes
-rw-r--r--erts/preloaded/ebin/otp_ring0.beambin1448 -> 1420 bytes
-rw-r--r--erts/preloaded/ebin/prim_file.beambin29496 -> 30472 bytes
-rw-r--r--erts/preloaded/ebin/prim_inet.beambin57320 -> 57288 bytes
-rw-r--r--erts/preloaded/ebin/prim_zip.beambin22600 -> 22432 bytes
-rw-r--r--erts/preloaded/ebin/zlib.beambin10620 -> 10596 bytes
-rw-r--r--erts/preloaded/src/prim_file.erl52
-rw-r--r--lib/compiler/src/compile.erl9
-rw-r--r--lib/compiler/src/v3_core.erl3
-rw-r--r--lib/kernel/doc/src/file.xml46
-rw-r--r--lib/kernel/src/file.erl28
-rw-r--r--lib/kernel/src/file_io_server.erl16
-rw-r--r--lib/kernel/src/ram_file.erl48
-rw-r--r--lib/kernel/test/file_SUITE.erl103
-rw-r--r--lib/kernel/test/prim_file_SUITE.erl95
-rw-r--r--lib/snmp/doc/src/notes.xml15
-rw-r--r--lib/snmp/doc/src/snmp_app.xml2
-rw-r--r--lib/snmp/doc/src/snmp_config.xml2
-rw-r--r--lib/snmp/doc/src/snmpa.xml20
-rw-r--r--lib/snmp/src/agent/snmpa.erl8
-rw-r--r--lib/snmp/src/agent/snmpa_agent.erl7
-rw-r--r--lib/snmp/src/agent/snmpa_mib.erl12
-rw-r--r--lib/snmp/src/app/snmp.appup.src72
-rw-r--r--lib/snmp/src/manager/snmpm_server.erl26
-rw-r--r--lib/snmp/vsn.mk6
-rw-r--r--lib/ssh/doc/src/notes.xml12
-rw-r--r--lib/ssh/src/ssh_acceptor.erl4
-rwxr-xr-xlib/ssh/src/ssh_connect.hrl3
-rw-r--r--lib/ssh/src/ssh_connection.erl20
-rw-r--r--lib/ssh/src/ssh_connection_controler.erl4
-rw-r--r--lib/ssh/src/ssh_connection_manager.erl7
-rw-r--r--lib/ssh/src/ssh_sftpd.erl9
-rw-r--r--lib/ssh/vsn.mk4
-rw-r--r--lib/ssl/src/ssl_connection.erl120
-rw-r--r--lib/ssl/src/ssl_manager.erl8
-rw-r--r--lib/ssl/src/ssl_record.erl21
-rw-r--r--lib/ssl/src/ssl_session_cache.erl16
-rw-r--r--lib/ssl/src/ssl_session_cache_api.erl12
-rw-r--r--lib/ssl/src/ssl_sup.erl33
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl369
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl121
-rw-r--r--lib/tools/emacs/erlang-eunit.el94
-rw-r--r--lib/tools/emacs/erlang-start.el5
-rw-r--r--lib/tools/emacs/erlang.el168
-rw-r--r--lib/tools/emacs/test.erl.indented5
-rw-r--r--lib/tools/emacs/test.erl.orig5
-rw-r--r--lib/wx/src/wx_object.erl56
56 files changed, 1332 insertions, 494 deletions
diff --git a/erts/configure.in b/erts/configure.in
index a14b10adbf..63bf548c89 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -1054,6 +1054,7 @@ fi
AC_SUBST(ERTS_BUILD_SMP_EMU)
+AC_CHECK_FUNCS([posix_fadvise])
#
@@ -1757,6 +1758,12 @@ fi
dnl Need by run_erl.
AC_CHECK_FUNCS([openpty])
+dnl fdatasync syscall (Unix only)
+AC_CHECK_FUNCS([fdatasync])
+
+dnl Find which C libraries are required to use fdatasync
+AC_SEARCH_LIBS(fdatasync, [rt])
+
dnl ----------------------------------------------------------------------
dnl Checks for features/quirks in the system that affects Erlang.
dnl ----------------------------------------------------------------------
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index a1955235b7..0f20d36167 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -1173,14 +1173,14 @@ EXTERN_FUNCTION(void*, sys_calloc2, (Uint, Uint));
/* Standard set of integer macros .. */
-#define get_int64(s) ((((unsigned char*) (s))[0] << 56) | \
- (((unsigned char*) (s))[1] << 48) | \
- (((unsigned char*) (s))[2] << 40) | \
- (((unsigned char*) (s))[3] << 32) | \
- (((unsigned char*) (s))[4] << 24) | \
- (((unsigned char*) (s))[5] << 16) | \
- (((unsigned char*) (s))[6] << 8) | \
- (((unsigned char*) (s))[7]))
+#define get_int64(s) (((Uint64)(((unsigned char*) (s))[0]) << 56) | \
+ (((Uint64)((unsigned char*) (s))[1]) << 48) | \
+ (((Uint64)((unsigned char*) (s))[2]) << 40) | \
+ (((Uint64)((unsigned char*) (s))[3]) << 32) | \
+ (((Uint64)((unsigned char*) (s))[4]) << 24) | \
+ (((Uint64)((unsigned char*) (s))[5]) << 16) | \
+ (((Uint64)((unsigned char*) (s))[6]) << 8) | \
+ (((Uint64)((unsigned char*) (s))[7])))
#define put_int64(i, s) do {((char*)(s))[0] = (char)((Sint64)(i) >> 56) & 0xff;\
((char*)(s))[1] = (char)((Sint64)(i) >> 48) & 0xff;\
diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c
index d2b916000e..60ae4cb108 100644
--- a/erts/emulator/drivers/common/efile_drv.c
+++ b/erts/emulator/drivers/common/efile_drv.c
@@ -53,6 +53,8 @@
#define FILE_IPREAD 27
#define FILE_ALTNAME 28
#define FILE_READ_LINE 29
+#define FILE_FDATASYNC 30
+#define FILE_FADVISE 31
/* Return codes */
@@ -357,6 +359,11 @@ struct t_data
struct t_readdir_buf *first_buf;
struct t_readdir_buf *last_buf;
} read_dir;
+ struct {
+ Sint64 offset;
+ Sint64 length;
+ int advise;
+ } fadvise;
} c;
char b[1];
};
@@ -883,6 +890,15 @@ static void invoke_chdir(void *data)
invoke_name(data, efile_chdir);
}
+static void invoke_fdatasync(void *data)
+{
+ struct t_data *d = (struct t_data *) data;
+ int fd = (int) d->fd;
+
+ d->again = 0;
+ d->result_ok = efile_fdatasync(&d->errInfo, fd);
+}
+
static void invoke_fsync(void *data)
{
struct t_data *d = (struct t_data *) data;
@@ -1637,6 +1653,18 @@ static void invoke_open(void *data)
d->result_ok = status;
}
+static void invoke_fadvise(void *data)
+{
+ struct t_data *d = (struct t_data *) data;
+ int fd = (int) d->fd;
+ off_t offset = (off_t) d->c.fadvise.offset;
+ off_t length = (off_t) d->c.fadvise.length;
+ int advise = (int) d->c.fadvise.advise;
+
+ d->again = 0;
+ d->result_ok = efile_fadvise(&d->errInfo, fd, offset, length, advise);
+}
+
static void free_readdir(void *data)
{
struct t_data *d = (struct t_data *) data;
@@ -1919,12 +1947,14 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data)
case FILE_RMDIR:
case FILE_CHDIR:
case FILE_DELETE:
+ case FILE_FDATASYNC:
case FILE_FSYNC:
case FILE_TRUNCATE:
case FILE_LINK:
case FILE_SYMLINK:
case FILE_RENAME:
case FILE_WRITE_INFO:
+ case FILE_FADVISE:
reply(desc, d->result_ok, &d->errInfo);
free_data(data);
break;
@@ -2209,6 +2239,18 @@ file_output(ErlDrvData e, char* buf, int count)
goto done;
}
+ case FILE_FDATASYNC:
+ {
+ d = EF_SAFE_ALLOC(sizeof(struct t_data));
+
+ d->fd = fd;
+ d->command = command;
+ d->invoke = invoke_fdatasync;
+ d->free = free_data;
+ d->level = 2;
+ goto done;
+ }
+
case FILE_FSYNC:
{
d = EF_SAFE_ALLOC(sizeof(struct t_data));
@@ -2332,6 +2374,21 @@ file_output(ErlDrvData e, char* buf, int count)
goto done;
}
+ case FILE_FADVISE:
+ {
+ d = EF_SAFE_ALLOC(sizeof(struct t_data));
+
+ d->fd = fd;
+ d->command = command;
+ d->invoke = invoke_fadvise;
+ d->free = free_data;
+ d->level = 2;
+ d->c.fadvise.offset = get_int64((uchar*) buf);
+ d->c.fadvise.length = get_int64(((uchar*) buf) + sizeof(Sint64));
+ d->c.fadvise.advise = get_int32(((uchar*) buf) + 2 * sizeof(Sint64));
+ goto done;
+ }
+
}
/*
diff --git a/erts/emulator/drivers/common/erl_efile.h b/erts/emulator/drivers/common/erl_efile.h
index 9aa941e550..bbc973d58b 100644
--- a/erts/emulator/drivers/common/erl_efile.h
+++ b/erts/emulator/drivers/common/erl_efile.h
@@ -1,19 +1,19 @@
/*
* %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2009. All Rights Reserved.
- *
+ *
+ * Copyright Ericsson AB 1997-2010. All Rights Reserved.
+ *
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
* 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%
*/
/*
@@ -126,6 +126,7 @@ int efile_readdir(Efile_error* errInfo, char* name,
int efile_openfile(Efile_error* errInfo, char* name, int flags,
int* pfd, Sint64* pSize);
void efile_closefile(int fd);
+int efile_fdatasync(Efile_error* errInfo, int fd);
int efile_fsync(Efile_error* errInfo, int fd);
int efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo,
char *name, int info_for_link);
@@ -150,3 +151,5 @@ int efile_altname(Efile_error* errInfo, char *name,
int efile_link(Efile_error* errInfo, char* old, char* new);
int efile_symlink(Efile_error* errInfo, char* old, char* new);
int efile_may_openfile(Efile_error* errInfo, char *name);
+int efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length,
+ int advise);
diff --git a/erts/emulator/drivers/common/ram_file_drv.c b/erts/emulator/drivers/common/ram_file_drv.c
index 4a39a156e6..abedcc933a 100644
--- a/erts/emulator/drivers/common/ram_file_drv.c
+++ b/erts/emulator/drivers/common/ram_file_drv.c
@@ -35,6 +35,7 @@
#define RAM_FILE_TRUNCATE 14
#define RAM_FILE_PREAD 17
#define RAM_FILE_PWRITE 18
+#define RAM_FILE_FDATASYNC 19
/* other operations */
#define RAM_FILE_GET 30
@@ -45,6 +46,8 @@
#define RAM_FILE_UUENCODE 35 /* uuencode file */
#define RAM_FILE_UUDECODE 36 /* uudecode file */
#define RAM_FILE_SIZE 37 /* get file size */
+#define RAM_FILE_ADVISE 38 /* predeclare the access
+ * pattern for file data */
/* possible new operations include:
DES_ENCRYPT
DES_DECRYPT
@@ -558,6 +561,13 @@ static void rfile_command(ErlDrvData e, char* buf, int count)
numeric_reply(f, 0); /* 0 is not used */
break;
+ case RAM_FILE_FDATASYNC:
+ if (f->flags == 0)
+ error_reply(f, EBADF);
+ else
+ reply(f, 1, 0);
+ break;
+
case RAM_FILE_FSYNC:
if (f->flags == 0)
error_reply(f, EBADF);
@@ -685,6 +695,13 @@ static void rfile_command(ErlDrvData e, char* buf, int count)
case RAM_FILE_UUDECODE: /* uudecode file */
ram_file_uudecode(f);
break;
+
+ case RAM_FILE_ADVISE:
+ if (f->flags == 0)
+ error_reply(f, EBADF);
+ else
+ reply(f, 1, 0);
+ break;
}
/*
* Ignore anything else -- let the caller hang.
diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c
index 1d094ee613..ea016526ef 100644
--- a/erts/emulator/drivers/unix/unix_efile.c
+++ b/erts/emulator/drivers/unix/unix_efile.c
@@ -774,6 +774,17 @@ efile_closefile(int fd)
}
int
+efile_fdatasync(Efile_error *errInfo, /* Where to return error codes. */
+ int fd) /* File descriptor for file to sync data. */
+{
+#ifdef HAVE_FDATASYNC
+ return check_error(fdatasync(fd), errInfo);
+#else
+ return efile_fsync(errInfo, fd);
+#endif
+}
+
+int
efile_fsync(Efile_error *errInfo, /* Where to return error codes. */
int fd) /* File descriptor for file to sync. */
{
@@ -1437,3 +1448,14 @@ efile_symlink(Efile_error* errInfo, char* old, char* new)
return check_error(symlink(old, new), errInfo);
#endif
}
+
+int
+efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset,
+ Sint64 length, int advise)
+{
+#ifdef HAVE_POSIX_FADVISE
+ return check_error(posix_fadvise(fd, offset, length, advise), errInfo);
+#else
+ return check_error(0, errInfo);
+#endif
+}
diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c
index 89aaad31da..d5f2b79706 100644
--- a/erts/emulator/drivers/win32/win_efile.c
+++ b/erts/emulator/drivers/win32/win_efile.c
@@ -1,19 +1,19 @@
/*
* %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2009. All Rights Reserved.
- *
+ *
+ * Copyright Ericsson AB 1997-2010. All Rights Reserved.
+ *
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
* 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%
*/
/*
@@ -764,6 +764,15 @@ int fd; /* File descriptor for file to close. */
}
int
+efile_fdatasync(errInfo, fd)
+Efile_error* errInfo; /* Where to return error codes. */
+int fd; /* File descriptor for file to sync. */
+{
+ /* Not available in Windows, just call regular fsync */
+ return efile_fsync(errInfo, fd);
+}
+
+int
efile_fsync(errInfo, fd)
Efile_error* errInfo; /* Where to return error codes. */
int fd; /* File descriptor for file to sync. */
@@ -1424,3 +1433,12 @@ efile_symlink(Efile_error* errInfo, char* old, char* new)
errno = ENOTSUP;
return check_error(-1, errInfo);
}
+
+int
+efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset,
+ Sint64 length, int advise)
+{
+ /* posix_fadvise is not available on Windows, do nothing */
+ errno = ERROR_SUCCESS;
+ return check_error(0, errInfo);
+}
diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam
index afd8a90b3f..fe3cee1c56 100644
--- a/erts/preloaded/ebin/erl_prim_loader.beam
+++ b/erts/preloaded/ebin/erl_prim_loader.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index 4ec84948d8..5a4c5e9d1e 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
Binary files differ
diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam
index c3e746f3ee..cfe2c36cee 100644
--- a/erts/preloaded/ebin/init.beam
+++ b/erts/preloaded/ebin/init.beam
Binary files differ
diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam
index 4b2d8bb2de..74587de26b 100644
--- a/erts/preloaded/ebin/otp_ring0.beam
+++ b/erts/preloaded/ebin/otp_ring0.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam
index 2916baaa77..c6610b71e6 100644
--- a/erts/preloaded/ebin/prim_file.beam
+++ b/erts/preloaded/ebin/prim_file.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam
index 46912e2bea..8d19923281 100644
--- a/erts/preloaded/ebin/prim_inet.beam
+++ b/erts/preloaded/ebin/prim_inet.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam
index ccf8aff6f6..cd41f36413 100644
--- a/erts/preloaded/ebin/prim_zip.beam
+++ b/erts/preloaded/ebin/prim_zip.beam
Binary files differ
diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam
index ccd597ba68..ce1163d260 100644
--- a/erts/preloaded/ebin/zlib.beam
+++ b/erts/preloaded/ebin/zlib.beam
Binary files differ
diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl
index 43e6f6cd88..2d177bf80e 100644
--- a/erts/preloaded/src/prim_file.erl
+++ b/erts/preloaded/src/prim_file.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2000-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
-module(prim_file).
@@ -25,7 +25,7 @@
%%% Interface towards a single file's contents. Uses ?FD_DRV.
%% Generic file contents operations
--export([open/2, close/1, sync/1, position/2, truncate/1,
+-export([open/2, close/1, datasync/1, sync/1, advise/4, position/2, truncate/1,
write/2, pwrite/2, pwrite/3, read/2, read_line/1, pread/2, pread/3, copy/3]).
%% Specialized file operations
@@ -96,6 +96,8 @@
-define(FILE_IPREAD, 27).
-define(FILE_ALTNAME, 28).
-define(FILE_READ_LINE, 29).
+-define(FILE_FDATASYNC, 30).
+-define(FILE_ADVISE, 31).
%% Driver responses
-define(FILE_RESP_OK, 0).
@@ -130,6 +132,13 @@
%% IPREAD variants
-define(IPREAD_S32BU_P32BU, 0).
+%% POSIX file advises
+-define(POSIX_FADV_NORMAL, 0).
+-define(POSIX_FADV_RANDOM, 1).
+-define(POSIX_FADV_SEQUENTIAL, 2).
+-define(POSIX_FADV_WILLNEED, 3).
+-define(POSIX_FADV_DONTNEED, 4).
+-define(POSIX_FADV_NOREUSE, 5).
%%%-----------------------------------------------------------------
@@ -220,7 +229,35 @@ close(#file_descriptor{module = ?MODULE, data = {Port, _}}) ->
close(Port) when is_port(Port) ->
drv_close(Port).
+-define(ADVISE(Offs, Len, Adv),
+ <<?FILE_ADVISE, Offs:64/signed, Len:64/signed,
+ Adv:32/signed>>).
+%% Returns {error, Reason} | ok.
+advise(#file_descriptor{module = ?MODULE, data = {Port, _}},
+ Offset, Length, Advise) ->
+ case Advise of
+ normal ->
+ Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_NORMAL),
+ drv_command(Port, Cmd);
+ random ->
+ Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_RANDOM),
+ drv_command(Port, Cmd);
+ sequential ->
+ Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_SEQUENTIAL),
+ drv_command(Port, Cmd);
+ will_need ->
+ Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_WILLNEED),
+ drv_command(Port, Cmd);
+ dont_need ->
+ Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_DONTNEED),
+ drv_command(Port, Cmd);
+ no_reuse ->
+ Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_NOREUSE),
+ drv_command(Port, Cmd);
+ _ ->
+ {error, einval}
+ end.
%% Returns {error, Reason} | ok.
write(#file_descriptor{module = ?MODULE, data = {Port, _}}, Bytes) ->
@@ -292,6 +329,9 @@ pwrite(#file_descriptor{module = ?MODULE}, _, _) ->
{error, badarg}.
+%% Returns {error, Reason} | ok.
+datasync(#file_descriptor{module = ?MODULE, data = {Port, _}}) ->
+ drv_command(Port, [?FILE_FDATASYNC]).
%% Returns {error, Reason} | ok.
sync(#file_descriptor{module = ?MODULE, data = {Port, _}}) ->
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 08de3059c9..d5dfde6514 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -900,13 +900,8 @@ expand_module(#compile{code=Code,options=Opts0}=St0) ->
{ok,St0#compile{module=Mod,options=Opts,code={Mod,Exp,Forms}}}.
core_module(#compile{code=Code0,options=Opts}=St) ->
- case v3_core:module(Code0, Opts) of
- {ok,Code,Ws} ->
- {ok,St#compile{code=Code,warnings=St#compile.warnings ++ Ws}};
- {error,Es,Ws} ->
- {error,St#compile{warnings=St#compile.warnings ++ Ws,
- errors=St#compile.errors ++ Es}}
- end.
+ {ok,Code,Ws} = v3_core:module(Code0, Opts),
+ {ok,St#compile{code=Code,warnings=St#compile.warnings ++ Ws}}.
core_fold_module(#compile{code=Code0,options=Opts,warnings=Warns}=St) ->
{ok,Code,Ws} = sys_core_fold:module(Code0, Opts),
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 16c5b6b415..f6bb45787c 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -122,7 +122,6 @@
| iclause() | ifun() | iletrec() | imatch() | iprimop()
| iprotect() | ireceive1() | ireceive2() | iset() | itry().
--type error() :: {file:filename(), [{integer(), module(), term()}]}.
-type warning() :: {file:filename(), [{integer(), module(), term()}]}.
-record(core, {vcount=0 :: non_neg_integer(), %Variable counter
@@ -140,7 +139,7 @@
| {attribute, integer(), attribute(), _}.
-spec module({module(), [fa()], [form()]}, [compile:option()]) ->
- {'ok',cerl:c_module(),[warning()]} | {'error',[error()],[warning()]}.
+ {'ok',cerl:c_module(),[warning()]}.
module({Mod,Exp,Forms}, Opts) ->
Cexp = map(fun ({_N,_A} = NA) -> #c_var{name=NA} end, Exp),
diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml
index 50f9722a1c..382262d1ee 100644
--- a/lib/kernel/doc/src/file.xml
+++ b/lib/kernel/doc/src/file.xml
@@ -62,6 +62,25 @@ time() = {{Year, Month, Day}, {Hour, Minute, Second}}
</section>
<funcs>
<func>
+ <name>advise(IoDevice, Offset, Length, Advise) -> ok | {error, Reason}</name>
+ <fsummary>Predeclare an access pattern for file data</fsummary>
+ <type>
+ <v>IoDevice = io_device()</v>
+ <v>Offset = int()</v>
+ <v>Length = int()</v>
+ <v>Advise = posix_file_advise()</v>
+ <v>posix_file_advise() = normal | sequential | random | no_reuse
+ | will_need | dont_need</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p><c>advise/4</c> can be used to announce an intention to access file
+ data in a specific pattern in the future, thus allowing the
+ operating system to perform appropriate optimizations.</p>
+ <p>On some platforms, this function might have no effect.</p>
+ </desc>
+ </func>
+ <func>
<name>change_group(Filename, Gid) -> ok | {error, Reason}</name>
<fsummary>Change group of a file</fsummary>
<type>
@@ -1641,6 +1660,33 @@ f.txt: {person, "kalle", 25}.
</desc>
</func>
<func>
+ <name>datasync(IoDevice) -> ok | {error, Reason}</name>
+ <fsummary>Synchronizes the in-memory data of a file, ignoring most of its metadata, with that on the physical medium</fsummary>
+ <type>
+ <v>IoDevice = io_device()</v>
+ <v>Reason = ext_posix() | terminated</v>
+ </type>
+ <desc>
+ <p>Makes sure that any buffers kept by the operating system
+ (not by the Erlang runtime system) are written to disk. In
+ many ways it's resembles fsync but it not requires to update
+ some of file's metadata such as the access time. On
+ some platforms, this function might have no effect.</p>
+ <p>Applications that access databases or log files often write
+ a tiny data fragment (e.g., one line in a log file) and then
+ call fsync() immediately in order to ensure that the written
+ data is physically stored on the harddisk. Unfortunately, fsync()
+ will always initiate two write operations: one for the newly
+ written data and another one in order to update the modification
+ time stored in the inode. If the modification time is not a part
+ of the transaction concept fdatasync() can be used to avoid
+ unnecessary inode disk write operations.</p>
+ <p>Available only in some POSIX systems. This call results in a
+ call to fsync(), or has no effect, in systems not implementing
+ the fdatasync syscall.</p>
+ </desc>
+ </func>
+ <func>
<name>truncate(IoDevice) -> ok | {error, Reason}</name>
<fsummary>Truncate a file</fsummary>
<type>
diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl
index 46ffa9d708..a694ed0708 100644
--- a/lib/kernel/src/file.erl
+++ b/lib/kernel/src/file.erl
@@ -36,11 +36,11 @@
%% Specialized
-export([ipread_s32bu_p32bu/3]).
%% Generic file contents.
--export([open/2, close/1,
+-export([open/2, close/1, advise/4,
read/2, write/2,
pread/2, pread/3, pwrite/2, pwrite/3,
read_line/1,
- position/2, truncate/1, sync/1,
+ position/2, truncate/1, datasync/1, sync/1,
copy/2, copy/3]).
%% High level operations
-export([consult/1, path_consult/2]).
@@ -89,6 +89,8 @@
-type date() :: {pos_integer(), pos_integer(), pos_integer()}.
-type time() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}.
-type date_time() :: {date(), time()}.
+-type posix_file_advise() :: 'normal' | 'sequential' | 'random' | 'no_reuse' |
+ 'will_need' | 'dont_need'.
%%%-----------------------------------------------------------------
%%% General functions
@@ -352,6 +354,18 @@ close(#file_descriptor{module = Module} = Handle) ->
close(_) ->
{error, badarg}.
+-spec advise(File :: io_device(), Offset :: integer(),
+ Length :: integer(), Advise :: posix_file_advise()) ->
+ 'ok' | {'error', posix()}.
+
+advise(File, Offset, Length, Advise) when is_pid(File) ->
+ R = file_request(File, {advise, Offset, Length, Advise}),
+ wait_file_reply(File, R);
+advise(#file_descriptor{module = Module} = Handle, Offset, Length, Advise) ->
+ Module:advise(Handle, Offset, Length, Advise);
+advise(_, _, _, _) ->
+ {error, badarg}.
+
-spec read(File :: io_device(), Size :: non_neg_integer()) ->
'eof' | {'ok', [char()] | binary()} | {'error', posix()}.
@@ -472,6 +486,16 @@ pwrite(#file_descriptor{module = Module} = Handle, Offs, Bytes) ->
pwrite(_, _, _) ->
{error, badarg}.
+-spec datasync(File :: io_device()) -> 'ok' | {'error', posix()}.
+
+datasync(File) when is_pid(File) ->
+ R = file_request(File, datasync),
+ wait_file_reply(File, R);
+datasync(#file_descriptor{module = Module} = Handle) ->
+ Module:datasync(Handle);
+datasync(_) ->
+ {error, badarg}.
+
-spec sync(File :: io_device()) -> 'ok' | {'error', posix()}.
sync(File) when is_pid(File) ->
diff --git a/lib/kernel/src/file_io_server.erl b/lib/kernel/src/file_io_server.erl
index 3ac35a209d..39dc32bb79 100644
--- a/lib/kernel/src/file_io_server.erl
+++ b/lib/kernel/src/file_io_server.erl
@@ -198,6 +198,14 @@ io_reply(From, ReplyAs, Reply) ->
%%%-----------------------------------------------------------------
%%% file requests
+file_request({advise,Offset,Length,Advise},
+ #state{handle=Handle}=State) ->
+ case ?PRIM_FILE:advise(Handle, Offset, Length, Advise) of
+ {error,_}=Reply ->
+ {stop,normal,Reply,State};
+ Reply ->
+ {reply,Reply,State}
+ end;
file_request({pread,At,Sz},
#state{handle=Handle,buf=Buf,read_mode=ReadMode}=State) ->
case position(Handle, At, Buf) of
@@ -219,6 +227,14 @@ file_request({pwrite,At,Data},
Reply ->
std_reply(Reply, State)
end;
+file_request(datasync,
+ #state{handle=Handle}=State) ->
+ case ?PRIM_FILE:datasync(Handle) of
+ {error,_}=Reply ->
+ {stop,normal,Reply,State};
+ Reply ->
+ {reply,Reply,State}
+ end;
file_request(sync,
#state{handle=Handle}=State) ->
case ?PRIM_FILE:sync(Handle) of
diff --git a/lib/kernel/src/ram_file.erl b/lib/kernel/src/ram_file.erl
index d996650948..48ea871433 100644
--- a/lib/kernel/src/ram_file.erl
+++ b/lib/kernel/src/ram_file.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
-module(ram_file).
@@ -24,11 +24,11 @@
-export([open/2, close/1]).
-export([write/2, read/2, copy/3,
pread/2, pread/3, pwrite/2, pwrite/3,
- position/2, truncate/1, sync/1]).
+ position/2, truncate/1, datasync/1, sync/1]).
%% Specialized file operations
-export([get_size/1, get_file/1, set_file/2, get_file_close/1]).
--export([compress/1, uncompress/1, uuencode/1, uudecode/1]).
+-export([compress/1, uncompress/1, uuencode/1, uudecode/1, advise/4]).
-export([open_mode/1]). %% used by ftp-file
@@ -60,6 +60,7 @@
-define(RAM_FILE_TRUNCATE, 14).
-define(RAM_FILE_PREAD, 17).
-define(RAM_FILE_PWRITE, 18).
+-define(RAM_FILE_FDATASYNC, 19).
%% Other operations
-define(RAM_FILE_GET, 30).
@@ -70,6 +71,7 @@
-define(RAM_FILE_UUENCODE, 35).
-define(RAM_FILE_UUDECODE, 36).
-define(RAM_FILE_SIZE, 37).
+-define(RAM_FILE_ADVISE, 38).
%% Open modes for RAM_FILE_OPEN
-define(RAM_FILE_MODE_READ, 1).
@@ -90,6 +92,14 @@
-define(RAM_FILE_RESP_NUMBER, 3).
-define(RAM_FILE_RESP_INFO, 4).
+%% POSIX file advises
+-define(POSIX_FADV_NORMAL, 0).
+-define(POSIX_FADV_RANDOM, 1).
+-define(POSIX_FADV_SEQUENTIAL, 2).
+-define(POSIX_FADV_WILLNEED, 3).
+-define(POSIX_FADV_DONTNEED, 4).
+-define(POSIX_FADV_NOREUSE, 5).
+
%% --------------------------------------------------------------------------
%% Generic file contents operations.
%%
@@ -167,6 +177,8 @@ copy(#file_descriptor{module = ?MODULE} = Source,
%% XXX Should be moved down to the driver for optimization.
file:copy_opened(Source, Dest, Length).
+datasync(#file_descriptor{module = ?MODULE, data = Port}) ->
+ call_port(Port, <<?RAM_FILE_FDATASYNC>>).
sync(#file_descriptor{module = ?MODULE, data = Port}) ->
call_port(Port, <<?RAM_FILE_FSYNC>>).
@@ -349,6 +361,28 @@ uudecode(#file_descriptor{module = ?MODULE, data = Port}) ->
uudecode(#file_descriptor{}) ->
{error, enotsup}.
+advise(#file_descriptor{module = ?MODULE, data = Port}, Offset,
+ Length, Advise) ->
+ Cmd0 = <<?RAM_FILE_ADVISE, Offset:64/signed, Length:64/signed>>,
+ case Advise of
+ normal ->
+ call_port(Port, <<Cmd0/binary, ?POSIX_FADV_NORMAL:32/signed>>);
+ random ->
+ call_port(Port, <<Cmd0/binary, ?POSIX_FADV_RANDOM:32/signed>>);
+ sequential ->
+ call_port(Port, <<Cmd0/binary, ?POSIX_FADV_SEQUENTIAL:32/signed>>);
+ will_need ->
+ call_port(Port, <<Cmd0/binary, ?POSIX_FADV_WILLNEED:32/signed>>);
+ dont_need ->
+ call_port(Port, <<Cmd0/binary, ?POSIX_FADV_DONTNEED:32/signed>>);
+ no_reuse ->
+ call_port(Port, <<Cmd0/binary, ?POSIX_FADV_NOREUSE:32/signed>>);
+ _ ->
+ {error, einval}
+ end;
+advise(#file_descriptor{}, _Offset, _Length, _Advise) ->
+ {error, enotsup}.
+
%%%-----------------------------------------------------------------
diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl
index 1d170790a3..1d652679b0 100644
--- a/lib/kernel/test/file_SUITE.erl
+++ b/lib/kernel/test/file_SUITE.erl
@@ -52,7 +52,7 @@
old_modes/1, new_modes/1, path_open/1, open_errors/1]).
-export([file_info/1, file_info_basic_file/1, file_info_basic_directory/1,
file_info_bad/1, file_info_times/1, file_write_file_info/1]).
--export([rename/1, access/1, truncate/1, sync/1,
+-export([rename/1, access/1, truncate/1, datasync/1, sync/1,
read_write/1, pread_write/1, append/1]).
-export([errors/1, e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]).
-export([otp_5814/1]).
@@ -82,6 +82,8 @@
-export([read_line_1/1, read_line_2/1, read_line_3/1,read_line_4/1]).
+-export([advise/1]).
+
%% Debug exports
-export([create_file_slow/2, create_file/2, create_bin/2]).
-export([verify_file/2, verify_bin/3]).
@@ -377,7 +379,9 @@ win_cur_dir_1(_Config) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-files(suite) -> [open,pos,file_info,consult,eval,script,truncate,sync].
+files(suite) ->
+ [open,pos,file_info,consult,eval,script,truncate,
+ sync,datasync,advise].
open(suite) -> [open1,old_modes,new_modes,path_open,close,access,read_write,
pread_write,append,open_errors].
@@ -1355,6 +1359,30 @@ truncate(Config) when is_list(Config) ->
ok.
+datasync(suite) -> [];
+datasync(doc) -> "Tests that ?FILE_MODULE:datasync/1 at least doesn't crash.";
+datasync(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line Sync = filename:join(PrivDir,
+ atom_to_list(?MODULE)
+ ++"_sync.fil"),
+
+ %% Raw open.
+ ?line {ok, Fd} = ?FILE_MODULE:open(Sync, [write, raw]),
+ ?line ok = ?FILE_MODULE:datasync(Fd),
+ ?line ok = ?FILE_MODULE:close(Fd),
+
+ %% Ordinary open.
+ ?line {ok, Fd2} = ?FILE_MODULE:open(Sync, [write]),
+ ?line ok = ?FILE_MODULE:datasync(Fd2),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
sync(suite) -> [];
sync(doc) -> "Tests that ?FILE_MODULE:sync/1 at least doesn't crash.";
sync(Config) when is_list(Config) ->
@@ -1378,6 +1406,77 @@ sync(Config) when is_list(Config) ->
?line test_server:timetrap_cancel(Dog),
ok.
+advise(suite) -> [];
+advise(doc) -> "Tests that ?FILE_MODULE:advise/4 at least doesn't crash.";
+advise(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line Advise = filename:join(PrivDir,
+ atom_to_list(?MODULE)
+ ++"_advise.fil"),
+
+ Line1 = "Hello\n",
+ Line2 = "World!\n",
+
+ ?line {ok, Fd} = ?FILE_MODULE:open(Advise, [write]),
+ ?line ok = ?FILE_MODULE:advise(Fd, 0, 0, normal),
+ ?line ok = io:format(Fd, "~s", [Line1]),
+ ?line ok = io:format(Fd, "~s", [Line2]),
+ ?line ok = ?FILE_MODULE:close(Fd),
+
+ ?line {ok, Fd2} = ?FILE_MODULE:open(Advise, [write]),
+ ?line ok = ?FILE_MODULE:advise(Fd2, 0, 0, random),
+ ?line ok = io:format(Fd2, "~s", [Line1]),
+ ?line ok = io:format(Fd2, "~s", [Line2]),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+
+ ?line {ok, Fd3} = ?FILE_MODULE:open(Advise, [write]),
+ ?line ok = ?FILE_MODULE:advise(Fd3, 0, 0, sequential),
+ ?line ok = io:format(Fd3, "~s", [Line1]),
+ ?line ok = io:format(Fd3, "~s", [Line2]),
+ ?line ok = ?FILE_MODULE:close(Fd3),
+
+ ?line {ok, Fd4} = ?FILE_MODULE:open(Advise, [write]),
+ ?line ok = ?FILE_MODULE:advise(Fd4, 0, 0, will_need),
+ ?line ok = io:format(Fd4, "~s", [Line1]),
+ ?line ok = io:format(Fd4, "~s", [Line2]),
+ ?line ok = ?FILE_MODULE:close(Fd4),
+
+ ?line {ok, Fd5} = ?FILE_MODULE:open(Advise, [write]),
+ ?line ok = ?FILE_MODULE:advise(Fd5, 0, 0, dont_need),
+ ?line ok = io:format(Fd5, "~s", [Line1]),
+ ?line ok = io:format(Fd5, "~s", [Line2]),
+ ?line ok = ?FILE_MODULE:close(Fd5),
+
+ ?line {ok, Fd6} = ?FILE_MODULE:open(Advise, [write]),
+ ?line ok = ?FILE_MODULE:advise(Fd6, 0, 0, no_reuse),
+ ?line ok = io:format(Fd6, "~s", [Line1]),
+ ?line ok = io:format(Fd6, "~s", [Line2]),
+ ?line ok = ?FILE_MODULE:close(Fd6),
+
+ ?line {ok, Fd7} = ?FILE_MODULE:open(Advise, [write]),
+ ?line {error, einval} = ?FILE_MODULE:advise(Fd7, 0, 0, bad_advise),
+ ?line ok = ?FILE_MODULE:close(Fd7),
+
+ %% test write without advise, then a read after an advise
+ ?line {ok, Fd8} = ?FILE_MODULE:open(Advise, [write]),
+ ?line ok = io:format(Fd8, "~s", [Line1]),
+ ?line ok = io:format(Fd8, "~s", [Line2]),
+ ?line ok = ?FILE_MODULE:close(Fd8),
+ ?line {ok, Fd9} = ?FILE_MODULE:open(Advise, [read]),
+ Offset = 0,
+ %% same as a 0 length in some implementations
+ Length = length(Line1) + length(Line2),
+ ?line ok = ?FILE_MODULE:advise(Fd9, Offset, Length, sequential),
+ ?line {ok, Line1} = ?FILE_MODULE:read_line(Fd9),
+ ?line {ok, Line2} = ?FILE_MODULE:read_line(Fd9),
+ ?line eof = ?FILE_MODULE:read_line(Fd9),
+ ?line ok = ?FILE_MODULE:close(Fd9),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl
index 6badbb5090..21bdc06fdc 100644
--- a/lib/kernel/test/prim_file_SUITE.erl
+++ b/lib/kernel/test/prim_file_SUITE.erl
@@ -34,7 +34,7 @@
file_info_times_a/1, file_info_times_b/1,
file_write_file_info_a/1, file_write_file_info_b/1]).
-export([rename_a/1, rename_b/1,
- access/1, truncate/1, sync/1,
+ access/1, truncate/1, datasync/1, sync/1,
read_write/1, pread_write/1, append/1]).
-export([errors/1, e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]).
@@ -48,6 +48,8 @@
symlinks_a/1, symlinks_b/1,
list_dir_limit/1]).
+-export([advise/1]).
+
-include("test_server.hrl").
-include_lib("kernel/include/file.hrl").
@@ -380,7 +382,7 @@ win_cur_dir_1(_Config, Handle) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-files(suite) -> [open,pos,file_info,truncate,sync].
+files(suite) -> [open,pos,file_info,truncate,sync,datasync,advise].
open(suite) -> [open1,modes,close,access,read_write,
pread_write,append].
@@ -1064,6 +1066,24 @@ truncate(Config) when is_list(Config) ->
ok.
+datasync(suite) -> [];
+datasync(doc) -> "Tests that ?PRIM_FILE:datasync/1 at least doesn't crash.";
+datasync(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line Sync = filename:join(PrivDir,
+ atom_to_list(?MODULE)
+ ++"_sync.fil"),
+
+ %% Raw open.
+ ?line {ok, Fd} = ?PRIM_FILE:open(Sync, [write]),
+ ?line ok = ?PRIM_FILE:datasync(Fd),
+ ?line ok = ?PRIM_FILE:close(Fd),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
sync(suite) -> [];
sync(doc) -> "Tests that ?PRIM_FILE:sync/1 at least doesn't crash.";
sync(Config) when is_list(Config) ->
@@ -1082,6 +1102,77 @@ sync(Config) when is_list(Config) ->
ok.
+advise(suite) -> [];
+advise(doc) -> "Tests that ?PRIM_FILE:advise/4 at least doesn't crash.";
+advise(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line Advise = filename:join(PrivDir,
+ atom_to_list(?MODULE)
+ ++"_advise.fil"),
+
+ Line1 = "Hello\n",
+ Line2 = "World!\n",
+
+ ?line {ok, Fd} = ?PRIM_FILE:open(Advise, [write]),
+ ?line ok = ?PRIM_FILE:advise(Fd, 0, 0, normal),
+ ?line ok = ?PRIM_FILE:write(Fd, Line1),
+ ?line ok = ?PRIM_FILE:write(Fd, Line2),
+ ?line ok = ?PRIM_FILE:close(Fd),
+
+ ?line {ok, Fd2} = ?PRIM_FILE:open(Advise, [write]),
+ ?line ok = ?PRIM_FILE:advise(Fd2, 0, 0, random),
+ ?line ok = ?PRIM_FILE:write(Fd2, Line1),
+ ?line ok = ?PRIM_FILE:write(Fd2, Line2),
+ ?line ok = ?PRIM_FILE:close(Fd2),
+
+ ?line {ok, Fd3} = ?PRIM_FILE:open(Advise, [write]),
+ ?line ok = ?PRIM_FILE:advise(Fd3, 0, 0, sequential),
+ ?line ok = ?PRIM_FILE:write(Fd3, Line1),
+ ?line ok = ?PRIM_FILE:write(Fd3, Line2),
+ ?line ok = ?PRIM_FILE:close(Fd3),
+
+ ?line {ok, Fd4} = ?PRIM_FILE:open(Advise, [write]),
+ ?line ok = ?PRIM_FILE:advise(Fd4, 0, 0, will_need),
+ ?line ok = ?PRIM_FILE:write(Fd4, Line1),
+ ?line ok = ?PRIM_FILE:write(Fd4, Line2),
+ ?line ok = ?PRIM_FILE:close(Fd4),
+
+ ?line {ok, Fd5} = ?PRIM_FILE:open(Advise, [write]),
+ ?line ok = ?PRIM_FILE:advise(Fd5, 0, 0, dont_need),
+ ?line ok = ?PRIM_FILE:write(Fd5, Line1),
+ ?line ok = ?PRIM_FILE:write(Fd5, Line2),
+ ?line ok = ?PRIM_FILE:close(Fd5),
+
+ ?line {ok, Fd6} = ?PRIM_FILE:open(Advise, [write]),
+ ?line ok = ?PRIM_FILE:advise(Fd6, 0, 0, no_reuse),
+ ?line ok = ?PRIM_FILE:write(Fd6, Line1),
+ ?line ok = ?PRIM_FILE:write(Fd6, Line2),
+ ?line ok = ?PRIM_FILE:close(Fd6),
+
+ ?line {ok, Fd7} = ?PRIM_FILE:open(Advise, [write]),
+ ?line {error, einval} = ?PRIM_FILE:advise(Fd7, 0, 0, bad_advise),
+ ?line ok = ?PRIM_FILE:close(Fd7),
+
+ %% test write without advise, then a read after an advise
+ ?line {ok, Fd8} = ?PRIM_FILE:open(Advise, [write]),
+ ?line ok = ?PRIM_FILE:write(Fd8, Line1),
+ ?line ok = ?PRIM_FILE:write(Fd8, Line2),
+ ?line ok = ?PRIM_FILE:close(Fd8),
+ ?line {ok, Fd9} = ?PRIM_FILE:open(Advise, [read]),
+ Offset = 0,
+ %% same as a 0 length in some implementations
+ Length = length(Line1) + length(Line2),
+ ?line ok = ?PRIM_FILE:advise(Fd9, Offset, Length, sequential),
+ ?line {ok, Line1} = ?PRIM_FILE:read_line(Fd9),
+ ?line {ok, Line2} = ?PRIM_FILE:read_line(Fd9),
+ ?line eof = ?PRIM_FILE:read_line(Fd9),
+ ?line ok = ?PRIM_FILE:close(Fd9),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
delete_a(suite) -> [];
diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml
index eb7c9db6ba..45e1549de7 100644
--- a/lib/snmp/doc/src/notes.xml
+++ b/lib/snmp/doc/src/notes.xml
@@ -60,6 +60,12 @@
<p>Own Id: OTP-8594</p>
</item>
+ <item>
+ <p>Auto [agent] Changed default value for the MIB server cache.
+ GC is now on by default. </p>
+ <p>Own Id: OTP-8648</p>
+ </item>
+
</list>
</section>
@@ -83,6 +89,15 @@
<p>Own Id: OTP-8595</p>
</item>
+ <item>
+ <p>[manager] Raise condition causing the manager server process to
+ crash. Unregistering an agent while traffic (set/get-operations)
+ is ongoing could cause a crash in the manager server process
+ (raise condition). </p>
+ <p>Own Id: OTP-8646</p>
+ <p>Aux Id: Seq 11585</p>
+ </item>
+
</list>
</section>
diff --git a/lib/snmp/doc/src/snmp_app.xml b/lib/snmp/doc/src/snmp_app.xml
index 57eb87a759..694e619da1 100644
--- a/lib/snmp/doc/src/snmp_app.xml
+++ b/lib/snmp/doc/src/snmp_app.xml
@@ -346,7 +346,7 @@
<p>Defines if the mib server shall perform cache gc automatically or
leave it to the user (see
<seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p>
- <p>Default is <c>false</c>.</p>
+ <p>Default is <c>true</c>.</p>
</item>
<tag><c><![CDATA[mibs_cache_age() = integer() > 0 <optional>]]></c></tag>
diff --git a/lib/snmp/doc/src/snmp_config.xml b/lib/snmp/doc/src/snmp_config.xml
index 5bd36305fc..769b908adc 100644
--- a/lib/snmp/doc/src/snmp_config.xml
+++ b/lib/snmp/doc/src/snmp_config.xml
@@ -343,7 +343,7 @@
<p>Defines if the mib server shall perform cache gc automatically or
leave it to the user (see
<seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p>
- <p>Default is <c>false</c>.</p>
+ <p>Default is <c>true</c>.</p>
</item>
<tag><c><![CDATA[mibs_cache_age() = integer() > 0 <optional>]]></c></tag>
diff --git a/lib/snmp/doc/src/snmpa.xml b/lib/snmp/doc/src/snmpa.xml
index b3661ae9b0..69fe6d62f4 100644
--- a/lib/snmp/doc/src/snmpa.xml
+++ b/lib/snmp/doc/src/snmpa.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2004</year><year>2009</year>
+ <year>2004</year><year>2010</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -13,12 +13,12 @@
compliance with the License. You should have received a copy of the
Erlang Public License along with this software. If not, it can be
retrieved online at http://www.erlang.org/.
-
+
Software distributed under the License is distributed on an "AS IS"
basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
the License for the specific language governing rights and limitations
under the License.
-
+
</legalnotice>
<title>snmpa</title>
@@ -648,6 +648,20 @@ notification_delivery_info() = #snmpa_notification_delivery_info{}
<desc>
<p>Disable the mib server cache. </p>
+ <marker id="which_mibs_cache_size"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>which_mibs_cache_size() -> void()</name>
+ <name>which_mibs_cache_size(Agent) -> void()</name>
+ <fsummary>The size of the mib server cache</fsummary>
+ <type>
+ <v>Agent = pid() | atom()</v>
+ </type>
+ <desc>
+ <p>Retreive the size of the mib server cache. </p>
+
<marker id="gc_mibs_cache"></marker>
</desc>
</func>
diff --git a/lib/snmp/src/agent/snmpa.erl b/lib/snmp/src/agent/snmpa.erl
index a113bba3a7..1c37d76074 100644
--- a/lib/snmp/src/agent/snmpa.erl
+++ b/lib/snmp/src/agent/snmpa.erl
@@ -47,6 +47,7 @@
mib_of/1, mib_of/2,
me_of/1, me_of/2,
invalidate_mibs_cache/0, invalidate_mibs_cache/1,
+ which_mibs_cache_size/0, which_mibs_cache_size/1,
enable_mibs_cache/0, enable_mibs_cache/1,
disable_mibs_cache/0, disable_mibs_cache/1,
gc_mibs_cache/0, gc_mibs_cache/1, gc_mibs_cache/2, gc_mibs_cache/3,
@@ -302,6 +303,13 @@ invalidate_mibs_cache(Agent) ->
snmpa_agent:invalidate_mibs_cache(Agent).
+which_mibs_cache_size() ->
+ which_mibs_cache_size(snmp_master_agent).
+
+which_mibs_cache_size(Agent) ->
+ snmpa_agent:which_mibs_cache_size(Agent).
+
+
enable_mibs_cache() ->
enable_mibs_cache(snmp_master_agent).
diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl
index fb04fca632..648f5b53fa 100644
--- a/lib/snmp/src/agent/snmpa_agent.erl
+++ b/lib/snmp/src/agent/snmpa_agent.erl
@@ -48,6 +48,7 @@
get/2, get/3, get_next/2, get_next/3]).
-export([mib_of/1, mib_of/2, me_of/1, me_of/2,
invalidate_mibs_cache/1,
+ which_mibs_cache_size/1,
enable_mibs_cache/1, disable_mibs_cache/1,
gc_mibs_cache/1, gc_mibs_cache/2, gc_mibs_cache/3,
enable_mibs_cache_autogc/1, disable_mibs_cache_autogc/1,
@@ -245,6 +246,10 @@ disable_mibs_cache(Agent) ->
call(Agent, {mibs_cache_request, disable_cache}).
+which_mibs_cache_size(Agent) ->
+ call(Agent, {mibs_cache_request, cache_size}).
+
+
enable_mibs_cache_autogc(Agent) ->
call(Agent, {mibs_cache_request, enable_autogc}).
@@ -1219,6 +1224,8 @@ handle_mibs_cache_request(MibServer, Req) ->
snmpa_mib:gc_cache(MibServer, Age);
{gc_cache, Age, GcLimit} ->
snmpa_mib:gc_cache(MibServer, Age, GcLimit);
+ cache_size ->
+ snmpa_mib:which_cache_size(MibServer);
enable_cache ->
snmpa_mib:enable_cache(MibServer);
disable_cache ->
diff --git a/lib/snmp/src/agent/snmpa_mib.erl b/lib/snmp/src/agent/snmpa_mib.erl
index 370989d0be..ce90db18b3 100644
--- a/lib/snmp/src/agent/snmpa_mib.erl
+++ b/lib/snmp/src/agent/snmpa_mib.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
-module(snmpa_mib).
@@ -55,7 +55,7 @@
-define(NO_CACHE, no_mibs_cache).
-define(DEFAULT_CACHE_USAGE, true).
-define(CACHE_GC_TICKTIME, timer:minutes(1)).
--define(DEFAULT_CACHE_AUTOGC, false).
+-define(DEFAULT_CACHE_AUTOGC, true).
-define(DEFAULT_CACHE_GCLIMIT, 100).
-define(DEFAULT_CACHE_AGE, timer:minutes(10)).
-define(CACHE_GC_TRIGGER, cache_gc_trigger).
diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src
index aa3410fea3..a138a2dfd1 100644
--- a/lib/snmp/src/app/snmp.appup.src
+++ b/lib/snmp/src/app/snmp.appup.src
@@ -24,48 +24,59 @@
[
{"4.16.1",
[
+ {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]},
{load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]},
{load_module, snmp_usm, soft_purge, soft_purge, []},
- {load_module, snmp_pdus, soft_purge, soft_purge, []}
+ {load_module, snmp_pdus, soft_purge, soft_purge, []},
+ {update, snmpm_server, soft, soft_purge, soft_purge, []},
+ {update, snmpa_mib, soft, soft_purge, soft_purge, []},
+ {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}
]
},
{"4.16",
[
+ {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]},
{load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]},
{load_module, snmp_usm, soft_purge, soft_purge, []},
{load_module, snmp_pdus, soft_purge, soft_purge, []},
{load_module, snmpa_general_db, soft_purge, soft_purge, []},
- {update, snmpm_net_if, soft, soft_purge, soft_purge, []}
+ {update, snmpm_net_if, soft, soft_purge, soft_purge, []},
+ {update, snmpm_server, soft, soft_purge, soft_purge, []},
+ {update, snmpa_mib, soft, soft_purge, soft_purge, []},
+ {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}
]
},
{"4.15",
[
{load_module, snmp_pdus, soft_purge, soft_purge, []},
- {load_module, snmpa, soft_purge, soft_purge, [snmp_log]},
+ {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]},
{load_module, snmp_config, soft_purge, soft_purge, []},
{load_module, snmp_log, soft_purge, soft_purge, []},
{load_module, snmpa_general_db, soft_purge, soft_purge, []},
- {update, snmpm_net_if, {advanced, upgrade_from_pre_4_16},
- soft_purge, soft_purge, [snmpm_config, snmp_log]},
- {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16},
+ {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16},
soft_purge, soft_purge, [snmpa_agent, snmp_log]},
- {update, snmpa_agent, soft, soft_purge, soft_purge, []},
+ {update, snmpa_mib, soft, soft_purge, soft_purge, []},
+ {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]},
{load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]},
{load_module, snmp_usm, soft_purge, soft_purge, []},
- {update, snmpm_config, soft, soft_purge, soft_purge, []}
+ {update, snmpm_net_if, {advanced, upgrade_from_pre_4_16},
+ soft_purge, soft_purge, [snmpm_config, snmp_log]},
+ {update, snmpm_config, soft, soft_purge, soft_purge, []},
+ {update, snmpm_server, soft, soft_purge, soft_purge, []}
]
},
{"4.14",
[
{load_module, snmp_pdus, soft_purge, soft_purge, []},
- {load_module, snmpa, soft_purge, soft_purge, [snmp_log]},
+ {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]},
{load_module, snmp_config, soft_purge, soft_purge, []},
{load_module, snmp_log, soft_purge, soft_purge, []},
{load_module, snmpa_general_db, soft_purge, soft_purge, []},
{update, snmpa_net_if, {advanced, upgrade_from_pre_4_16},
soft_purge, soft_purge, [snmpa_agent, snmp_log]},
- {update, snmpa_agent, soft, soft_purge, soft_purge, []},
+ {update, snmpa_mib, soft, soft_purge, soft_purge, []},
+ {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]},
{load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]},
{load_module, snmp_usm, soft_purge, soft_purge, []},
@@ -82,13 +93,14 @@
[
{load_module, snmp_pdus, soft_purge, soft_purge, []},
{load_module, snmpa_mib_data, soft_purge, soft_purge, []},
- {load_module, snmpa, soft_purge, soft_purge, [snmp_log]},
+ {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]},
{load_module, snmp_config, soft_purge, soft_purge, []},
{load_module, snmp_log, soft_purge, soft_purge, []},
{load_module, snmpa_general_db, soft_purge, soft_purge, []},
{update, snmpa_net_if, {advanced, upgrade_from_pre_4_16},
soft_purge, soft_purge, [snmpa_agent, snmp_log]},
- {update, snmpa_agent, soft, soft_purge, soft_purge, []},
+ {update, snmpa_mib, soft, soft_purge, soft_purge, [snmpa_mib_data]},
+ {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]},
{load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]},
{load_module, snmp_usm, soft_purge, soft_purge, []},
@@ -109,49 +121,60 @@
[
{"4.16.1",
[
+ {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]},
{load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]},
{load_module, snmp_usm, soft_purge, soft_purge, []},
- {load_module, snmp_pdus, soft_purge, soft_purge, []}
+ {load_module, snmp_pdus, soft_purge, soft_purge, []},
+ {update, snmpm_server, soft, soft_purge, soft_purge, []},
+ {update, snmpa_mib, soft, soft_purge, soft_purge, []},
+ {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}
]
},
{"4.16",
[
+ {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]},
{load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]},
{load_module, snmp_usm, soft_purge, soft_purge, []},
{load_module, snmp_pdus, soft_purge, soft_purge, []},
{load_module, snmpa_general_db, soft_purge, soft_purge, []},
- {update, snmpm_net_if, soft, soft_purge, soft_purge, []}
+ {update, snmpm_net_if, soft, soft_purge, soft_purge, []},
+ {update, snmpm_server, soft, soft_purge, soft_purge, []},
+ {update, snmpa_mib, soft, soft_purge, soft_purge, []},
+ {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}
]
},
{"4.15",
[
{load_module, snmp_pdus, soft_purge, soft_purge, []},
- {load_module, snmpa, soft_purge, soft_purge, [snmp_log]},
+ {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]},
{load_module, snmp_config, soft_purge, soft_purge, []},
{load_module, snmp_log, soft_purge, soft_purge, []},
{load_module, snmpa_general_db, soft_purge, soft_purge, []},
- {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16},
+ {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16},
soft_purge, soft_purge, [snmpa_agent, snmp_log]},
- {update, snmpa_agent, soft, soft_purge, soft_purge, []},
+ {update, snmpa_mib, soft, soft_purge, soft_purge, []},
+ {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]},
{load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]},
{load_module, snmp_usm, soft_purge, soft_purge, []},
{load_module, snmpa_general_db, soft_purge, soft_purge, []},
- {update, snmpm_net_if, {advanced, downgrade_to_pre_4_16},
+ {update, snmpm_net_if, {advanced, downgrade_to_pre_4_16},
soft_purge, soft_purge, [snmpm_config, snmp_log]},
- {update, snmpm_config, soft, soft_purge, soft_purge, []}
+ {update, snmpm_config, soft, soft_purge, soft_purge, []},
+ {update, snmpm_server, soft, soft_purge, soft_purge, []}
]
},
{"4.14",
[
{load_module, snmp_pdus, soft_purge, soft_purge, []},
- {load_module, snmpa, soft_purge, soft_purge, [snmp_log]},
+ {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]},
{load_module, snmp_config, soft_purge, soft_purge, []},
{load_module, snmp_log, soft_purge, soft_purge, []},
{load_module, snmpa_general_db, soft_purge, soft_purge, []},
- {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16},
+ {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16},
soft_purge, soft_purge, [snmpa_agent, snmp_log]},
- {update, snmpa_agent, soft, soft_purge, soft_purge, []},
+ {update, snmpa_mib, soft, soft_purge, soft_purge, []},
+ {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]},
{load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]},
{load_module, snmp_usm, soft_purge, soft_purge, []},
@@ -169,12 +192,13 @@
{load_module, snmp_pdus, soft_purge, soft_purge, []},
{load_module, snmpa_mib_data, soft_purge, soft_purge, []},
{load_module, snmp_config, soft_purge, soft_purge, []},
- {load_module, snmpa, soft_purge, soft_purge, [snmp_log]},
+ {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]},
{load_module, snmp_log, soft_purge, soft_purge, []},
{load_module, snmpa_general_db, soft_purge, soft_purge, []},
{update, snmpa_net_if, {advanced, downgrade_to_pre_4_16},
soft_purge, soft_purge, [snmpa_agent, snmp_log]},
- {update, snmpa_agent, soft, soft_purge, soft_purge, []},
+ {update, snmpa_mib, soft, soft_purge, soft_purge, [snmpa_mib_data]},
+ {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]},
{load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]},
{load_module, snmp_usm, soft_purge, soft_purge, []},
diff --git a/lib/snmp/src/manager/snmpm_server.erl b/lib/snmp/src/manager/snmpm_server.erl
index 30aacc0ec3..d64b5b1d53 100644
--- a/lib/snmp/src/manager/snmpm_server.erl
+++ b/lib/snmp/src/manager/snmpm_server.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2004-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
@@ -2804,16 +2804,16 @@ agent_data(TargetName, CtxName) ->
agent_data(TargetName, CtxName, Config) ->
case snmpm_config:agent_info(TargetName, all) of
{ok, Info} ->
- {value, {_, Version}} = lists:keysearch(version, 1, Info),
+ Version = agent_data_item(version, Info),
MsgData =
case Version of
v3 ->
DefSecModel = agent_data_item(sec_model, Info),
DefSecName = agent_data_item(sec_name, Info),
DefSecLevel = agent_data_item(sec_level, Info),
-
+
EngineId = agent_data_item(engine_id, Info),
-
+
SecModel = agent_data_item(sec_model,
Config,
DefSecModel),
@@ -2829,7 +2829,7 @@ agent_data(TargetName, CtxName, Config) ->
_ ->
DefComm = agent_data_item(community, Info),
DefSecModel = agent_data_item(sec_model, Info),
-
+
Comm = agent_data_item(community,
Config,
DefComm),
@@ -2848,8 +2848,12 @@ agent_data(TargetName, CtxName, Config) ->
end.
agent_data_item(Item, Info) ->
- {value, {_, Val}} = lists:keysearch(Item, 1, Info),
- Val.
+ case lists:keysearch(Item, 1, Info) of
+ {value, {_, Val}} ->
+ Val;
+ false ->
+ throw({error, {not_found, Item, Info}})
+ end.
agent_data_item(Item, Info, Default) ->
case lists:keysearch(Item, 1, Info) of
diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk
index 2fccc733e6..c3704bf6c9 100644
--- a/lib/snmp/vsn.mk
+++ b/lib/snmp/vsn.mk
@@ -21,9 +21,11 @@ SNMP_VSN = 4.16.2
PRE_VSN =
APP_VSN = "snmp-$(SNMP_VSN)$(PRE_VSN)"
-TICKETS = OTP-8563 OTP-8574 OTP-8594 OTP-8595
+TICKETS = OTP-8563 OTP-8574 OTP-8594 OTP-8595 OTP-8646 OTP-8648
-TICKETS_4_16_1 = OTP-8480 OTP-8481
+TICKETS_4_16_1 = \
+ OTP-8480 \
+ OTP-8481
TICKETS_4_16 = \
OTP-8395 \
diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml
index 67a226f726..7c8735cf56 100644
--- a/lib/ssh/doc/src/notes.xml
+++ b/lib/ssh/doc/src/notes.xml
@@ -37,6 +37,18 @@
<p>The function ssh:connect/4 was not exported.</p>
<p>Own Id: OTP-8550 Aux Id:</p>
</item>
+ <item>
+ <p>Aligned error message with used version (SSH_FX_FAILURE vs
+ SSH_FX_NOT_A_DIRECTORY, the latter introduced in version 6).</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>Own Id: OTP-8644 Aux Id: seq11574</p>
+ </item>
+ <item>
+ <p>Resolved race condition when another connection is started
+ before a channel is opened in the first connection.</p>
+ <p>Own Id: OTP-8645 Aux Id: seq11577</p>
+ </item>
</list>
</section>
diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl
index 57229daa27..9060626ab3 100644
--- a/lib/ssh/src/ssh_acceptor.erl
+++ b/lib/ssh/src/ssh_acceptor.erl
@@ -79,11 +79,11 @@ acceptor_loop(Callback, Port, Address, Opts, ListenSocket, AcceptTimeout) ->
handle_connection(Callback, Address, Port, Options, Socket) ->
SystemSup = ssh_system_sup:system_supervisor(Address, Port),
- ssh_system_sup:start_subsystem(SystemSup, Options),
+ {ok, SubSysSup} = ssh_system_sup:start_subsystem(SystemSup, Options),
ConnectionSup = ssh_system_sup:connection_supervisor(SystemSup),
{ok, Pid} =
ssh_connection_controler:start_manager_child(ConnectionSup,
- [server, Socket, Options]),
+ [server, Socket, Options, SubSysSup]),
Callback:controlling_process(Socket, Pid),
SshOpts = proplists:get_value(ssh_opts, Options),
Pid ! {start_connection, server, [Address, Port, Socket, SshOpts]}.
diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl
index 57bb141c60..34d4ff8fc1 100755
--- a/lib/ssh/src/ssh_connect.hrl
+++ b/lib/ssh/src/ssh_connect.hrl
@@ -260,5 +260,6 @@
address,
port,
options,
- exec
+ exec,
+ sub_system_supervisor
}).
diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl
index b9827c90ea..7b9e9185bf 100644
--- a/lib/ssh/src/ssh_connection.erl
+++ b/lib/ssh/src/ssh_connection.erl
@@ -946,13 +946,12 @@ encode_ip(Addr) when is_list(Addr) ->
end
end.
-start_channel(Address, Port, Cb, Id, Args) ->
- start_channel(Address, Port, Cb, Id, Args, undefined).
+start_channel(Cb, Id, Args, SubSysSup) ->
+ start_channel(Cb, Id, Args, SubSysSup, undefined).
-start_channel(Address, Port, Cb, Id, Args, Exec) ->
+start_channel(Cb, Id, Args, SubSysSup, Exec) ->
ChildSpec = child_spec(Cb, Id, Args, Exec),
- SystemSup = ssh_system_sup:system_supervisor(Address, Port),
- ChannelSup = ssh_system_sup:channel_supervisor(SystemSup),
+ ChannelSup =ssh_subsystem_sup:channel_supervisor(SubSysSup),
ssh_channel_sup:start_child(ChannelSup, ChildSpec).
%%--------------------------------------------------------------------
@@ -1017,18 +1016,19 @@ start_cli(#connection{address = Address, port = Port, cli_spec = {Fun, [Shell]},
{ok, Pid}
end;
-start_cli(#connection{address = Address, port = Port,
- cli_spec = {CbModule, Args}, exec = Exec}, ChannelId) ->
- start_channel(Address, Port, CbModule, ChannelId, Args, Exec).
+start_cli(#connection{cli_spec = {CbModule, Args}, exec = Exec,
+ sub_system_supervisor = SubSysSup}, ChannelId) ->
+ start_channel(CbModule, ChannelId, Args, SubSysSup, Exec).
start_subsytem(BinName, #connection{address = Address, port = Port,
- options = Options},
+ options = Options,
+ sub_system_supervisor = SubSysSup},
#channel{local_id = ChannelId, remote_id = RemoteChannelId},
ReplyMsg) ->
Name = binary_to_list(BinName),
case check_subsystem(Name, Options) of
{Callback, Opts} when is_atom(Callback), Callback =/= none ->
- start_channel(Address, Port, Callback, ChannelId, Opts);
+ start_channel(Callback, ChannelId, Opts, SubSysSup);
{Other, _} when Other =/= none ->
handle_backwards_compatibility(Other, self(),
ChannelId, RemoteChannelId,
diff --git a/lib/ssh/src/ssh_connection_controler.erl b/lib/ssh/src/ssh_connection_controler.erl
index 990541f8d6..636ecba532 100644
--- a/lib/ssh/src/ssh_connection_controler.erl
+++ b/lib/ssh/src/ssh_connection_controler.erl
@@ -99,8 +99,8 @@ terminate(_Reason, #state{}) ->
handle_call({handler, Pid, [Role, Socket, Opts]}, _From, State) ->
{ok, Handler} = ssh_connection_handler:start_link(Role, Pid, Socket, Opts),
{reply, {ok, Handler}, State#state{handler = Handler}};
-handle_call({manager, [server = Role, Socket, Opts]}, _From, State) ->
- {ok, Manager} = ssh_connection_manager:start_link([Role, Socket, Opts]),
+handle_call({manager, [server = Role, Socket, Opts, SubSysSup]}, _From, State) ->
+ {ok, Manager} = ssh_connection_manager:start_link([Role, Socket, Opts, SubSysSup]),
{reply, {ok, Manager}, State#state{manager = Manager}};
handle_call({manager, [client = Role | Opts]}, _From, State) ->
{ok, Manager} = ssh_connection_manager:start_link([Role, Opts]),
diff --git a/lib/ssh/src/ssh_connection_manager.erl b/lib/ssh/src/ssh_connection_manager.erl
index a2effc177e..cffeade485 100644
--- a/lib/ssh/src/ssh_connection_manager.erl
+++ b/lib/ssh/src/ssh_connection_manager.erl
@@ -178,7 +178,7 @@ send_eof(ConnectionManager, ChannelId) ->
%% {stop, Reason}
%% Description: Initiates the server
%%--------------------------------------------------------------------
-init([server, _Socket, Opts]) ->
+init([server, _Socket, Opts, SubSysSup]) ->
process_flag(trap_exit, true),
ssh_bits:install_messages(ssh_connection:messages()),
Cache = ssh_channel:cache_create(),
@@ -187,7 +187,8 @@ init([server, _Socket, Opts]) ->
channel_id_seed = 0,
port_bindings = [],
requests = [],
- channel_pids = []},
+ channel_pids = [],
+ sub_system_supervisor = SubSysSup},
opts = Opts,
connected = false}};
@@ -400,7 +401,7 @@ handle_call({close, ChannelId}, _,
end;
handle_call(stop, _, #state{role = _client,
- client = ChannelPid,
+ client = _ChannelPid,
connection = Pid} = State) ->
DisconnectMsg =
#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION,
diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl
index dc789092dd..da91817fd7 100644
--- a/lib/ssh/src/ssh_sftpd.erl
+++ b/lib/ssh/src/ssh_sftpd.erl
@@ -242,7 +242,8 @@ handle_op(?SSH_FXP_REALPATH, ReqId,
end;
handle_op(?SSH_FXP_OPENDIR, ReqId,
<<?UINT32(RLen), RPath:RLen/binary>>,
- State0 = #state{file_handler = FileMod, file_state = FS0}) ->
+ State0 = #state{xf = #ssh_xfer{vsn = Vsn},
+ file_handler = FileMod, file_state = FS0}) ->
RelPath = binary_to_list(RPath),
AbsPath = relate_file_name(RelPath, State0),
@@ -250,10 +251,14 @@ handle_op(?SSH_FXP_OPENDIR, ReqId,
{IsDir, FS1} = FileMod:is_dir(AbsPath, FS0),
State1 = State0#state{file_state = FS1},
case IsDir of
- false ->
+ false when Vsn > 5 ->
ssh_xfer:xf_send_status(XF, ReqId, ?SSH_FX_NOT_A_DIRECTORY,
"Not a directory"),
State1;
+ false ->
+ ssh_xfer:xf_send_status(XF, ReqId, ?SSH_FX_FAILURE,
+ "Not a directory"),
+ State1;
true ->
add_handle(State1, XF, ReqId, directory, {RelPath,unread})
end;
diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk
index 38a82ff32d..ccdbfe4f9a 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -7,7 +7,9 @@ TICKETS = OTP-8524 \
OTP-8534 \
OTP-8535 \
OTP-8550 \
- OTP-8596
+ OTP-8596 \
+ OTP-8644 \
+ OTP-8645
TICKETS_1.1.8 = OTP-8356 \
OTP-8401
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 75faac9a95..2e853c7cc8 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -87,7 +87,6 @@
from, % term(), where to reply
bytes_to_read, % integer(), # bytes to read in passive mode
user_data_buffer, % binary()
-%% tls_buffer, % Keeps a lookahead one packet if available
log_alert, % boolean()
renegotiation, % {boolean(), From | internal | peer}
recv_during_renegotiation, %boolean()
@@ -108,7 +107,8 @@
%% Description: Sends data over the ssl connection
%%--------------------------------------------------------------------
send(Pid, Data) ->
- sync_send_all_state_event(Pid, {application_data, erlang:iolist_to_binary(Data)}, infinity).
+ sync_send_all_state_event(Pid, {application_data,
+ erlang:iolist_to_binary(Data)}, infinity).
%%--------------------------------------------------------------------
%% Function: recv(Socket, Length Timeout) -> {ok, Data} | {error, reason}
@@ -422,7 +422,7 @@ abbreviated(#hello_request{}, State0) ->
{Record, State} = next_record(State0),
next_state(hello, Record, State);
-abbreviated(Finished = #finished{verify_data = Data},
+abbreviated(#finished{verify_data = Data} = Finished,
#state{role = server,
negotiated_version = Version,
tls_handshake_hashes = Hashes,
@@ -440,7 +440,7 @@ abbreviated(Finished = #finished{verify_data = Data},
{stop, normal, State}
end;
-abbreviated(Finished = #finished{verify_data = Data},
+abbreviated(#finished{verify_data = Data} = Finished,
#state{role = client, tls_handshake_hashes = Hashes0,
session = #session{master_secret = MasterSecret},
negotiated_version = Version,
@@ -504,7 +504,7 @@ certify(#certificate{} = Cert,
certify(#server_key_exchange{} = KeyExchangeMsg,
#state{role = client, negotiated_version = Version,
key_algorithm = Alg} = State0)
- when Alg == dhe_dss; Alg == dhe_rsa ->%%Not imp:Alg == dh_anon;Alg == krb5 ->
+ when Alg == dhe_dss; Alg == dhe_rsa ->
case handle_server_key(KeyExchangeMsg, State0) of
#state{} = State1 ->
{Record, State} = next_record(State1),
@@ -515,12 +515,9 @@ certify(#server_key_exchange{} = KeyExchangeMsg,
{stop, normal, State0}
end;
-certify(#server_key_exchange{},
- State = #state{role = client, negotiated_version = Version,
- key_algorithm = rsa}) ->
- Alert = ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE),
- handle_own_alert(Alert, Version, certify_server_key_exchange, State),
- {stop, normal, State};
+certify(#server_key_exchange{} = Msg,
+ #state{role = client, key_algorithm = rsa} = State) ->
+ handle_unexpected_message(Msg, certify_server_keyexchange, State);
certify(#certificate_request{}, State0) ->
{Record, State} = next_record(State0#state{client_certificate_requested = true}),
@@ -564,17 +561,12 @@ certify(#server_hello_done{},
{stop, normal, State0}
end;
-certify(#client_key_exchange{},
- State = #state{role = server,
- client_certificate_requested = true,
- ssl_options = #ssl_options{fail_if_no_peer_cert = true},
- negotiated_version = Version}) ->
+certify(#client_key_exchange{} = Msg,
+ #state{role = server,
+ client_certificate_requested = true,
+ ssl_options = #ssl_options{fail_if_no_peer_cert = true}} = State) ->
%% We expect a certificate here
- Alert = ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE),
- handle_own_alert(Alert, Version,
- certify_server_waiting_certificate, State),
- {stop, normal, State};
-
+ handle_unexpected_message(Msg, certify_client_key_exchange, State);
certify(#client_key_exchange{exchange_keys
= #encrypted_premaster_secret{premaster_secret
@@ -814,10 +806,22 @@ handle_sync_event(start, From, StateName, State) ->
handle_sync_event(close, _, _StateName, State) ->
{stop, normal, ok, State};
-handle_sync_event({shutdown, How}, _, StateName,
- #state{transport_cb = CbModule,
+handle_sync_event({shutdown, How0}, _, StateName,
+ #state{transport_cb = Transport,
+ negotiated_version = Version,
+ connection_states = ConnectionStates,
socket = Socket} = State) ->
- case CbModule:shutdown(Socket, How) of
+ case How0 of
+ How when How == write; How == both ->
+ Alert = ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY),
+ {BinMsg, _} =
+ encode_alert(Alert, Version, ConnectionStates),
+ Transport:send(Socket, BinMsg);
+ _ ->
+ ok
+ end,
+
+ case Transport:shutdown(Socket, How0) of
ok ->
{reply, ok, StateName, State};
Error ->
@@ -1709,13 +1713,7 @@ header(N, Binary) ->
<<?BYTE(ByteN), NewBinary/binary>> = Binary,
[ByteN | header(N-1, NewBinary)].
-%% tcp_closed
-send_or_reply(false, _Pid, undefined, _Data) ->
- Report = io_lib:format("SSL(debug): Unexpected Data ~p ~n",[_Data]),
- error_logger:error_report(Report),
- erlang:error({badarg, _Pid, undefined, _Data}),
- ok;
-send_or_reply(false, _Pid, From, Data) ->
+send_or_reply(false, _Pid, From, Data) when From =/= undefined ->
gen_fsm:reply(From, Data);
send_or_reply(_, Pid, _From, Data) ->
send_user(Pid, Data).
@@ -1976,34 +1974,19 @@ handle_alerts(_, {stop, _, _} = Stop) ->
handle_alerts([Alert | Alerts], {next_state, StateName, State}) ->
handle_alerts(Alerts, handle_alert(Alert, StateName, State)).
-handle_alert(#alert{level = ?FATAL} = Alert, connection,
- #state{from = From, user_application = {_Mon, Pid},
- log_alert = Log,
- host = Host, port = Port, session = Session,
- role = Role, socket_options = Opts} = State) ->
- invalidate_session(Role, Host, Port, Session),
- log_alert(Log, connection, Alert),
- alert_user(Opts#socket_options.active, Pid, From, Alert, Role),
- {stop, normal, State};
-
-handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert,
- connection, #state{from = From,
- role = Role,
- user_application = {_Mon, Pid},
- socket_options = Opts} = State) ->
- alert_user(Opts#socket_options.active, Pid, From, Alert, Role),
- {stop, normal, State};
-
handle_alert(#alert{level = ?FATAL} = Alert, StateName,
#state{from = From, host = Host, port = Port, session = Session,
- log_alert = Log, role = Role} = State) ->
+ user_application = {_Mon, Pid},
+ log_alert = Log, role = Role, socket_options = Opts} = State) ->
invalidate_session(Role, Host, Port, Session),
log_alert(Log, StateName, Alert),
- alert_user(From, Alert, Role),
+ alert_user(StateName, Opts, Pid, From, Alert, Role),
{stop, normal, State};
+
handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert,
- _, #state{from = From, role = Role} = State) ->
- alert_user(From, Alert, Role),
+ StateName, #state{from = From, role = Role,
+ user_application = {_Mon, Pid}, socket_options = Opts} = State) ->
+ alert_user(StateName, Opts, Pid, From, Alert, Role),
{stop, normal, State};
handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName,
@@ -2026,6 +2009,11 @@ handle_alert(#alert{level = ?WARNING, description = ?USER_CANCELED} = Alert, Sta
{Record, State} = next_record(State0),
next_state(StateName, Record, State).
+alert_user(connection, Opts, Pid, From, Alert, Role) ->
+ alert_user(Opts#socket_options.active, Pid, From, Alert, Role);
+alert_user(_, _, _, From, Alert, Role) ->
+ alert_user(From, Alert, Role).
+
alert_user(From, Alert, Role) ->
alert_user(false, no_pid, From, Alert, Role).
@@ -2045,13 +2033,13 @@ alert_user(Active, Pid, From, Alert, Role) ->
{ssl_error, sslsocket(), ReasonCode})
end.
-log_alert(true, StateName, Alert) ->
+log_alert(true, Info, Alert) ->
Txt = ssl_alert:alert_txt(Alert),
- error_logger:format("SSL: ~p: ~s\n", [StateName, Txt]);
+ error_logger:format("SSL: ~p: ~s\n", [Info, Txt]);
log_alert(false, _, _) ->
ok.
-handle_own_alert(Alert, Version, StateName,
+handle_own_alert(Alert, Version, Info,
#state{transport_cb = Transport,
socket = Socket,
from = User,
@@ -2061,20 +2049,21 @@ handle_own_alert(Alert, Version, StateName,
try %% Try to tell the other side
{BinMsg, _} =
encode_alert(Alert, Version, ConnectionStates),
+ linux_workaround_transport_delivery_problems(Alert, Socket),
Transport:send(Socket, BinMsg)
catch _:_ -> %% Can crash if we are in a uninitialized state
ignore
end,
try %% Try to tell the local user
- log_alert(Log, StateName, Alert),
+ log_alert(Log, Info, Alert),
alert_user(User, Alert, Role)
catch _:_ ->
ok
end.
-handle_unexpected_message(_Msg, StateName, #state{negotiated_version = Version} = State) ->
+handle_unexpected_message(Msg, Info, #state{negotiated_version = Version} = State) ->
Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE),
- handle_own_alert(Alert, Version, StateName, State),
+ handle_own_alert(Alert, Version, {Info, Msg}, State),
{stop, normal, State}.
make_premaster_secret({MajVer, MinVer}, rsa) ->
@@ -2134,6 +2123,19 @@ notify_renegotiater(_) ->
ok.
workaround_transport_delivery_problems(Socket, Transport) ->
+ %% Standard trick to try to make sure all
+ %% data sent to to tcp port is really sent
+ %% before tcp port is closed.
inet:setopts(Socket, [{active, false}]),
Transport:shutdown(Socket, write),
Transport:recv(Socket, 0).
+
+linux_workaround_transport_delivery_problems(#alert{level = ?FATAL}, Socket) ->
+ case os:type() of
+ {unix, linux} ->
+ inet:setopts(Socket, [{nodelay, true}]);
+ _ ->
+ ok
+ end;
+linux_workaround_transport_delivery_problems(_, _) ->
+ ok.
diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl
index 7a0192a80f..19bdcfa1f5 100644
--- a/lib/ssl/src/ssl_manager.erl
+++ b/lib/ssl/src/ssl_manager.erl
@@ -140,19 +140,19 @@ invalidate_session(Port, Session) ->
%% {stop, Reason}
%% Description: Initiates the server
%%--------------------------------------------------------------------
-init(Opts) ->
+init([Opts]) ->
process_flag(trap_exit, true),
- CacheCb = proplists:get_value(session_cache, Opts, ssl_session_cache),
+ CacheCb = proplists:get_value(session_cb, Opts, ssl_session_cache),
SessionLifeTime =
proplists:get_value(session_lifetime, Opts, ?'24H_in_sec'),
CertDb = ssl_certificate_db:create(),
- SessionCache = CacheCb:init(),
+ SessionCache = CacheCb:init(proplists:get_value(session_cb_init_args, Opts, [])),
Timer = erlang:send_after(SessionLifeTime * 1000,
self(), validate_sessions),
{ok, #state{certificate_db = CertDb,
session_cache = SessionCache,
session_cache_cb = CacheCb,
- session_lifetime = SessionLifeTime ,
+ session_lifetime = SessionLifeTime,
session_validation_timer = Timer}}.
%%--------------------------------------------------------------------
diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl
index c867848c31..43f18d95a0 100644
--- a/lib/ssl/src/ssl_record.erl
+++ b/lib/ssl/src/ssl_record.erl
@@ -411,16 +411,14 @@ protocol_version(tlsv1) ->
{3, 1};
protocol_version(sslv3) ->
{3, 0};
-protocol_version(sslv2) ->
+protocol_version(sslv2) -> %% Backwards compatibility
{2, 0};
protocol_version({3, 2}) ->
'tlsv1.1';
protocol_version({3, 1}) ->
tlsv1;
protocol_version({3, 0}) ->
- sslv3;
-protocol_version({2, 0}) ->
- sslv2.
+ sslv3.
%%--------------------------------------------------------------------
%% Function: protocol_version(Version1, Version2) -> #protocol_version{}
%% Version1 = Version2 = #protocol_version{}
@@ -468,7 +466,7 @@ highest_protocol_version(_, [Version | Rest]) ->
%%--------------------------------------------------------------------
supported_protocol_versions() ->
Fun = fun(Version) ->
- protocol_version(Version)
+ protocol_version(Version)
end,
case application:get_env(ssl, protocol_version) of
undefined ->
@@ -476,11 +474,18 @@ supported_protocol_versions() ->
{ok, []} ->
lists:map(Fun, ?DEFAULT_SUPPORTED_VERSIONS);
{ok, Vsns} when is_list(Vsns) ->
- lists:map(Fun, Vsns);
+ Versions = lists:filter(fun is_acceptable_version/1, lists:map(Fun, Vsns)),
+ supported_protocol_versions(Versions);
{ok, Vsn} ->
- [Fun(Vsn)]
+ Versions = lists:filter(fun is_acceptable_version/1, [Fun(Vsn)]),
+ supported_protocol_versions(Versions)
end.
+supported_protocol_versions([]) ->
+ ?DEFAULT_SUPPORTED_VERSIONS;
+supported_protocol_versions([_|_] = Vsns) ->
+ Vsns.
+
%%--------------------------------------------------------------------
%% Function: is_acceptable_version(Version) -> true | false
%% Version = #protocol_version{}
@@ -688,7 +693,7 @@ hash_and_bump_seqno(#connection_state{sequence_number = SeqNo,
check_hash(_, _) ->
ok. %% TODO check this
-mac_hash(?NULL, {_,_}, _MacSecret, _SeqNo, _Type,
+mac_hash({_,_}, ?NULL, _MacSecret, _SeqNo, _Type,
_Length, _Fragment) ->
<<>>;
mac_hash({3, 0}, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) ->
diff --git a/lib/ssl/src/ssl_session_cache.erl b/lib/ssl/src/ssl_session_cache.erl
index 4a60892235..1f2d1fc7d3 100644
--- a/lib/ssl/src/ssl_session_cache.erl
+++ b/lib/ssl/src/ssl_session_cache.erl
@@ -1,19 +1,19 @@
%%
%% %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
%% 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%
%%
@@ -22,8 +22,8 @@
-behaviour(ssl_session_cache_api).
--export([init/0, terminate/1, lookup/2, update/3, delete/2, foldl/3,
- select_session/2]).
+-export([init/1, terminate/1, lookup/2, update/3, delete/2, foldl/3,
+ select_session/2]).
%%--------------------------------------------------------------------
%% Function: init() -> Cache
@@ -32,7 +32,7 @@
%%
%% Description: Return table reference. Called by ssl_manager process.
%%--------------------------------------------------------------------
-init() ->
+init(_) ->
ets:new(cache_name(), [set, protected]).
%%--------------------------------------------------------------------
diff --git a/lib/ssl/src/ssl_session_cache_api.erl b/lib/ssl/src/ssl_session_cache_api.erl
index d2e846e9fd..f8416bf327 100644
--- a/lib/ssl/src/ssl_session_cache_api.erl
+++ b/lib/ssl/src/ssl_session_cache_api.erl
@@ -1,19 +1,19 @@
%%
%% %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
%% 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%
%%
@@ -25,7 +25,7 @@
behaviour_info(callbacks) ->
[
- {init, 0},
+ {init, 1},
{terminate, 1},
{lookup, 2},
{update, 3},
diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl
index bd5a02417a..b7cb5c3ab3 100644
--- a/lib/ssl/src/ssl_sup.erl
+++ b/lib/ssl/src/ssl_sup.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1998-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% 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%
%%
@@ -40,8 +40,7 @@ start_link() ->
%%%=========================================================================
%% init([]) -> {ok, {SupFlags, [ChildSpec]}}
%%
-init([]) ->
-
+init([]) ->
%% OLD ssl - moved start to ssl.erl only if old
%% ssl is acctualy run!
%%Child1 = {ssl_server, {ssl_server, start_link, []},
@@ -67,7 +66,7 @@ init([]) ->
session_and_cert_manager_child_spec() ->
Opts = manager_opts(),
Name = ssl_manager,
- StartFunc = {ssl_manager, start_link, Opts},
+ StartFunc = {ssl_manager, start_link, [Opts]},
Restart = permanent,
Shutdown = 4000,
Modules = [ssl_manager],
@@ -86,11 +85,12 @@ connection_manager_child_spec() ->
manager_opts() ->
CbOpts = case application:get_env(ssl, session_cb) of
- {ok, Cb} when is_atom(Cb) ->
- [{session_cb, Cb}];
- _ ->
- []
- end,
+ {ok, Cb} when is_atom(Cb) ->
+ InitArgs = session_cb_init_args(),
+ [{session_cb, Cb}, {session_cb_init_args, InitArgs}];
+ _ ->
+ []
+ end,
case application:get_env(ssl, session_lifetime) of
{ok, Time} when is_integer(Time) ->
[{session_lifetime, Time}| CbOpts];
@@ -98,3 +98,10 @@ manager_opts() ->
CbOpts
end.
+session_cb_init_args() ->
+ case application:get_env(ssl, session_cb_init_args) of
+ {ok, Args} when is_list(Args) ->
+ Args;
+ _ ->
+ []
+ end.
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 4cea55cca0..dc110e2940 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -34,11 +34,10 @@
-define(EXPIRE, 10).
-define(SLEEP, 500).
-
-behaviour(ssl_session_cache_api).
%% For the session cache tests
--export([init/0, terminate/1, lookup/2, update/3,
+-export([init/1, terminate/1, lookup/2, update/3,
delete/2, foldl/3, select_session/2]).
%% Test server callback functions
@@ -84,11 +83,11 @@ end_per_suite(_Config) ->
%% Description: Initialization before each test case
%%--------------------------------------------------------------------
init_per_testcase(session_cache_process_list, Config) ->
- init_customized_session_cache(Config);
+ init_customized_session_cache(list, Config);
init_per_testcase(session_cache_process_mnesia, Config) ->
mnesia:start(),
- init_customized_session_cache(Config);
+ init_customized_session_cache(mnesia, Config);
init_per_testcase(reuse_session_expired, Config0) ->
Config = lists:keydelete(watchdog, 1, Config0),
@@ -114,17 +113,34 @@ init_per_testcase(TestCase, Config) when TestCase == ciphers_ssl3;
ssl:start(),
Config;
+init_per_testcase(protocol_versions, Config) ->
+ ssl:stop(),
+ application:load(ssl),
+ %% For backwards compatibility sslv2 should be filtered out.
+ application:set_env(ssl, protocol_version, [sslv2, sslv3, tlsv1]),
+ ssl:start(),
+ Config;
+
+init_per_testcase(empty_protocol_versions, Config) ->
+ ssl:stop(),
+ application:load(ssl),
+ %% For backwards compatibility sslv2 should be filtered out.
+ application:set_env(ssl, protocol_version, []),
+ ssl:start(),
+ Config;
+
init_per_testcase(_TestCase, Config0) ->
Config = lists:keydelete(watchdog, 1, Config0),
Dog = test_server:timetrap(?TIMEOUT),
- [{watchdog, Dog} | Config].
+ [{watchdog, Dog} | Config].
-init_customized_session_cache(Config0) ->
+init_customized_session_cache(Type, Config0) ->
Config = lists:keydelete(watchdog, 1, Config0),
Dog = test_server:timetrap(?TIMEOUT),
ssl:stop(),
application:load(ssl),
application:set_env(ssl, session_cb, ?MODULE),
+ application:set_env(ssl, session_cb_init_args, [Type]),
ssl:start(),
[{watchdog, Dog} | Config].
@@ -141,13 +157,18 @@ end_per_testcase(session_cache_process_list, Config) ->
end_per_testcase(default_action, Config);
end_per_testcase(session_cache_process_mnesia, Config) ->
application:unset_env(ssl, session_cb),
+ application:unset_env(ssl, session_cb_init_args),
mnesia:stop(),
+ ssl:stop(),
+ ssl:start(),
end_per_testcase(default_action, Config);
end_per_testcase(reuse_session_expired, Config) ->
application:unset_env(ssl, session_lifetime),
end_per_testcase(default_action, Config);
end_per_testcase(TestCase, Config) when TestCase == ciphers_ssl3;
- TestCase == ciphers_ssl3_openssl_names ->
+ TestCase == ciphers_ssl3_openssl_names;
+ TestCase == protocol_versions;
+ TestCase == empty_protocol_versions->
application:unset_env(ssl, protocol_version),
end_per_testcase(default_action, Config);
end_per_testcase(_TestCase, Config) ->
@@ -171,32 +192,31 @@ all(doc) ->
["Test the basic ssl functionality"];
all(suite) ->
- [app, alerts, connection_info, controlling_process, controller_dies,
- client_closes_socket,
- peercert, connect_dist,
- peername, sockname, socket_options, misc_ssl_options, versions, cipher_suites,
- upgrade, upgrade_with_timeout, tcp_connect,
- ipv6, ekeyfile, ecertfile, ecacertfile, eoptions, shutdown,
- shutdown_write, shutdown_both, shutdown_error, ciphers, ciphers_ssl3,
- ciphers_openssl_names, ciphers_ssl3_openssl_names,
- send_close, close_transport_accept, dh_params,
- server_verify_peer_passive,
- server_verify_peer_active, server_verify_peer_active_once,
- server_verify_none_passive, server_verify_none_active,
- server_verify_none_active_once, server_verify_no_cacerts,
- server_require_peer_cert_ok, server_require_peer_cert_fail,
- server_verify_client_once_passive,
- server_verify_client_once_active,
- server_verify_client_once_active_once,
- client_verify_none_passive,
- client_verify_none_active, client_verify_none_active_once,
- %session_cache_process_list, session_cache_process_mnesia,
- reuse_session, reuse_session_expired, server_does_not_want_to_reuse_session,
- client_renegotiate, 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,
- invalid_signature_client, invalid_signature_server
+ [app, alerts, connection_info, protocol_versions,
+ empty_protocol_versions, controlling_process, controller_dies,
+ client_closes_socket, peercert, connect_dist, peername, sockname,
+ socket_options, misc_ssl_options, versions, cipher_suites,
+ upgrade, upgrade_with_timeout, tcp_connect, ipv6, ekeyfile,
+ ecertfile, ecacertfile, eoptions, shutdown, shutdown_write,
+ shutdown_both, shutdown_error, ciphers, ciphers_ssl3,
+ ciphers_openssl_names, ciphers_ssl3_openssl_names, send_close,
+ close_transport_accept, dh_params, server_verify_peer_passive,
+ server_verify_peer_active, server_verify_peer_active_once,
+ server_verify_none_passive, server_verify_none_active,
+ server_verify_none_active_once, server_verify_no_cacerts,
+ server_require_peer_cert_ok, server_require_peer_cert_fail,
+ server_verify_client_once_passive,
+ server_verify_client_once_active,
+ server_verify_client_once_active_once, client_verify_none_passive,
+ client_verify_none_active, client_verify_none_active_once,
+ session_cache_process_list, session_cache_process_mnesia,
+ reuse_session, reuse_session_expired,
+ server_does_not_want_to_reuse_session, client_renegotiate,
+ 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,
+ invalid_signature_client, invalid_signature_server, cert_expired
].
%% Test cases starts here.
@@ -272,6 +292,49 @@ connection_info_result(Socket) ->
%%--------------------------------------------------------------------
+protocol_versions(doc) ->
+ ["Test to set a list of protocol versions in app environment."];
+
+protocol_versions(suite) ->
+ [];
+
+protocol_versions(Config) when is_list(Config) ->
+ basic_test(Config).
+
+empty_protocol_versions(doc) ->
+ ["Test to set an empty list of protocol versions in app environment."];
+
+empty_protocol_versions(suite) ->
+ [];
+
+empty_protocol_versions(Config) when is_list(Config) ->
+ basic_test(Config).
+
+
+basic_test(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),
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, send_recv_result_active, []}},
+ {options, ClientOpts}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok),
+
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
+
+%%--------------------------------------------------------------------
+
controlling_process(doc) ->
["Test API function controlling_process/2"];
@@ -684,7 +747,7 @@ socket_options(Config) when is_list(Config) ->
{options, ClientOpts}]),
ssl_test_lib:check_result(Server, ok, Client, ok),
-
+
ssl_test_lib:close(Server),
ssl_test_lib:close(Client),
@@ -692,6 +755,7 @@ socket_options(Config) when is_list(Config) ->
{ok,[{mode,list}]} = ssl:getopts(Listen, [mode]),
ok = ssl:setopts(Listen, [{mode, binary}]),
{ok,[{mode, binary}]} = ssl:getopts(Listen, [mode]),
+ {ok,[{recbuf, _}]} = ssl:getopts(Listen, [recbuf]),
ssl:close(Listen).
socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) ->
@@ -701,6 +765,8 @@ socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) ->
{ok, NewValues} = ssl:getopts(Socket, NewOptions),
%% Test get/set inet opts
{ok,[{nodelay,false}]} = ssl:getopts(Socket, [nodelay]),
+ ssl:setopts(Socket, [{nodelay, true}]),
+ {ok,[{nodelay, true}]} = ssl:getopts(Socket, [nodelay]),
ok.
%%--------------------------------------------------------------------
@@ -2418,7 +2484,7 @@ extended_key_usage(Config) when is_list(Config) ->
[ServerExtKeyUsageExt |
ServerExtensions]},
NewServerDerCert = public_key:sign(NewServerOTPTbsCert, Key),
- public_key:der_to_pem(NewServerCertFile, [{cert, NewServerDerCert}]),
+ public_key:der_to_pem(NewServerCertFile, [{cert, NewServerDerCert, not_encrypted}]),
NewServerOpts = [{certfile, NewServerCertFile} | proplists:delete(certfile, ServerOpts)],
ClientCertFile = proplists:get_value(certfile, ClientOpts),
@@ -2432,7 +2498,7 @@ extended_key_usage(Config) when is_list(Config) ->
[ClientExtKeyUsageExt |
ClientExtensions]},
NewClientDerCert = public_key:sign(NewClientOTPTbsCert, Key),
- public_key:der_to_pem(NewClientCertFile, [{cert, NewClientDerCert}]),
+ public_key:der_to_pem(NewClientCertFile, [{cert, NewClientDerCert, not_encrypted}]),
NewClientOpts = [{certfile, NewClientCertFile} | proplists:delete(certfile, ClientOpts)],
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
@@ -2515,7 +2581,7 @@ no_authority_key_identifier(Config) when is_list(Config) ->
test_server:format("Extensions ~p~n, NewExtensions: ~p~n", [Extensions, NewExtensions]),
NewDerCert = public_key:sign(NewOTPTbsCert, Key),
- public_key:der_to_pem(NewCertFile, [{cert, NewDerCert}]),
+ public_key:der_to_pem(NewCertFile, [{cert, NewDerCert, not_encrypted}]),
NewServerOpts = [{certfile, NewCertFile} | proplists:delete(certfile, ServerOpts)],
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
@@ -2567,7 +2633,7 @@ invalid_signature_server(Config) when is_list(Config) ->
{ok, ServerOTPCert} = public_key:pkix_decode_cert(ServerDerCert, otp),
ServerOTPTbsCert = ServerOTPCert#'OTPCertificate'.tbsCertificate,
NewServerDerCert = public_key:sign(ServerOTPTbsCert, Key),
- public_key:der_to_pem(NewServerCertFile, [{cert, NewServerDerCert}]),
+ public_key:der_to_pem(NewServerCertFile, [{cert, NewServerDerCert, not_encrypted}]),
NewServerOpts = [{certfile, NewServerCertFile} | proplists:delete(certfile, ServerOpts)],
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
@@ -2610,7 +2676,7 @@ invalid_signature_client(Config) when is_list(Config) ->
{ok, ClientOTPCert} = public_key:pkix_decode_cert(ClientDerCert, otp),
ClientOTPTbsCert = ClientOTPCert#'OTPCertificate'.tbsCertificate,
NewClientDerCert = public_key:sign(ClientOTPTbsCert, Key),
- public_key:der_to_pem(NewClientCertFile, [{cert, NewClientDerCert}]),
+ public_key:der_to_pem(NewClientCertFile, [{cert, NewClientDerCert, not_encrypted}]),
NewClientOpts = [{certfile, NewClientCertFile} | proplists:delete(certfile, ClientOpts)],
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
@@ -2631,6 +2697,75 @@ invalid_signature_client(Config) when is_list(Config) ->
ssl_test_lib:close(Client).
%%--------------------------------------------------------------------
+cert_expired(doc) ->
+ ["Test server with invalid signature"];
+
+cert_expired(suite) ->
+ [];
+
+cert_expired(Config) when is_list(Config) ->
+ ClientOpts = ?config(client_opts, Config),
+ ServerOpts = ?config(server_verification_opts, Config),
+ PrivDir = ?config(priv_dir, Config),
+
+ KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"),
+ {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile),
+ {ok, Key} = public_key:decode_private_key(KeyInfo),
+
+ ServerCertFile = proplists:get_value(certfile, ServerOpts),
+ NewServerCertFile = filename:join(PrivDir, "server/expired_cert.pem"),
+ {ok, [{cert, DerCert, _}]} = public_key:pem_to_der(ServerCertFile),
+ {ok, OTPCert} = public_key:pkix_decode_cert(DerCert, otp),
+ OTPTbsCert = OTPCert#'OTPCertificate'.tbsCertificate,
+
+ {Year, Month, Day} = date(),
+ {Hours, Min, Sec} = time(),
+ NotBeforeStr = lists:flatten(io_lib:format("~p~s~s~s~s~sZ",[Year-2,
+ two_digits_str(Month),
+ two_digits_str(Day),
+ two_digits_str(Hours),
+ two_digits_str(Min),
+ two_digits_str(Sec)])),
+ NotAfterStr = lists:flatten(io_lib:format("~p~s~s~s~s~sZ",[Year-1,
+ two_digits_str(Month),
+ two_digits_str(Day),
+ two_digits_str(Hours),
+ two_digits_str(Min),
+ two_digits_str(Sec)])),
+ NewValidity = {'Validity', {generalTime, NotBeforeStr}, {generalTime, NotAfterStr}},
+
+ test_server:format("Validity: ~p ~n NewValidity: ~p ~n",
+ [OTPTbsCert#'OTPTBSCertificate'.validity, NewValidity]),
+
+ NewOTPTbsCert = OTPTbsCert#'OTPTBSCertificate'{validity = NewValidity},
+ NewServerDerCert = public_key:sign(NewOTPTbsCert, Key),
+ public_key:der_to_pem(NewServerCertFile, [{cert, NewServerDerCert, not_encrypted}]),
+ NewServerOpts = [{certfile, NewServerCertFile} | proplists:delete(certfile, ServerOpts)],
+
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {options, NewServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {options, [{verify, verify_peer} | ClientOpts]}]),
+
+ ssl_test_lib:check_result(Server, {error, "certificate expired"},
+ Client, {error, "certificate expired"}),
+
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
+
+
+two_digits_str(N) when N < 10 ->
+ lists:flatten(io_lib:format("0~p", [N]));
+two_digits_str(N) ->
+ lists:flatten(io_lib:format("~p", [N])).
+
+%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
send_recv_result(Socket) ->
@@ -2689,128 +2824,34 @@ session_cache_process_mnesia(Config) when is_list(Config) ->
session_cache_process(mnesia,Config).
session_cache_process(Type,Config) when is_list(Config) ->
- process_flag(trap_exit, true),
- setup_session_cb(Type),
-
- ClientOpts = ?config(client_opts, Config),
- ServerOpts = ?config(server_opts, Config),
- {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ reuse_session(Config).
- Server =
- ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {?MODULE, session_info_result, []}},
- {options,
- [{session_cache_cb, ?MODULE}|
- ServerOpts]}]),
- Port = ssl_test_lib:inet_port(Server),
- Client0 =
- ssl_test_lib:start_client([{node, ClientNode},
- {port, Port}, {host, Hostname},
- {mfa, {ssl_test_lib, no_result, []}},
- {from, self()}, {options, ClientOpts}]),
- SessionInfo =
- receive
- {Server, Info} ->
- Info
- end,
-
- Server ! listen,
-
- %% Make sure session is registered
- test_server:sleep(?SLEEP),
-
- Client1 =
- ssl_test_lib:start_client([{node, ClientNode},
- {port, Port}, {host, Hostname},
- {mfa, {?MODULE, session_info_result, []}},
- {from, self()}, {options, ClientOpts}]),
- receive
- {Client1, SessionInfo} ->
- ok;
- {Client1, Other} ->
- test_server:format("Expected: ~p, Unexpected: ~p~n",
- [SessionInfo, Other]),
- test_server:fail(session_not_reused)
- end,
-
- ssl_test_lib:close(Server),
- ssl_test_lib:close(Client0),
- ssl_test_lib:close(Client1),
-
- Server1 =
- ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {?MODULE, session_info_result, []}},
- {options,
- [{reuse_sessions, false} | ServerOpts]}]),
- Port1 = ssl_test_lib:inet_port(Server1),
-
- Client3 =
- ssl_test_lib:start_client([{node, ClientNode},
- {port, Port1}, {host, Hostname},
- {mfa, {?MODULE, session_info_result, []}},
- {from, self()}, {options, ClientOpts}]),
-
- SessionInfo1 =
- receive
- {Server1, Info1} ->
- Info1
- end,
-
- Server1 ! listen,
-
- %% Make sure session is registered
- test_server:sleep(?SLEEP),
-
- Client4 =
- ssl_test_lib:start_client([{node, ClientNode},
- {port, Port1}, {host, Hostname},
- {mfa, {?MODULE, session_info_result, []}},
- {from, self()}, {options, ClientOpts}]),
-
- receive
- {Client4, SessionInfo1} ->
- test_server:fail(
- session_reused_when_session_reuse_disabled_by_server);
- {Client4, _Other} ->
- ok
- end,
-
- ssl_test_lib:close(Server1),
- ssl_test_lib:close(Client3),
- ssl_test_lib:close(Client4),
- process_flag(trap_exit, false).
-
-setup_session_cb(Type) ->
- ssl_test = ets:new(ssl_test,[named_table, set,public]),
- ets:insert(ssl_test, {type,Type}).
-
-session_cb() ->
- [{type,Type}] = ets:lookup(ssl_test, type),
- Type.
-
-init() ->
- io:format("~p~n",[?LINE]),
- case session_cb() of
+init([Type]) ->
+ ets:new(ssl_test, [named_table, public, set]),
+ ets:insert(ssl_test, {type, Type}),
+ case Type of
list ->
spawn(fun() -> session_loop([]) end);
mnesia ->
mnesia:start(),
- {atomic,ok} = mnesia:create_table(sess_cache, [])
+ {atomic,ok} = mnesia:create_table(sess_cache, []),
+ sess_cache
end.
+session_cb() ->
+ [{type, Type}] = ets:lookup(ssl_test, type),
+ Type.
+
terminate(Cache) ->
- io:format("~p~n",[?LINE]),
case session_cb() of
list ->
Cache ! terminate;
mnesia ->
- {atomic,ok} = mnesia:delete_table(sess_cache, [])
+ catch {atomic,ok} =
+ mnesia:delete_table(sess_cache)
end.
-lookup(Cache, Key) ->
- io:format("~p~n",[?LINE]),
+lookup(Cache, Key) ->
case session_cb() of
list ->
Cache ! {self(), lookup, Key},
@@ -2820,13 +2861,14 @@ lookup(Cache, Key) ->
mnesia:read(sess_cache,
Key, read)
end) of
- {atomic, [Session]} -> Session;
- _ -> undefined
+ {atomic, [{sess_cache, Key, Value}]} ->
+ Value;
+ _ ->
+ undefined
end
- end.
+ end.
update(Cache, Key, Value) ->
- io:format("~p~n",[?LINE]),
case session_cb() of
list ->
Cache ! {update, Key, Value};
@@ -2834,12 +2876,11 @@ update(Cache, Key, Value) ->
{atomic, ok} =
mnesia:transaction(fun() ->
mnesia:write(sess_cache,
- Key, Value)
+ {sess_cache, Key, Value}, write)
end)
end.
delete(Cache, Key) ->
- io:format("~p~n",[?LINE]),
case session_cb() of
list ->
Cache ! {delete, Key};
@@ -2851,7 +2892,6 @@ delete(Cache, Key) ->
end.
foldl(Fun, Acc, Cache) ->
- io:format("~p~n",[?LINE]),
case session_cb() of
list ->
Cache ! {self(),foldl,Fun,Acc},
@@ -2865,15 +2905,17 @@ foldl(Fun, Acc, Cache) ->
end.
select_session(Cache, PartialKey) ->
- io:format("~p~n",[?LINE]),
case session_cb() of
list ->
Cache ! {self(),select_session, PartialKey},
- receive {Cache, Res} -> Res end;
+ receive
+ {Cache, Res} ->
+ Res
+ end;
mnesia ->
Sel = fun() ->
mnesia:select(Cache,
- [{{{PartialKey,'$1'}, '$2'},
+ [{{sess_cache,{PartialKey,'$1'}, '$2'},
[],['$$']}])
end,
{atomic, Res} = mnesia:transaction(Sel),
@@ -2893,7 +2935,8 @@ session_loop(Sess) ->
end,
session_loop(Sess);
{update, Key, Value} ->
- session_loop([{Key,Value}|Sess]);
+ NewSess = [{Key,Value}| lists:keydelete(Key,1,Sess)],
+ session_loop(NewSess);
{delete, Key} ->
session_loop(lists:keydelete(Key,1,Sess));
{Pid,foldl,Fun,Acc} ->
@@ -2901,15 +2944,17 @@ session_loop(Sess) ->
Pid ! {self(), Res},
session_loop(Sess);
{Pid,select_session,PKey} ->
- Sel = fun({{Head, _},Session}, Acc) when Head =:= PKey ->
- [Session|Acc];
+ Sel = fun({{PKey0, Id},Session}, Acc) when PKey == PKey0 ->
+ [[Id, Session]|Acc];
(_,Acc) ->
Acc
- end,
- Pid ! {self(), lists:foldl(Sel, [], Sess)},
+ end,
+ Sessions = lists:foldl(Sel, [], Sess),
+ Pid ! {self(), Sessions},
session_loop(Sess)
end.
+
erlang_ssl_receive(Socket, Data) ->
receive
{ssl, Socket, Data} ->
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index 03466aec6f..1c18f10038 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -33,6 +33,7 @@
-define(OPENSSL_RENEGOTIATE, "r\n").
-define(OPENSSL_QUIT, "Q\n").
-define(OPENSSL_GARBAGE, "P\n").
+-define(EXPIRE, 10).
%% Test server callback functions
%%--------------------------------------------------------------------
@@ -81,6 +82,15 @@ end_per_suite(_Config) ->
%% variable, but should NOT alter/remove any existing entries.
%% Description: Initialization before each test case
%%--------------------------------------------------------------------
+init_per_testcase(expired_session, Config0) ->
+ Config = lists:keydelete(watchdog, 1, Config0),
+ Dog = ssl_test_lib:timetrap(?EXPIRE * 1000 * 5),
+ ssl:stop(),
+ application:load(ssl),
+ application:set_env(ssl, session_lifetime, ?EXPIRE),
+ ssl:start(),
+ [{watchdog, Dog} | Config];
+
init_per_testcase(TestCase, Config0) ->
Config = lists:keydelete(watchdog, 1, Config0),
Dog = ssl_test_lib:timetrap(?TIMEOUT),
@@ -103,14 +113,20 @@ special_init(_, Config) ->
%% A list of key/value pairs, holding the test case configuration.
%% Description: Cleanup after each test case
%%--------------------------------------------------------------------
-end_per_testcase(_TestCase, Config) ->
+end_per_testcase(reuse_session_expired, Config) ->
+ application:unset_env(ssl, session_lifetime),
+ end_per_testcase(default_action, Config);
+
+end_per_testcase(default_action, Config) ->
Dog = ?config(watchdog, Config),
case Dog of
undefined ->
ok;
_ ->
test_server:timetrap_cancel(Dog)
- end.
+ end;
+end_per_testcase(_, Config) ->
+ end_per_testcase(default_action, Config).
%%--------------------------------------------------------------------
%% Function: all(Clause) -> TestCases
@@ -142,7 +158,9 @@ all(suite) ->
tls1_erlang_server_openssl_client_client_cert,
tls1_erlang_server_erlang_client_client_cert,
ciphers,
- erlang_client_bad_openssl_server
+ erlang_client_bad_openssl_server,
+ expired_session,
+ ssl2_erlang_server_openssl_client
].
%% Test cases starts here.
@@ -991,6 +1009,100 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) ->
close_port(OpensslPort),
process_flag(trap_exit, false),
ok.
+
+%%--------------------------------------------------------------------
+
+expired_session(doc) ->
+ ["Test our ssl client handling of expired sessions. Will make"
+ "better code coverage of the ssl_manager module"];
+
+expired_session(suite) ->
+ [];
+
+expired_session(Config) when is_list(Config) ->
+ process_flag(trap_exit, true),
+ ClientOpts = ?config(client_opts, Config),
+ ServerOpts = ?config(server_opts, Config),
+ {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
+
+ Port = ssl_test_lib:inet_port(node()),
+ CertFile = proplists:get_value(certfile, ServerOpts),
+ KeyFile = proplists:get_value(keyfile, ServerOpts),
+
+ Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++
+ " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "",
+
+ test_server:format("openssl cmd: ~p~n", [Cmd]),
+
+ OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]),
+
+ wait_for_openssl_server(),
+
+ Client0 =
+ ssl_test_lib:start_client([{node, ClientNode},
+ {port, Port}, {host, Hostname},
+ {mfa, {ssl_test_lib, no_result, []}},
+ {from, self()}, {options, ClientOpts}]),
+
+ ssl_test_lib:close(Client0),
+
+ %% Make sure session is registered
+ test_server:sleep(?SLEEP),
+
+ Client1 =
+ ssl_test_lib:start_client([{node, ClientNode},
+ {port, Port}, {host, Hostname},
+ {mfa, {ssl_test_lib, no_result, []}},
+ {from, self()}, {options, ClientOpts}]),
+
+ ssl_test_lib:close(Client1),
+ %% Make sure session is unregistered due to expiration
+ test_server:sleep((?EXPIRE+1) * 1000),
+
+ Client2 =
+ ssl_test_lib:start_client([{node, ClientNode},
+ {port, Port}, {host, Hostname},
+ {mfa, {ssl_test_lib, no_result, []}},
+ {from, self()}, {options, ClientOpts}]),
+
+ close_port(OpensslPort),
+ ssl_test_lib:close(Client2),
+ process_flag(trap_exit, false).
+
+%%--------------------------------------------------------------------
+ssl2_erlang_server_openssl_client(doc) ->
+ ["Test that ssl v2 clients are rejected"];
+ssl2_erlang_server_openssl_client(suite) ->
+ [];
+ssl2_erlang_server_openssl_client(Config) when is_list(Config) ->
+ process_flag(trap_exit, true),
+ ServerOpts = ?config(server_opts, Config),
+
+ {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+
+ Data = "From openssl to erlang",
+
+ Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++
+ " -host localhost -ssl2 -msg",
+
+ test_server:format("openssl cmd: ~p~n", [Cmd]),
+
+ OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]),
+ port_command(OpenSslPort, Data),
+
+ ssl_test_lib:check_result(Server, {error,"protocol version"}),
+
+ ssl_test_lib:close(Server),
+
+ close_port(OpenSslPort),
+ process_flag(trap_exit, false),
+ ok.
+
%%--------------------------------------------------------------------
erlang_ssl_receive(Socket, Data) ->
@@ -1030,8 +1142,7 @@ delayed_send(Socket, [ErlData, OpenSslData]) ->
erlang_ssl_receive(Socket, OpenSslData).
close_port(Port) ->
- port_command(Port, ?OPENSSL_QUIT),
- %%catch port_command(Port, "quit\n"),
+ catch port_command(Port, ?OPENSSL_QUIT),
close_loop(Port, 500, false).
close_loop(Port, Time, SentClose) ->
diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el
index b2598f93e6..970afe2e9f 100644
--- a/lib/tools/emacs/erlang-eunit.el
+++ b/lib/tools/emacs/erlang-eunit.el
@@ -102,6 +102,13 @@ buffer and vice versa"
(substring base-name (match-beginning 1) (match-end 1))
base-name)))
+;;; Return the module name of the file
+;;; /tmp/foo/src/x.erl --> x
+;;; /tmp/foo/test/x_tests.erl --> x_tests
+(defun erlang-eunit-module-name (file-path)
+ (interactive)
+ (file-name-sans-extension (file-name-nondirectory file-path)))
+
;;; Return the directory name which is common to both src and test
;;; /tmp/foo/src/x.erl --> /tmp/foo
;;; /tmp/foo/test/x_tests.erl --> /tmp/foo
@@ -128,25 +135,62 @@ buffer and vice versa"
(concat dir file)
(concat dir "/" file)))
-;;; Run EUnit tests for the current module
-(defun erlang-eunit-run-tests ()
- "Run the EUnit test suite for the current module.
+;;; Determine options for EUnit.
+(defun erlang-eunit-opts ()
+ (if current-prefix-arg ", [verbose]" ""))
-With prefix arg, runs tests with the verbose flag set."
- (interactive)
+;;; Determine current test function
+(defun erlang-eunit-test-name ()
+ (save-excursion
+ (erlang-end-of-function 1)
+ (erlang-beginning-of-function 1)
+ (erlang-name-of-function)))
+
+(defun erlang-eunit-simple-test-p (test-name)
+ (if (erlang-eunit-string-match-p "^\\(.+\\)_test$" test-name) t nil))
+
+(defun erlang-eunit-test-generator-p (test-name)
+ (if (erlang-eunit-string-match-p "^\\(.+\\)_test_$" test-name) t nil))
+
+;;; Run the current EUnit test
+(defun erlang-eunit-run-current-test ()
(let* ((module-name (erlang-add-quotes-if-needed
- (erlang-eunit-source-module-name buffer-file-name)))
- (opts (if current-prefix-arg ", [verbose]" ""))
- (command (format "eunit:test(%s%s)." module-name opts)))
+ (erlang-eunit-module-name buffer-file-name)))
+ (test-name (erlang-eunit-test-name))
+ (command
+ (cond ((erlang-eunit-simple-test-p test-name)
+ (format "eunit:test({%s, %s}%s)."
+ module-name test-name (erlang-eunit-opts)))
+ ((erlang-eunit-test-generator-p test-name)
+ (format "eunit:test({generator, %s, %s}%s)."
+ module-name test-name (erlang-eunit-opts)))
+ (t (format "%% WARNING: '%s' is not a test function" test-name)))))
(erlang-eunit-inferior-erlang-send-command command)))
-;;; Compile source and EUnit test file and finally run EUnit tests for
-;;; the current module
-(defun erlang-eunit-compile-and-run-tests ()
- "Compile the source and test files and run the EUnit test suite.
+;;; Run EUnit tests for the current module
+(defun erlang-eunit-run-module-tests ()
+ (let* ((module-name (erlang-add-quotes-if-needed
+ (erlang-eunit-source-module-name buffer-file-name)))
+ (command (format "eunit:test(%s%s)." module-name (erlang-eunit-opts))))
+ (erlang-eunit-inferior-erlang-send-command command)))
+
+(defun erlang-eunit-compile-and-run-current-test ()
+ "Compile the source and test files and run the current EUnit test.
With prefix arg, compiles for debug and runs tests with the verbose flag set."
(interactive)
+ (erlang-eunit-compile-and-test 'erlang-eunit-run-current-test))
+
+(defun erlang-eunit-compile-and-run-module-tests ()
+ "Compile the source and test files and run all EUnit tests in the module.
+
+With prefix arg, compiles for debug and runs tests with the verbose flag set."
+ (interactive)
+ (erlang-eunit-compile-and-test 'erlang-eunit-run-module-tests))
+
+;;; Compile source and EUnit test file and finally run EUnit tests for
+;;; the current module
+(defun erlang-eunit-compile-and-test (run-tests)
(let ((src-filename (erlang-eunit-src-filename buffer-file-name))
(test-filename (erlang-eunit-test-filename buffer-file-name)))
@@ -166,7 +210,7 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set."
(if (file-readable-p test-filename)
(erlang-eunit-compile-file test-filename)
t)
- (erlang-eunit-run-tests)))))
+ (funcall run-tests)))))
(defun erlang-eunit-compile-file (file-path)
(if (file-readable-p file-path)
@@ -224,22 +268,18 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set."
;;; Key bindings
;;;====================================================================
-(defvar erlang-eunit-toggle-src-and-test-file-other-window-key "\C-c\C-et"
- "*Key to which the `erlang-eunit-toggle-src-and-test-file-other-window'
-function will be bound.")
-(defvar erlang-eunit-compile-and-run-tests-key "\C-c\C-ek"
- "*Key to which the `erlang-eunit-compile-and-run-tests'
-function will be bound.")
+(defconst erlang-eunit-key-bindings
+ '(("\C-c\C-et" erlang-eunit-toggle-src-and-test-file-other-window)
+ ("\C-c\C-ek" erlang-eunit-compile-and-run-module-tests)
+ ("\C-c\C-ej" erlang-eunit-compile-and-run-current-test)))
(defun erlang-eunit-add-key-bindings ()
- (erlang-eunit-ensure-keymap-for-key
- erlang-eunit-toggle-src-and-test-file-other-window-key)
- (local-set-key erlang-eunit-toggle-src-and-test-file-other-window-key
- 'erlang-eunit-toggle-src-and-test-file-other-window)
- (erlang-eunit-ensure-keymap-for-key
- erlang-eunit-compile-and-run-tests-key)
- (local-set-key erlang-eunit-compile-and-run-tests-key
- 'erlang-eunit-compile-and-run-tests))
+ (dolist (binding erlang-eunit-key-bindings)
+ (erlang-eunit-bind-key (car binding) (cadr binding))))
+
+(defun erlang-eunit-bind-key (key function)
+ (erlang-eunit-ensure-keymap-for-key key)
+ (local-set-key key function))
(defun erlang-eunit-ensure-keymap-for-key (key-seq)
(let ((prefix-keys (butlast (append key-seq nil)))
diff --git a/lib/tools/emacs/erlang-start.el b/lib/tools/emacs/erlang-start.el
index 542e81f24c..bbcea3e46a 100644
--- a/lib/tools/emacs/erlang-start.el
+++ b/lib/tools/emacs/erlang-start.el
@@ -90,6 +90,11 @@
(or (assoc (car b) auto-mode-alist)
(setq auto-mode-alist (cons b auto-mode-alist))))
+;;
+;; Associate files using interpreter "escript" with Erlang mode.
+;;
+
+(add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode))
;;
;; Ignore files ending in ".jam", ".vee", and ".beam" when performing
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index 0132587d28..c31f76025e 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -885,15 +885,54 @@ files written in other languages than Erlang.")
If nil, the inferior shell replaces the window. This is the traditional
behaviour.")
-(defvar erlang-mode-map nil
+(defconst inferior-erlang-use-cmm (boundp 'minor-mode-overriding-map-alist)
+ "Non-nil means use `compilation-minor-mode' in Erlang shell.")
+
+(defvar erlang-mode-map
+ (let ((map (make-sparse-keymap)))
+ (unless (boundp 'indent-line-function)
+ (define-key map "\t" 'erlang-indent-command))
+ (define-key map ";" 'erlang-electric-semicolon)
+ (define-key map "," 'erlang-electric-comma)
+ (define-key map "<" 'erlang-electric-lt)
+ (define-key map ">" 'erlang-electric-gt)
+ (define-key map "\C-m" 'erlang-electric-newline)
+ (if (not (boundp 'delete-key-deletes-forward))
+ (define-key map "\177" 'backward-delete-char-untabify)
+ (define-key map [(backspace)] 'backward-delete-char-untabify))
+ ;;(unless (boundp 'fill-paragraph-function)
+ (define-key map "\M-q" 'erlang-fill-paragraph)
+ (unless (boundp 'beginning-of-defun-function)
+ (define-key map "\M-\C-a" 'erlang-beginning-of-function)
+ (define-key map "\M-\C-e" 'erlang-end-of-function)
+ (define-key map '(meta control h) 'erlang-mark-function)) ; Xemacs
+ (define-key map "\M-\t" 'erlang-complete-tag)
+ (define-key map "\C-c\M-\t" 'tempo-complete-tag)
+ (define-key map "\M-+" 'erlang-find-next-tag)
+ (define-key map "\C-c\M-a" 'erlang-beginning-of-clause)
+ (define-key map "\C-c\M-b" 'tempo-backward-mark)
+ (define-key map "\C-c\M-e" 'erlang-end-of-clause)
+ (define-key map "\C-c\M-f" 'tempo-forward-mark)
+ (define-key map "\C-c\M-h" 'erlang-mark-clause)
+ (define-key map "\C-c\C-c" 'comment-region)
+ (define-key map "\C-c\C-j" 'erlang-generate-new-clause)
+ (define-key map "\C-c\C-k" 'erlang-compile)
+ (define-key map "\C-c\C-l" 'erlang-compile-display)
+ (define-key map "\C-c\C-s" 'erlang-show-syntactic-information)
+ (define-key map "\C-c\C-q" 'erlang-indent-function)
+ (define-key map "\C-c\C-u" 'erlang-uncomment-region)
+ (define-key map "\C-c\C-y" 'erlang-clone-arguments)
+ (define-key map "\C-c\C-a" 'erlang-align-arrows)
+ (define-key map "\C-c\C-z" 'erlang-shell-display)
+ (unless inferior-erlang-use-cmm
+ (define-key map "\C-x`" 'erlang-next-error))
+ map)
"*Keymap used in Erlang mode.")
(defvar erlang-mode-abbrev-table nil
"Abbrev table in use in Erlang-mode buffers.")
(defvar erlang-mode-syntax-table nil
"Syntax table in use in Erlang-mode buffers.")
-(defconst inferior-erlang-use-cmm (boundp 'minor-mode-overriding-map-alist)
- "Non-nil means use `compilation-minor-mode' in Erlang shell.")
(defvar erlang-skel-file "erlang-skels"
@@ -1247,7 +1286,7 @@ Other commands:
(setq major-mode 'erlang-mode)
(setq mode-name "Erlang")
(erlang-syntax-table-init)
- (erlang-keymap-init)
+ (use-local-map erlang-mode-map)
(erlang-electric-init)
(erlang-menu-init)
(erlang-mode-variables)
@@ -1302,53 +1341,6 @@ Other commands:
(set-syntax-table erlang-mode-syntax-table))
-(defun erlang-keymap-init ()
- (if erlang-mode-map
- nil
- (setq erlang-mode-map (make-sparse-keymap))
- (erlang-mode-commands erlang-mode-map))
- (use-local-map erlang-mode-map))
-
-
-(defun erlang-mode-commands (map)
- (unless (boundp 'indent-line-function)
- (define-key map "\t" 'erlang-indent-command))
- (define-key map ";" 'erlang-electric-semicolon)
- (define-key map "," 'erlang-electric-comma)
- (define-key map "<" 'erlang-electric-lt)
- (define-key map ">" 'erlang-electric-gt)
- (define-key map "\C-m" 'erlang-electric-newline)
- (if (not (boundp 'delete-key-deletes-forward))
- (define-key map "\177" 'backward-delete-char-untabify)
- (define-key map [(backspace)] 'backward-delete-char-untabify))
- ;;(unless (boundp 'fill-paragraph-function)
- (define-key map "\M-q" 'erlang-fill-paragraph)
- (unless (boundp 'beginning-of-defun-function)
- (define-key map "\M-\C-a" 'erlang-beginning-of-function)
- (define-key map "\M-\C-e" 'erlang-end-of-function)
- (define-key map '(meta control h) 'erlang-mark-function)) ; Xemacs
- (define-key map "\M-\t" 'erlang-complete-tag)
- (define-key map "\C-c\M-\t" 'tempo-complete-tag)
- (define-key map "\M-+" 'erlang-find-next-tag)
- (define-key map "\C-c\M-a" 'erlang-beginning-of-clause)
- (define-key map "\C-c\M-b" 'tempo-backward-mark)
- (define-key map "\C-c\M-e" 'erlang-end-of-clause)
- (define-key map "\C-c\M-f" 'tempo-forward-mark)
- (define-key map "\C-c\M-h" 'erlang-mark-clause)
- (define-key map "\C-c\C-c" 'comment-region)
- (define-key map "\C-c\C-j" 'erlang-generate-new-clause)
- (define-key map "\C-c\C-k" 'erlang-compile)
- (define-key map "\C-c\C-l" 'erlang-compile-display)
- (define-key map "\C-c\C-s" 'erlang-show-syntactic-information)
- (define-key map "\C-c\C-q" 'erlang-indent-function)
- (define-key map "\C-c\C-u" 'erlang-uncomment-region)
- (define-key map "\C-c\C-y" 'erlang-clone-arguments)
- (define-key map "\C-c\C-a" 'erlang-align-arrows)
- (define-key map "\C-c\C-z" 'erlang-shell-display)
- (unless inferior-erlang-use-cmm
- (define-key map "\C-x`" 'erlang-next-error)))
-
-
(defun erlang-electric-init ()
;; Set up electric character functions to work with
;; delsel/pending-del mode. Also, set up text properties for bit
@@ -1402,7 +1394,7 @@ Other commands:
(set (make-local-variable 'imenu-prev-index-position-function)
'erlang-beginning-of-function)
(set (make-local-variable 'imenu-extract-index-name-function)
- 'erlang-get-function-name)
+ 'erlang-get-function-name-and-arity)
(set (make-local-variable 'tempo-match-finder)
"[^-a-zA-Z0-9_]\\([-a-zA-Z0-9_]*\\)\\=")
(set (make-local-variable 'beginning-of-defun-function)
@@ -2933,10 +2925,16 @@ This assumes that the preceding expression is either simple
(skip-chars-backward " \t")
;; Needed to match the colon in "'foo':'bar'".
(if (not (memq (preceding-char) '(?# ?:)))
- col
- (backward-char 1)
- (forward-sexp -1)
- (current-column)))))
+ col
+ ;; Special hack to handle: (note line break)
+ ;; [#myrecord{
+ ;; foo = foo}]
+ (or
+ (ignore-errors
+ (backward-char 1)
+ (forward-sexp -1)
+ (current-column))
+ col)))))
(defun erlang-indent-parenthesis (stack-position)
(let ((previous (erlang-indent-find-preceding-expr)))
@@ -3505,6 +3503,13 @@ Normally used in conjunction with `erlang-beginning-of-clause', e.g.:
res)
(error nil)))))
+(defun erlang-get-function-name-and-arity ()
+ "Return the name and arity of the function at point, or nil.
+The return value is a string of the form \"foo/1\"."
+ (let ((name (erlang-get-function-name))
+ (arity (erlang-get-function-arity)))
+ (and name arity (format "%s/%d" name arity))))
+
(defun erlang-get-function-arguments ()
"Return arguments of current function, or nil."
(if (not (looking-at (eval-when-compile
@@ -4901,9 +4906,14 @@ a prompt. When nil, we will wait forever, or until \\[keyboard-quit].")
(defvar inferior-erlang-buffer nil
"Buffer of last invoked inferior Erlang, or nil.")
+;; Enable uniquifying Erlang shell buffers based on directory name.
+(eval-after-load "uniquify"
+ '(add-to-list 'uniquify-list-buffers-directory-modes 'erlang-shell-mode))
+
;;;###autoload
-(defun inferior-erlang ()
+(defun inferior-erlang (&optional command)
"Run an inferior Erlang.
+With prefix command, prompt for command to start Erlang with.
This is just like running Erlang in a normal shell, except that
an Emacs buffer is used for input and output.
@@ -4917,17 +4927,37 @@ Entry to this mode calls the functions in the variables
The following commands imitate the usual Unix interrupt and
editing control characters:
\\{erlang-shell-mode-map}"
- (interactive)
+ (interactive
+ (when current-prefix-arg
+ (list (if (fboundp 'read-shell-command)
+ ;; `read-shell-command' is a new function in Emacs 23.
+ (read-shell-command "Erlang command: ")
+ (read-string "Erlang command: ")))))
(require 'comint)
- (let ((opts inferior-erlang-machine-options))
- (cond ((eq inferior-erlang-shell-type 'oldshell)
- (setq opts (cons "-oldshell" opts)))
- ((eq inferior-erlang-shell-type 'newshell)
- (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts))))
- (setq inferior-erlang-buffer
- (apply 'make-comint
- inferior-erlang-process-name inferior-erlang-machine
- nil opts)))
+ (let (cmd opts)
+ (if command
+ (setq cmd "sh"
+ opts (list "-c" command))
+ (setq cmd inferior-erlang-machine
+ opts inferior-erlang-machine-options)
+ (cond ((eq inferior-erlang-shell-type 'oldshell)
+ (setq opts (cons "-oldshell" opts)))
+ ((eq inferior-erlang-shell-type 'newshell)
+ (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts)))))
+
+ ;; Using create-file-buffer and list-buffers-directory in this way
+ ;; makes uniquify give each buffer a unique name based on the
+ ;; directory.
+ (let ((fake-file-name (expand-file-name inferior-erlang-buffer-name default-directory)))
+ (setq inferior-erlang-buffer (create-file-buffer fake-file-name))
+ (apply 'make-comint-in-buffer
+ inferior-erlang-process-name
+ inferior-erlang-buffer
+ cmd
+ nil opts)
+ (with-current-buffer inferior-erlang-buffer
+ (setq list-buffers-directory fake-file-name))))
+
(setq inferior-erlang-process
(get-buffer-process inferior-erlang-buffer))
(if (> 21 erlang-emacs-major-version) ; funcalls to avoid compiler warnings
@@ -4940,10 +4970,6 @@ editing control characters:
(if (and (not (eq system-type 'windows-nt))
(eq inferior-erlang-shell-type 'newshell))
(setq comint-process-echoes t))
- ;; `rename-buffer' takes only one argument in Emacs 18.
- (condition-case nil
- (rename-buffer inferior-erlang-buffer-name t)
- (error (rename-buffer inferior-erlang-buffer-name)))
(erlang-shell-mode))
diff --git a/lib/tools/emacs/test.erl.indented b/lib/tools/emacs/test.erl.indented
index d0ea4c29cf..1dc976d8dc 100644
--- a/lib/tools/emacs/test.erl.indented
+++ b/lib/tools/emacs/test.erl.indented
@@ -588,3 +588,8 @@ indent_comprehensions() ->
true = (X rem 2)
>>,
ok.
+
+%% This causes an error in earlier erlang-mode versions.
+foo() ->
+ [#foo{
+ foo = foo}].
diff --git a/lib/tools/emacs/test.erl.orig b/lib/tools/emacs/test.erl.orig
index 70e97a2e91..feb9e4e5a1 100644
--- a/lib/tools/emacs/test.erl.orig
+++ b/lib/tools/emacs/test.erl.orig
@@ -588,3 +588,8 @@ Binary2 = << <<X:8>> || <<X:32,_:32>> <= <<0:512>>,
true = (X rem 2)
>>,
ok.
+
+%% This causes an error in earlier erlang-mode versions.
+foo() ->
+[#foo{
+foo = foo}].
diff --git a/lib/wx/src/wx_object.erl b/lib/wx/src/wx_object.erl
index 1f0b7922a0..71041ff558 100644
--- a/lib/wx/src/wx_object.erl
+++ b/lib/wx/src/wx_object.erl
@@ -1,19 +1,19 @@
%%
%% %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
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%%-------------------------------------------------------------------
%%% File : wx_object.erl
@@ -321,7 +321,8 @@ loop(Parent, Name, State, Mod, Time, Debug) ->
_Msg when Debug =:= [] ->
handle_msg(Msg, Parent, Name, State, Mod);
_Msg ->
- Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, {in, Msg}),
+ Debug1 = sys:handle_debug(Debug, fun print_event/3,
+ Name, {in, Msg}),
handle_msg(Msg, Parent, Name, State, Mod, Debug1)
end.
@@ -410,12 +411,12 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug) ->
Debug1 = reply(Name, From, Reply, NState, Debug),
loop(Parent, Name, NState, Mod, Time1, Debug1);
{noreply, NState} ->
- Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name,
- {noreply, NState}),
+ Debug1 = sys:handle_debug(Debug, fun print_event/3,
+ Name, {noreply, NState}),
loop(Parent, Name, NState, Mod, infinity, Debug1);
{noreply, NState, Time1} ->
- Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name,
- {noreply, NState}),
+ Debug1 = sys:handle_debug(Debug, fun print_event/3,
+ Name, {noreply, NState}),
loop(Parent, Name, NState, Mod, Time1, Debug1);
{stop, Reason, Reply, NState} ->
{'EXIT', R} =
@@ -437,12 +438,12 @@ handle_no_reply({noreply, NState}, Parent, Name, _Msg, Mod, _State, []) ->
handle_no_reply({noreply, NState, Time1}, Parent, Name, _Msg, Mod, _State, []) ->
loop(Parent, Name, NState, Mod, Time1, []);
handle_no_reply({noreply, NState}, Parent, Name, _Msg, Mod, _State, Debug) ->
- Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name,
- {noreply, NState}),
+ Debug1 = sys:handle_debug(Debug, fun print_event/3,
+ Name, {noreply, NState}),
loop(Parent, Name, NState, Mod, infinity, Debug1);
handle_no_reply({noreply, NState, Time1}, Parent, Name, _Msg, Mod, _State, Debug) ->
- Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name,
- {noreply, NState}),
+ Debug1 = sys:handle_debug(Debug, fun print_event/3,
+ Name, {noreply, NState}),
loop(Parent, Name, NState, Mod, Time1, Debug1);
handle_no_reply(Reply, _Parent, Name, Msg, Mod, State, Debug) ->
handle_common_reply(Reply, Name, Msg, Mod, State,Debug).
@@ -462,8 +463,8 @@ handle_common_reply(Reply, Name, Msg, Mod, State, Debug) ->
%% @hidden
reply(Name, {To, Tag}, Reply, State, Debug) ->
reply({To, Tag}, Reply),
- sys:handle_debug(Debug, {gen_server, print_event}, Name,
- {out, Reply, To, State} ).
+ sys:handle_debug(Debug, fun print_event/3,
+ Name, {out, Reply, To, State}).
%%-----------------------------------------------------------------
@@ -485,6 +486,29 @@ system_code_change([Name, State, Mod, Time], _Module, OldVsn, Extra) ->
Else -> Else
end.
+%%-----------------------------------------------------------------
+%% Format debug messages. Print them as the call-back module sees
+%% them, not as the real erlang messages. Use trace for that.
+%%-----------------------------------------------------------------
+print_event(Dev, {in, Msg}, Name) ->
+ case Msg of
+ {'$gen_call', {From, _Tag}, Call} ->
+ io:format(Dev, "*DBG* ~p got call ~p from ~w~n",
+ [Name, Call, From]);
+ {'$gen_cast', Cast} ->
+ io:format(Dev, "*DBG* ~p got cast ~p~n",
+ [Name, Cast]);
+ _ ->
+ io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg])
+ end;
+print_event(Dev, {out, Msg, To, State}, Name) ->
+ io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n",
+ [Name, Msg, To, State]);
+print_event(Dev, {noreply, State}, Name) ->
+ io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]);
+print_event(Dev, Event, Name) ->
+ io:format(Dev, "*DBG* ~p dbg ~p~n", [Name, Event]).
+
%%% ---------------------------------------------------
%%% Terminate the server.
%%% ---------------------------------------------------