diff options
Diffstat (limited to 'lib/common_test')
| -rw-r--r-- | lib/common_test/Makefile | 3 | ||||
| -rw-r--r-- | lib/common_test/doc/src/ct_netconfc.xml | 376 | ||||
| -rw-r--r-- | lib/common_test/doc/src/notes.xml | 58 | ||||
| -rw-r--r-- | lib/common_test/src/Makefile | 3 | ||||
| -rw-r--r-- | lib/common_test/src/common_test.app.src | 4 | ||||
| -rw-r--r-- | lib/common_test/src/ct_event.erl | 12 | ||||
| -rw-r--r-- | lib/common_test/src/ct_framework.erl | 3 | ||||
| -rw-r--r-- | lib/common_test/src/ct_netconfc.erl | 1564 | ||||
| -rw-r--r-- | lib/common_test/src/ct_property_test.erl | 42 | ||||
| -rw-r--r-- | lib/common_test/src/ct_run.erl | 91 | ||||
| -rw-r--r-- | lib/common_test/src/ct_util.erl | 7 | ||||
| -rw-r--r-- | lib/common_test/src/ct_webtool.erl | 1214 | ||||
| -rw-r--r-- | lib/common_test/src/ct_webtool_sup.erl | 76 | ||||
| -rw-r--r-- | lib/common_test/src/vts.erl | 927 | ||||
| -rw-r--r-- | lib/common_test/test/ct_test_support.erl | 13 | ||||
| -rw-r--r-- | lib/common_test/vsn.mk | 2 |
16 files changed, 1289 insertions, 3106 deletions
diff --git a/lib/common_test/Makefile b/lib/common_test/Makefile index 35739462c5..5ac76f0044 100644 --- a/lib/common_test/Makefile +++ b/lib/common_test/Makefile @@ -45,4 +45,7 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=compiler tools crypto runtime_tools syntax_tools ftp inets \ + debugger sasl snmp ssh reltool observer xmerl + include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/common_test/doc/src/ct_netconfc.xml b/lib/common_test/doc/src/ct_netconfc.xml index 8fbe5f3df6..f4d98b611b 100644 --- a/lib/common_test/doc/src/ct_netconfc.xml +++ b/lib/common_test/doc/src/ct_netconfc.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2010</year><year>2017</year> + <year>2010</year><year>2019</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -37,51 +37,64 @@ <description> - <p>NETCONF client module.</p> - - <p>The NETCONF client is compliant with RFC 4741 NETCONF Configuration - Protocol and RFC 4742 Using the NETCONF Configuration Protocol over - Secure SHell (SSH).</p> + <p>NETCONF client module compliant with RFC 6241, NETCONF Configuration + Protocol, and RFC 6242, Using the NETCONF Configuration Protocol over + Secure SHell (SSH), and with support for RFC 5277, NETCONF Event + Notifications.</p> <marker id="Connecting"/> <p><em>Connecting to a NETCONF server</em></p> - <p>NETCONF sessions can either be opened by a single call - to <seealso marker="#open-1"><c>open/1,2</c></seealso> or by a call - to <seealso marker="#connect-1"><c>connect/1,2</c></seealso> followed - by one or more calls to - <seealso marker="#session-1"><c>session/1,2,3</c></seealso>.</p> - - <p>The properties of the sessions will be exactly the same, except - that when - using <seealso marker="#connect-1"><c>connect/1,2</c></seealso>, you - may start multiple sessions over the same SSH connection. Each - session is implemented as an SSH channel.</p> - - <p><seealso marker="#open-1"><c>open/1,2</c></seealso> will establish one - SSH connection with one SSH channel implementing one NETCONF - session. You may start mutiple sessions by - calling <seealso marker="#open-1"><c>open/1,2</c></seealso> multiple - times, but then a new SSH connection will be established for each - session.</p> - - <p>For each server to test against, the following entry can be added to a - configuration file:</p> + <p>Call <seealso marker="#connect-1"><c>connect/1,2</c></seealso> + to establish a connection to a server, then pass the returned + handle to <seealso marker="#session-1"><c>session/1-3</c></seealso> to + establish a NETCONF session on a new SSH channel. + Each call to + <seealso marker="#session-1"><c>session/1-3</c></seealso> establishes a + new session on the same connection, and results in a hello message + to the server.</p> + + <p>Alternately, + <seealso marker="#open-1"><c>open/1,2</c></seealso> can be used to + establish a single session on a dedicated connection. + (Or, equivalently, + <seealso marker="#only_open-1"><c>only_open/1,2</c></seealso> + followed by <seealso marker="#hello-1"><c>hello/1-3</c></seealso>.)</p> + + <p>Connect/session options can be specified in a configuration + file with entries like the following.</p> <pre> - {server_id(),options()}.</pre> + {server_id(), [option()]}.</pre> <p>The <seealso marker="#type-server_id"><c>server_id()</c></seealso> - or an associated - <seealso marker="ct#type-target_name"><c>ct:target_name()</c></seealso> - must then be used in calls to - <seealso marker="#connect-2"><c>connect/2</c></seealso> - or <seealso marker="#open-2"><c>open/2</c></seealso>.</p> - - <p>If no configuration exists for a server, - use <seealso marker="#connect-1"><c>connect/1</c></seealso> - or <seealso marker="#open-1"><c>open/1</c></seealso> instead, - and specify all necessary options in the <c>Options</c> parameter.</p> + or an associated + <seealso marker="ct#type-target_name"><c>ct:target_name()</c></seealso> + can then be passed to the aforementioned functions to use the + referenced configuration.</p> + + <marker id="Signaling"/> + <p><em>Signaling</em></p> + + <p>Protocol operations in the NETCONF protocol are realized as remote + procedure calls (RPCs) from client to server and a corresponding + reply from server to client. + RPCs are sent using like-named functions (eg. + <seealso marker="#edit_config-3"><c>edit_config/3-5</c></seealso> + to send an edit-config RPC), with the server reply + as return value. + There are functions for each RPC defined in RFC 6241 and + the create-subscription RPC from RFC 5277, all of which are + wrappers on <seealso marker="#send_rpc-2"><c>send_rpc/2,3</c></seealso>, + that can be used to send an arbitrary RPC + not defined in RFC 6241 or RFC 5277.</p> + + <p>All of the signaling functions have one variant with a + <c>Timeout</c> argument and one without, corresponding to an + infinite timeout. + The latter is inappropriate in most cases since a non-response by + the server or a missing message-id causes the call to hang + indefinitely.</p> <marker id="Logging"/> <p><em>Logging</em></p> @@ -93,7 +106,7 @@ <pre> suite() -> - [{ct_hooks, [{cth_conn_log, [{<seealso marker="ct#type-conn_log_mod"><c>ct:conn_log_mod()</c></seealso>,<seealso marker="ct#type-conn_log_options"><c>ct:conn_log_options()</c></seealso>}]}]}].</pre> + [{ct_hooks, [{cth_conn_log, [{<seealso marker="ct#type-conn_log_mod"><c>ct:conn_log_mod()</c></seealso>, <seealso marker="ct#type-conn_log_options"><c>ct:conn_log_options()</c></seealso>}]}]}].</pre> <p><c>conn_log_mod()</c> is the name of the <c>Common Test</c> module implementing the connection protocol, for example, <c>ct_netconfc</c>.</p> @@ -133,7 +146,7 @@ configuration variable <c>ct_conn_log</c>:</p> <pre> - {ct_conn_log,[{<seealso marker="ct#type-conn_log_mod"><c>ct:conn_log_mod()</c></seealso>,<seealso marker="ct#type-conn_log_options"><c>ct:conn_log_options()</c></seealso>}]}.</pre> + {ct_conn_log,[{<seealso marker="ct#type-conn_log_mod"><c>ct:conn_log_mod()</c></seealso>, <seealso marker="ct#type-conn_log_options"><c>ct:conn_log_options()</c></seealso>}]}.</pre> <p>For example:</p> @@ -185,100 +198,111 @@ would cause HTML logging of all NETCONF connections in to the test case HTML log.</p> - <marker id="Notifications"/> - <p><em>Notifications</em></p> - - <p>The NETCONF client is also compliant with RFC 5277 NETCONF Event - Notifications, which defines a mechanism for an asynchronous message - notification delivery service for the NETCONF protocol.</p> - - <p>Specific functions to support this are - <seealso marker="#create_subscription-1"><c>create_subscription/1-6</c></seealso> - and - <seealso marker="#get_event_streams-1"><c>get_event_streams/1-3</c></seealso>.</p> - - <marker id="Default_timeout"/> - <p><em>Default Timeout</em></p> - - <p>Most of the functions in this module have one variant with - a <c>Timeout</c> parameter, and one without. If nothing else is - specified, the default value <c>infinity</c> is used when - the <c>Timeout</c> parameter is not given.</p> - </description> + <!-- ====================================================================== --> + <datatypes> <datatype> <name name="client"/> - </datatype> - <datatype> - <name name="error_reason"/> - </datatype> - <datatype> - <name name="event_time"/> + <desc> + <p>Handle to a NETCONF session, as required by signaling + functions.</p> + </desc> </datatype> <datatype> <name name="handle"/> <desc> - <p>Opaque reference for a connection to a NETCONF server or a - NETCONF session.</p> + <p>Handle to a connection to a NETCONF server as + returned by + <seealso marker="#connect-1"><c>connect/1,2</c></seealso>, + or to a session as returned by + <seealso marker="#session-1"><c>session/1-3</c></seealso>, + <seealso marker="#open-1"><c>open/1,2</c></seealso>, + or <seealso marker="#only_open-1"><c>only_open/1,2</c></seealso>.</p> </desc> </datatype> <datatype> - <name name="host"/> - </datatype> - <datatype> - <name name="netconf_db"/> + <name name="xs_datetime"/> + <desc> + <p>Date and time of a startTime/stopTime element in an RFC + 5277 create-subscription request. Of XML primitive type + <c>dateTime</c>, which has the (informal) form</p> + <pre> + [-]YYYY-MM-DDThh:mm:ss[.s][Z|(+|-)hh:mm]</pre> + <p>where <c>T</c> and <c>Z</c> are literal and <c>.s</c> is + one or more fractional seconds.</p> + </desc> </datatype> <datatype> - <name name="notification"/> + <name name="event_time"/> </datatype> <datatype> <name name="notification_content"/> </datatype> <datatype> - <name name="option"/> + <name name="notification"/> <desc> - <p><c>SshConnectOption</c> is any valid option to - <seealso marker="ssh:ssh#connect-3"><c>ssh:connect/3,4</c></seealso>. - Common options used are <c>user</c>, <c>password</c> - and <c>user_dir</c>. The <c>SshConnectOptions</c> are - verfied by the SSH application.</p> + <p>Event notification messages sent as a result of calls to + <seealso marker="#create_subscription-2"><c>create_subscription/2,3</c></seealso>.</p> </desc> </datatype> <datatype> - <name name="options"/> + <name name="option"/> <desc> - <p>Options used for setting up an SSH connection to a NETCONF - server.</p> + <p>Options <c>host</c> and <c>port</c> specify the + server endpoint to which to connect, and are passed directly + to <seealso + marker="ssh:ssh#connect-3"><c>ssh:connect/4</c></seealso>, + as are arbitrary ssh options. Common options are <c>user</c>, + <c>password</c> and <c>user_dir</c>.</p> + + <p>Option <c>timeout</c> specifies the number of + milliseconds to allow for connection establishment and, if the + function in question results in an outgoing hello message, + reception of the server hello. The timeout applies to + connection and hello independently; + one timeout for connection establishment, another for hello + reception.</p> + + <p>Option <c>capability</c> specifies the content of a + corresponding element in an outgoing hello message, each + option specifying the content of a single element. + If no base NETCONF capability is configured then the RFC 4741 + 1.0 capability, "urn:ietf:params:netconf:base:1.0", is added, + otherwise not. + In particular, the RFC 6241 1.1 capability must be explicitly + configured. + NETCONF capabilities can be specified using the shorthand notation + defined in RFC 6241, any capability string starting with a + colon being prefixed by either "urn:ietf:params:netconf" or + "urn:ietf:params:netconf:capability", as appropriate.</p> + + <p>Capability options are ignored by connect/1-3 and only_open/1-2, + which don't result in an outgoing hello message.</p> </desc> </datatype> <datatype> <name name="server_id"/> <desc> - <p>The identity of a server, specified in a configuration - file.</p> - </desc> - </datatype> - <datatype> - <name name="simple_xml"/> - <desc> - <p>This type is further described in application - <seealso marker="xmerl:index"><c>xmerl</c></seealso>.</p> + <p>Identity of connection or session configuration in a + configuration file.</p> </desc> </datatype> <datatype> <name name="stream_data"/> - <desc> - <p>For details about the data format for the string values, see - "XML Schema for Event Notifications" in RFC 5277.</p> - </desc> </datatype> <datatype> <name name="stream_name"/> </datatype> <datatype> <name name="streams"/> + <desc> + <p>Stream information as returned by + <seealso marker="#get_event_streams-1"><c>get_event_streams/1-3</c></seealso>. + See RFC 5277, "XML Schema for Event Notifications", for detail + on the format of the string values.</p> + </desc> </datatype> <datatype> <name name="xml_attribute_tag"/> @@ -296,20 +320,28 @@ <name name="xml_tag"/> </datatype> <datatype> + <name name="simple_xml"/> + <desc> + <p>Representation of XML, as described in application + <seealso marker="xmerl:index"><c>xmerl</c></seealso>.</p> + </desc> + </datatype> + <datatype> <name name="xpath"/> </datatype> <datatype> - <name name="xs_datetime"/> - <desc> - <p>This date and time identifier has the same format as the XML type - <c>dateTime</c> and is compliant with RFC 3339 Date and Time on - the Internet Timestamps. The format is as follows:</p> - <pre> - [-]CCYY-MM-DDThh:mm:ss[.s][Z|(+|-)hh:mm]</pre> - </desc> + <name name="error_reason"/> + </datatype> + <datatype> + <name name="host"/> + </datatype> + <datatype> + <name name="netconf_db"/> </datatype> </datatypes> + <!-- ====================================================================== --> + <funcs> <func> <name name="action" arity="2" since="OTP R15B02"/> @@ -352,11 +384,7 @@ reference returned from this function is required as connection identifier when opening sessions over this connection, see - <seealso marker="#session-1"><c>session/1,2,3</c></seealso>.</p> - - <p>Option <c>timeout</c> (milliseconds) is used when setting up the - SSH connection. It is not used for any other purposes during the - lifetime of the connection.</p> + <seealso marker="#session-1"><c>session/1-3</c></seealso>.</p> </desc> </func> @@ -371,10 +399,9 @@ <c>target_name()</c> associated with such an Id, then the options for this server are fetched from the configuration file.</p> - <p>Argument <c><anno>ExtraOptions</anno></c> is added to the - options found in the configuration file. If the same options - are specified, the values from the configuration file - overwrite <c><anno>ExtraOptions</anno></c>.</p> + <p>The options list is added to those of the + configuration file. If an option is specified in both lists, + the configuration file takes precedence.</p> <p>If the server is not specified in a configuration file, use <seealso marker="#connect-1"><c>connect/1</c></seealso> @@ -384,17 +411,13 @@ reference returned from this function can be used as connection identifier when opening sessions over this connection, see - <seealso marker="#session-1"><c>session/1,2,3</c></seealso>. + <seealso marker="#session-1"><c>session/1-3</c></seealso>. However, if <c><anno>KeyOrName</anno></c> is a <c>target_name()</c>, that is, if the server is named through a call to <seealso marker="ct#require-2"><c>ct:require/2</c></seealso> or a <c>require</c> statement in the test suite, then this name can be used instead of <seealso marker="#type-handle"><c>handle()</c></seealso>.</p> - - <p>Option <c>timeout</c> (milliseconds) is used when setting up the - SSH connection. It is not used for any other purposes during the - lifetime of the connection.</p> </desc> </func> @@ -412,80 +435,61 @@ </func> <func> - <name since="OTP R15B02">create_subscription(Client) -> Result</name> - <name since="OTP R15B02">create_subscription(Client, Stream) -> Result</name> - <name since="OTP R15B02">create_subscription(Client, Stream, Filter) -> Result</name> - <name since="OTP R15B02">create_subscription(Client, Stream, Filter, Timeout) -> Result</name> - <name name="create_subscription" arity="5" clause_i="2" since="OTP R15B02"/> - <name name="create_subscription" arity="6" since="OTP R15B02"/> + <name name="create_subscription" arity="2" clause_i="1" since="OTP 22.1"/> + <name name="create_subscription" arity="3" clause_i="1" since="OTP 22.1"/> <fsummary>Creates a subscription for event notifications.</fsummary> <desc> - <p>Creates a subscription for event notifications.</p> - - <p>This function sets up a subscription for NETCONF event - notifications of the specified stream type, matching the specified - filter. The calling process receives notifications as messages of - type <seealso marker="#type-notification"><c>notification()</c></seealso>.</p> - - <p>Only a subset of the function clauses are show above. The - full set of valid combinations of input parameters is as - follows:</p> - -<pre>create_subscription(Client) + <p>Creates a subscription for event notifications by sending + an RFC 5277 create-subscription RPC to the server. + The calling process receives events as messages of + type <seealso marker="#type-notification"><c>notification()</c></seealso>.</p> -create_subscription(Client, Timeout) -create_subscription(Client, Stream) -create_subscription(Client, Filter) - -create_subscription(Client, Stream, Timeout) -create_subscription(Client, Filter, Timeout) -create_subscription(Client, Stream, Filter) -create_subscription(Client, StartTime, StopTime) - -create_subscription(Client, Stream, Filter, Timeout) -create_subscription(Client, StartTime, StopTime, Timeout) -create_subscription(Client, Stream, StartTime, StopTime) -create_subscription(Client, Filter, StartTime, StopTime) - -create_subscription(Client, Stream, StartTime, StopTime, Timeout) -create_subscription(Client, Stream, Filter, StartTime, StopTime) -create_subscription(Client, Stream, Filter, StartTime, StopTime, Timeout)</pre> + <p>From RFC 5722, 2.1 Subscribing to Receive Event Notifications:</p> <taglist> <tag><c><anno>Stream</anno></c></tag> - <item><p>Optional parameter that indicates which stream of event + <item><p>Indicates which stream of event is of interest. If not present, events in the default NETCONF stream are sent.</p></item> <tag><c><anno>Filter</anno></c></tag> - <item><p>Optional parameter that indicates which subset of all + <item><p>Indicates which subset of all possible events is of interest. The parameter format is the same as that of the filter parameter in the NETCONF protocol operations. If not present, all events not precluded by other parameters are sent.</p></item> <tag><c><anno>StartTime</anno></c></tag> - <item><p>Optional parameter used to trigger the replay feature and + <item><p>Used to trigger the replay feature and indicate that the replay is to start at the time specified. If <c><anno>StartTime</anno></c> is not present, this is not a - replay subscription.</p> - <p>It is not valid to specify start times that are later than + replay subscription. + It is not valid to specify start times that are later than the current time. If <c><anno>StartTime</anno></c> is specified earlier than the log can support, the replay begins with the - earliest available notification.</p> - <p>This parameter is of type <c>dateTime</c> and compliant to + earliest available notification. + This parameter is of type <c>dateTime</c> and compliant to RFC 3339. Implementations must support time zones.</p></item> <tag><c><anno>StopTime</anno></c></tag> - <item><p>Optional parameter used with the optional replay feature + <item><p>Used with the optional replay feature to indicate the newest notifications of interest. If <c><anno>StopTime</anno></c> is not present, the notifications - continues until the subscription is terminated.</p> - <p>Must be used with and be later than <c>StartTime</c>. Values + continues until the subscription is terminated. + Must be used with and be later than <c>StartTime</c>. Values of <c><anno>StopTime</anno></c> in the future are valid. This parameter is of type <c>dateTime</c> and compliant to RFC 3339. Implementations must support time zones.</p></item> </taglist> - <p>For more details about the event notification mechanism, see - RFC 5277.</p> + <p>See RFC 5277 for more details. The requirement that + <c>StopTime</c> must only be used with <c>StartTime</c> is not + enforced, to allow an invalid request to be sent to the + server.</p> + + <p>Prior to OTP 22.1, this function was documented as having + 15 variants in 6 arities. These are still exported for + backwards compatibility, but no longer documented. + The map-based variants documented above provide the same + functionality with simpler arguments.</p> + </desc> </func> @@ -561,23 +565,7 @@ create_subscription(Client, Stream, Filter, StartTime, StopTime, Timeout)</pre> <name name="get_capabilities" arity="2" since="OTP R15B02"/> <fsummary>Returns the server side capabilities.</fsummary> <desc> - <p>Returns the server side capabilities.</p> - - <p>The following capability identifiers, defined in RFC 4741 NETCONF - Configuration Protocol, can be returned:</p> - - <list> - <item><p><c>"urn:ietf:params:netconf:base:1.0"</c></p></item> - <item><p><c>"urn:ietf:params:netconf:capability:writable-running:1.0"</c></p></item> - <item><p><c>"urn:ietf:params:netconf:capability:candidate:1.0"</c></p></item> - <item><p><c>"urn:ietf:params:netconf:capability:confirmed-commit:1.0"</c></p></item> - <item><p><c>"urn:ietf:params:netconf:capability:rollback-on-error:1.0"</c></p></item> - <item><p><c>"urn:ietf:params:netconf:capability:startup:1.0"</c></p></item> - <item><p><c>"urn:ietf:params:netconf:capability:url:1.0"</c></p></item> - <item><p><c>"urn:ietf:params:netconf:capability:xpath:1.0"</c></p></item> - </list> - - <p>More identifiers can exist, for example, server-side namespace.</p> + <p>Returns the server capabilities as received in its hello message.</p> </desc> </func> @@ -652,10 +640,12 @@ create_subscription(Client, Stream, Filter, StartTime, StopTime, Timeout)</pre> <name name="hello" arity="3" since="OTP 17.5.3"/> <fsummary>Exchanges hello messages with the server.</fsummary> <desc> - <p>Exchanges <c>hello</c> messages with the server.</p> + <p>Exchanges <c>hello</c> messages with the server. Returns + when the server hello has been received or after the + specified timeout.</p> - <p>Adds optional capabilities and sends a <c>hello</c> message to the - server and waits for the return.</p> + <p>Note that capabilities for an outgoing hello can be passed + directly to <seealso marker="#open-2"><c>open/2</c></seealso>.</p> </desc> </func> @@ -740,11 +730,6 @@ create_subscription(Client, Stream, Filter, StartTime, StopTime, Timeout)</pre> reference returned from this function is required as client identifier when calling any other function in this module.</p> - - <p>Option <c>timeout</c> (milliseconds) is used when setting up the - SSH connection and when waiting for the <c>hello</c> message from - the server. It is not used for any other purposes during the - lifetime of the connection.</p> </desc> </func> @@ -761,10 +746,9 @@ create_subscription(Client, Stream, Filter, StartTime, StopTime, Timeout)</pre> <c>target_name()</c> associated with such an Id, then the options for this server are fetched from the configuration file.</p> - <p>Argument <c><anno>ExtraOptions</anno></c> is added to the - options found in the configuration file. If the same - options are specified, the values from the configuration - file overwrite <c><anno>ExtraOptions</anno></c>.</p> + <p>The options list is added to those of the + configuration file. If an option is specified in both lists, + the configuration file take precedence.</p> <p>If the server is not specified in a configuration file, use <seealso marker="#open-1"><c>open/1</c></seealso> @@ -780,11 +764,6 @@ create_subscription(Client, Stream, Filter, StartTime, StopTime, Timeout)</pre> be used instead of <seealso marker="#type-handle"><c>handle()</c></seealso>.</p> - <p>Option <c>timeout</c> (milliseconds) is used when setting up the - SSH connection and when waiting for the <c>hello</c> message from - the server. It is not used for any other purposes during the - lifetime of the connection.</p> - <p>See also <seealso marker="ct#require-2"><c>ct:require/2</c></seealso>.</p> </desc> @@ -827,7 +806,6 @@ create_subscription(Client, Stream, Filter, StartTime, StopTime, Timeout)</pre> <fsummary>Opens a NETCONF session as a channel on the given SSH connection, and exchanges hello messages with the server.</fsummary> - <type name="session_options"/> <type name="session_option"/> <desc> <p>Opens a NETCONF session as a channel on the given SSH diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index c454608bbe..39388fd5ed 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -33,6 +33,64 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.18</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + If a ct hook is installed in the <c>suite/0</c> function + in a test suite, then the hook's <c>terminate/1</c> + function would be called several times without it's + <c>init/2</c> function being called first. This is now + corrected.</p> + <p> + Own Id: OTP-15863 Aux Id: ERIERL-370 </p> + </item> + <item> + <p> + If <c>init_per_testcase</c> fails, the test itself is + skipped. According to the documentation, it should be + possible to change the result to failed in a hook + function. The only available hook function in this case + is <c>post_init_per_testcase</c>, but changing the return + value there did not affect the test case result. This is + now corrected.</p> + <p> + Own Id: OTP-15869 Aux Id: ERIERL-350 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add ct_netconfc support for NETCONF 1.1 (RFC 6241). The + 1.1 base capability can be sent in hello, and RFC 6242 + chunk framing is applied when both client and server + advertise 1.1 support.</p> + <p> + Own Id: OTP-15789</p> + </item> + <item> + <p> + Correct lib_dir paths in common_tests opaque data + structure that is passed to ct_release_test callback + modules in functions upgrade_init/2, upgrade_upgraded/2 + and upgrade_downgraded/2. The incorrect paths may cause + confusion when debugging although it will not cause any + incorrect behavior on the part of common_test as it is + currently not used.</p> + <p> + Own Id: OTP-15934</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.17.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 80eaed70bd..76689dab8c 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -62,9 +62,6 @@ MODULES= \ ct_repeat \ ct_telnet_client \ ct_make \ - vts \ - ct_webtool \ - ct_webtool_sup \ unix_telnet \ ct_config \ ct_config_plain \ diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index efebea896c..271bb2335b 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -49,10 +49,7 @@ ct_telnet, ct_testspec, ct_util, - ct_webtool, - ct_webtool_sup, unix_telnet, - vts, ct_config, ct_config_plain, ct_config_xml, @@ -72,7 +69,6 @@ ct_util_server, ct_config_server, ct_make_ref, - vts, ct_master, ct_master_logs, test_server_ctrl, diff --git a/lib/common_test/src/ct_event.erl b/lib/common_test/src/ct_event.erl index 3689c6bc45..7c6ba28180 100644 --- a/lib/common_test/src/ct_event.erl +++ b/lib/common_test/src/ct_event.erl @@ -221,17 +221,7 @@ handle_event(Event,State=#state{receivers=RecvPids}) -> %% report to master report_event({master,Master},E=#event{name=_Name,node=_Node,data=_Data}) -> - ct_master:status(Master,E); - -%% report to VTS -report_event({vts,VTS},#event{name=Name,node=_Node,data=Data}) -> - if Name == start_info ; - Name == test_stats ; - Name == test_done -> - vts:test_info(VTS,Name,Data); - true -> - ok - end. + ct_master:status(Master,E). %%-------------------------------------------------------------------- diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index bce6420042..367b5f5fdc 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -1550,8 +1550,7 @@ report(What,Data) -> end; _ -> ok - end, - catch vts:report(What,Data). + end. add_to_stats(Result) -> Update = fun({Ok,Failed,Skipped={UserSkipped,AutoSkipped}}) -> diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index 6a758c4ea3..7ad6fa46e8 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -1,7 +1,7 @@ %%---------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2017. All Rights Reserved. +%% Copyright Ericsson AB 2012-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,7 +26,7 @@ %% Netconf servers can be configured by adding the following statement %% to a configuration file: %% -%% {server_id(),options()}. +%% {server_id(), [option()]}. %% %% The server_id() or an associated ct:target_name() shall then be %% used in calls to open/2 connect/2. @@ -55,13 +55,14 @@ %% The netconf client is also compliant with RFC5277 NETCONF Event %% Notifications, which defines a mechanism for an asynchronous %% message notification delivery service for the netconf protocol. -%% -%% Specific functions to support this are create_subscription/6 -%% get_event_streams/3. (The functions also exist with other arities.) +%% Functions supporting this are create_subscription/3 +%% get_event_streams/3. %% %%---------------------------------------------------------------------- -module(ct_netconfc). +-dialyzer(no_improper_lists). + -include("ct_netconfc.hrl"). -include("ct_util.hrl"). -include_lib("xmerl/include/xmerl.hrl"). @@ -107,12 +108,8 @@ copy_config/4, action/2, action/3, - create_subscription/1, create_subscription/2, create_subscription/3, - create_subscription/4, - create_subscription/5, - create_subscription/6, get_event_streams/1, get_event_streams/2, get_event_streams/3, @@ -121,6 +118,12 @@ get_session_id/1, get_session_id/2]). +%% historic, no longer documented +-export([create_subscription/1, + create_subscription/4, + create_subscription/5, + create_subscription/6]). + %%---------------------------------------------------------------------- %% Exported types %%---------------------------------------------------------------------- @@ -163,6 +166,9 @@ (is_atom(Xml) orelse (is_tuple(Xml) andalso is_atom(element(1,Xml))))). -define(is_string(S), (is_list(S) andalso is_integer(hd(S)))). +%% Keys into the process dictionary. +-define(KEY(T), {?MODULE, T}). + %%---------------------------------------------------------------------- %% Records %%---------------------------------------------------------------------- @@ -173,9 +179,9 @@ capabilities, session_id, msg_id = 1, - hello_status, - no_end_tag_buff = <<>>, - buff = <<>>, + hello_status, % undefined | received | #pending{} + % string() | {error, Reason} + buf = false, % binary() | list() | boolean() pending = [], % [#pending] event_receiver}).% pid @@ -195,10 +201,9 @@ type}). %% Pending replies from server --record(pending, {tref, % timer ref (returned from timer:xxx) - ref, % pending ref +-record(pending, {tref :: false | reference(), % timer reference msg_id, - op, + op, caller}).% pid which sent the request %%---------------------------------------------------------------------- @@ -207,13 +212,14 @@ -type client() :: handle() | server_id() | ct:target_name(). -opaque handle() :: pid(). --type options() :: [option()]. --type option() :: {ssh,host()} | {port,inet:port_number()} | {user,string()} | - {password,string()} | {user_dir,string()} | - {timeout,timeout()}. +-type option() :: {host | ssh, host()} + | {port, inet:port_number()} + | {timeout, timeout()} + | {capability, string() | [string()]} + | ssh:client_option(). --type session_options() :: [session_option()]. --type session_option() :: {timeout,timeout()}. +-type session_option() :: {timeout,timeout()} + | {capability, string() | [string()]}. -type host() :: inet:hostname() | inet:ip_address(). @@ -258,33 +264,44 @@ %% Open an SSH connection to a Netconf server %% If the server options are specified in a configuration file, use %% open/2. + +%% connect/1 + -spec connect(Options) -> Result when - Options :: options(), - Result :: {ok,handle()} | {error,error_reason()}. + Options :: [option()], + Result :: {ok, handle()} | {error, error_reason()}. connect(Options) -> - do_connect(Options, #options{type=connection},[]). + connect(Options, #options{type = connection}, []). + +%% connect/2 --spec connect(KeyOrName,ExtraOptions) -> Result when +-spec connect(KeyOrName, ExtraOptions) -> Result when KeyOrName :: ct:key_or_name(), - ExtraOptions :: options(), - Result :: {ok,handle()} | {error,error_reason()}. + ExtraOptions :: [option()], + Result :: {ok, handle()} | {error, error_reason()}. + connect(KeyOrName, ExtraOptions) -> - SortedExtra = lists:keysort(1,ExtraOptions), - SortedConfig = lists:keysort(1,ct:get_config(KeyOrName,[])), - AllOpts = lists:ukeymerge(1,SortedConfig,SortedExtra), - do_connect(AllOpts,#options{name=KeyOrName,type=connection},[{name,KeyOrName}]). - -do_connect(OptList,InitOptRec,NameOpt) -> - case check_options(OptList,InitOptRec) of - {Host,Port,Options} -> - ct_gen_conn:start({Host,Port},Options,?MODULE, - NameOpt ++ [{reconnect,false}, - {use_existing_connection,false}, - {forward_messages,false}]); - Error -> - Error + connect(make_opts(KeyOrName, ExtraOptions), + #options{name = KeyOrName, type = connection}, + [{name, KeyOrName}]). + +%% connect/3 + +connect(Opts, InitRec, NameOpt) -> + case make_options(Opts, InitRec) of + #options{} = Rec -> + start(Rec, NameOpt, false); + {error, _} = No -> + No end. +%% make_opts/2 + +make_opts(KeyOrName, ExtraOptions) -> + SortedExtra = lists:keysort(1, ExtraOptions), + SortedConfig = lists:keysort(1, ct:get_config(KeyOrName, [])), + lists:ukeymerge(1, SortedConfig, SortedExtra). + %%---------------------------------------------------------------------- %% Close the given SSH connection. -spec disconnect(Conn) -> ok | {error,error_reason()} when @@ -300,146 +317,185 @@ disconnect(Conn) -> %%---------------------------------------------------------------------- %% Open a netconf session as a channel on the given SSH connection, %% and exchange `hello' messages. + +%% session/1 + -spec session(Conn) -> Result when Conn :: handle(), - Result :: {ok,handle()} | {error,error_reason()}. + Result :: {ok, handle()} | {error, error_reason()}. + session(Conn) -> - do_session(Conn,[],#options{type=channel},[]). + session(Conn, [], #options{type = channel}, []). --spec session(Conn,Options) -> Result when +%% session/2 + +-spec session(Conn, Options) -> Result when Conn :: handle(), - Options :: session_options(), - Result :: {ok,handle()} | {error,error_reason()}; - (KeyOrName,Conn) -> Result when + Options :: [session_option()], + Result :: {ok, handle()} | {error, error_reason()}; + (KeyOrName, Conn) -> Result when KeyOrName :: ct:key_or_name(), Conn :: handle(), - Result :: {ok,handle()} | {error,error_reason()}. -session(Conn,Options) when is_list(Options) -> - do_session(Conn,Options,#options{type=channel},[]); -session(KeyOrName,Conn) -> - do_session(Conn,[],#options{name=KeyOrName,type=channel},[{name,KeyOrName}]). + Result :: {ok, handle()} | {error, error_reason()}. + +session(Conn, Options) when is_list(Options) -> + session(Conn, Options, #options{type = channel}, []); --spec session(KeyOrName,Conn,Options) -> Result when +session(KeyOrName, Conn) -> + session(Conn, + [], + #options{name = KeyOrName, type = channel}, + [{name, KeyOrName}]). + +%% session/3 + +-spec session(KeyOrName, Conn, Options) -> Result when Conn :: handle(), - Options :: session_options(), + Options :: [session_option()], KeyOrName :: ct:key_or_name(), - Result :: {ok,handle()} | {error,error_reason()}. -session(KeyOrName,Conn,ExtraOptions) -> - SortedExtra = lists:keysort(1,ExtraOptions), - SortedConfig = lists:keysort(1,ct:get_config(KeyOrName,[])), - AllOpts = lists:ukeymerge(1,SortedConfig,SortedExtra), - do_session(Conn,AllOpts,#options{name=KeyOrName,type=channel}, - [{name,KeyOrName}]). - -do_session(Conn,OptList,InitOptRec,NameOpt) -> - case call(Conn,get_ssh_connection) of - {ok,SshConn} -> - case check_session_options(OptList,InitOptRec) of - {ok,Options} -> - case ct_gen_conn:start(SshConn,Options,?MODULE, - NameOpt ++ - [{reconnect,false}, - {use_existing_connection,false}, - {forward_messages,true}]) of - {ok,Client} -> - case hello(Client,Options#options.timeout) of - ok -> - {ok,Client}; - Error -> - Error - end; - Error -> - Error - end; - Error -> - Error - end; - Error -> - Error + Result :: {ok, handle()} | {error, error_reason()}. + +session(KeyOrName, Conn, ExtraOptions) -> + session(Conn, + make_opts(KeyOrName, ExtraOptions), + #options{name = KeyOrName, type = channel}, + [{name, KeyOrName}]). + +%% session/4 + +session(Conn, Opts, InitRec, NameOpt) -> + T = make_ref(), + try + [_ | {ok, SshConn}] = [T | call(Conn, get_ssh_connection)], + [_ | #options{} = Rec] = [T | make_session_options(Opts, InitRec)], + [_ | {ok, Client} = Ok] = [T | start(SshConn, Rec, NameOpt, true)], + [_ | ok] = [T | hello(Client, caps(Opts), Rec#options.timeout)], + Ok + catch + error: {badmatch, [T | Error]} -> + Error end. +%% caps/1 + +caps(Opts) -> + [T || {capability, _} = T <- Opts]. + %%---------------------------------------------------------------------- %% Open a netconf session and exchange 'hello' messages. %% If the server options are specified in a configuration file, use %% open/2. + +%% open/1 + -spec open(Options) -> Result when - Options :: options(), - Result :: {ok,handle()} | {error,error_reason()}. + Options :: [option()], + Result :: {ok, handle()} | {error, error_reason()}. + open(Options) -> - open(Options,#options{type=connection_and_channel},[],true). + open(Options, + #options{type = connection_and_channel}, + [], + true). --spec open(KeyOrName, ExtraOptions) -> Result when +-spec open(KeyOrName, ExtraOption) -> Result when KeyOrName :: ct:key_or_name(), - ExtraOptions :: options(), - Result :: {ok,handle()} | {error,error_reason()}. + ExtraOption :: [option()], + Result :: {ok, handle()} | {error, error_reason()}. + open(KeyOrName, ExtraOpts) -> open(KeyOrName, ExtraOpts, true). -open(KeyOrName, ExtraOpts, Hello) -> - SortedExtra = lists:keysort(1,ExtraOpts), - SortedConfig = lists:keysort(1,ct:get_config(KeyOrName,[])), - AllOpts = lists:ukeymerge(1,SortedConfig,SortedExtra), - open(AllOpts,#options{name=KeyOrName,type=connection_and_channel}, - [{name,KeyOrName}],Hello). - -open(OptList,InitOptRec,NameOpt,Hello) -> - case check_options(OptList,InitOptRec) of - {Host,Port,Options} -> - case ct_gen_conn:start({Host,Port},Options,?MODULE, - NameOpt ++ [{reconnect,false}, - {use_existing_connection,false}, - {forward_messages,true}]) of - {ok,Client} when Hello==true -> - case hello(Client,Options#options.timeout) of - ok -> - {ok,Client}; - Error -> - Error - end; - Other -> - Other - end; - Error -> - Error +%% open/3 + +open(KeyOrName, ExtraOptions, Hello) -> + open(make_opts(KeyOrName, ExtraOptions), + #options{name = KeyOrName, type = connection_and_channel}, + [{name, KeyOrName}], + Hello). + +%% open/4 + +open(Opts, InitRec, NameOpt, Hello) -> + T = make_ref(), + try + [_, #options{} = Rec] = [T, make_options(Opts, InitRec)], + [_, {ok, Client} = Ok | true] = [T, start(Rec, NameOpt, true) | Hello], + [_, ok] = [T, hello(Client, caps(Opts), Rec#options.timeout)], + Ok + catch + error: {badmatch, [T, Res | _]} -> + Res end. +%% start/3 + +start(#options{host = undefined}, _, _) -> + {error, no_host_address}; + +start(#options{port = undefined}, _, _) -> + {error, no_port}; + +start(#options{host = Host, port = Port} = Opts, NameOpt, Fwd) -> + start({Host, Port}, Opts, NameOpt, Fwd). + +%% start/4 + +start(Ep, Opts, NameOpt, Fwd) -> + ct_gen_conn:start(Ep, Opts, ?MODULE, [{reconnect, false}, + {use_existing_connection, false}, + {forward_messages, Fwd} + | NameOpt]). %%---------------------------------------------------------------------- -%% As open/1,2, except no 'hello' message is sent. +%% Like open/1,2, but no 'hello' message is sent. + -spec only_open(Options) -> Result when - Options :: options(), - Result :: {ok,handle()} | {error,error_reason()}. + Options :: [option()], + Result :: {ok, handle()} | {error, error_reason()}. + only_open(Options) -> - open(Options,#options{type=connection_and_channel},[],false). + open(Options, #options{type = connection_and_channel}, [], false). --spec only_open(KeyOrName,ExtraOptions) -> Result when +-spec only_open(KeyOrName, ExtraOptions) -> Result when KeyOrName :: ct:key_or_name(), - ExtraOptions :: options(), - Result :: {ok,handle()} | {error,error_reason()}. + ExtraOptions :: [option()], + Result :: {ok, handle()} | {error, error_reason()}. + only_open(KeyOrName, ExtraOpts) -> open(KeyOrName, ExtraOpts, false). %%---------------------------------------------------------------------- %% Send a 'hello' message. + +%% hello/1 + -spec hello(Client) -> Result when Client :: handle(), - Result :: ok | {error,error_reason()}. + Result :: ok | {error, error_reason()}. + hello(Client) -> - hello(Client,[],?DEFAULT_TIMEOUT). + hello(Client, [], ?DEFAULT_TIMEOUT). + +%% hello/2 --spec hello(Client,Timeout) -> Result when +-spec hello(Client, Timeout) -> Result when Client :: handle(), Timeout :: timeout(), - Result :: ok | {error,error_reason()}. -hello(Client,Timeout) -> - hello(Client,[],Timeout). + Result :: ok | {error, error_reason()}. + +hello(Client, Timeout) -> + hello(Client, [], Timeout). --spec hello(Client,Options,Timeout) -> Result when +%% hello/3 + +-spec hello(Client, Options, Timeout) -> Result when Client :: handle(), Options :: [{capability, [string()]}], Timeout :: timeout(), - Result :: ok | {error,error_reason()}. -hello(Client,Options,Timeout) -> + Result :: ok | {error, error_reason()}. + +hello(Client, Options, Timeout) -> call(Client, {hello, Options, Timeout}). @@ -675,117 +731,122 @@ action(Client,Action,Timeout) -> %%---------------------------------------------------------------------- %% Send a 'create-subscription' request %% See RFC5277, NETCONF Event Notifications --spec create_subscription(Client) -> Result when - Client :: client(), - Result :: ok | {error,error_reason()}. -create_subscription(Client) -> - create_subscription(Client,?DEFAULT_STREAM,?DEFAULT_TIMEOUT). --spec create_subscription(Client, Stream | Filter | Timeout) -> Result when +%% create_subscription/2 + +-spec create_subscription(Client, Values) -> Result when Client :: client(), + Values :: #{stream => Stream, + filter => Filter, + start => StartTime, + stop => StopTime}, Stream :: stream_name(), Filter :: simple_xml() | [simple_xml()], - Timeout :: timeout(), + StartTime :: xs_datetime(), + StopTime :: xs_datetime(), + Result :: ok | {error,error_reason()}; + %% historic, no longer documented + (Client, list() | timeout()) -> Result when + Client :: client(), Result :: ok | {error,error_reason()}. -create_subscription(Client,Timeout) + +create_subscription(Client, #{} = Values) -> + create_subscription(Client, Values, ?DEFAULT_TIMEOUT); + +%% historic clauses +create_subscription(Client, Timeout) when ?is_timeout(Timeout) -> - create_subscription(Client,?DEFAULT_STREAM,Timeout); -create_subscription(Client,Stream) + create_subscription(Client, #{}, Timeout); +create_subscription(Client, Stream) when ?is_string(Stream) -> - create_subscription(Client,Stream,?DEFAULT_TIMEOUT); -create_subscription(Client,Filter) + create_subscription(Client, #{stream => Stream}); +create_subscription(Client, Filter) when ?is_filter(Filter) -> - create_subscription(Client,?DEFAULT_STREAM,Filter, - ?DEFAULT_TIMEOUT). + create_subscription(Client, #{filter => Filter}). -create_subscription(Client,Stream,Timeout) - when ?is_string(Stream) andalso - ?is_timeout(Timeout) -> - call(Client,{send_rpc_op,{create_subscription,self()}, - [Stream,undefined,undefined,undefined], - Timeout}); -create_subscription(Client,StartTime,StopTime) - when ?is_string(StartTime) andalso - ?is_string(StopTime) -> - create_subscription(Client,?DEFAULT_STREAM,StartTime,StopTime, - ?DEFAULT_TIMEOUT); -create_subscription(Client,Filter,Timeout) - when ?is_filter(Filter) andalso - ?is_timeout(Timeout) -> - create_subscription(Client,?DEFAULT_STREAM,Filter,Timeout); -create_subscription(Client,Stream,Filter) - when ?is_string(Stream) andalso - ?is_filter(Filter) -> - create_subscription(Client,Stream,Filter,?DEFAULT_TIMEOUT). - -create_subscription(Client,StartTime,StopTime,Timeout) - when ?is_string(StartTime) andalso - ?is_string(StopTime) andalso - ?is_timeout(Timeout) -> - create_subscription(Client,?DEFAULT_STREAM,StartTime,StopTime,Timeout); -create_subscription(Client,Stream,StartTime,StopTime) - when ?is_string(Stream) andalso - ?is_string(StartTime) andalso - ?is_string(StopTime) -> - create_subscription(Client,Stream,StartTime,StopTime,?DEFAULT_TIMEOUT); -create_subscription(Client,Filter,StartTime,StopTime) - when ?is_filter(Filter) andalso - ?is_string(StartTime) andalso - ?is_string(StopTime) -> - create_subscription(Client,?DEFAULT_STREAM,Filter, - StartTime,StopTime,?DEFAULT_TIMEOUT); -create_subscription(Client,Stream,Filter,Timeout) - when ?is_string(Stream) andalso - ?is_filter(Filter) andalso - ?is_timeout(Timeout) -> - call(Client,{send_rpc_op,{create_subscription,self()}, - [Stream,Filter,undefined,undefined], - Timeout}). - --spec create_subscription(Client, Stream, StartTime, StopTime, Timeout) -> - Result when +-spec create_subscription(Client, Values, Timeout) -> Result when Client :: client(), + Values :: #{stream => Stream, + filter => Filter, + start => StartTime, + stop => StopTime}, Stream :: stream_name(), + Filter :: simple_xml() | [simple_xml()], StartTime :: xs_datetime(), StopTime :: xs_datetime(), Timeout :: timeout(), Result :: ok | {error,error_reason()}; - (Client, Stream, Filter,StartTime, StopTime) -> - Result when + %% historic, no longer documented + (Client, list(), list() | timeout()) -> Result when Client :: client(), - Stream :: stream_name(), - Filter :: simple_xml() | [simple_xml()], - StartTime :: xs_datetime(), - StopTime :: xs_datetime(), Result :: ok | {error,error_reason()}. -create_subscription(Client,Stream,StartTime,StopTime,Timeout) - when ?is_string(Stream) andalso - ?is_string(StartTime) andalso - ?is_string(StopTime) andalso + +create_subscription(Client, #{} = Values, Timeout) -> + Keys = [{stream, ?DEFAULT_STREAM}, + {filter, undefined}, + {start, undefined}, + {stop, undefined}], + call(Client, {send_rpc_op, {create_subscription, self()}, + [maps:get(K, Values, D) || {K,D} <- Keys], + Timeout}); + +%% historic clauses, arity 3 +create_subscription(Client, Stream, Timeout) + when ?is_string(Stream), ?is_timeout(Timeout) -> + create_subscription(Client, #{stream => Stream}, Timeout); +create_subscription(Client, StartTime, StopTime) + when ?is_string(StartTime), ?is_string(StopTime) -> + create_subscription(Client, #{start => StartTime, stop => StopTime}); +create_subscription(Client, Filter, Timeout) + when ?is_filter(Filter), ?is_timeout(Timeout) -> + create_subscription(Client, #{filter => Filter}, Timeout); +create_subscription(Client, Stream, Filter) + when ?is_string(Stream), ?is_filter(Filter) -> + create_subscription(Client, #{stream => Stream, filter => Filter}). + +%% historic clauses, arity 1,4-5 +create_subscription(Client) -> + create_subscription(Client, #{}). +create_subscription(Client, StartTime, StopTime, Timeout) + when ?is_string(StartTime), ?is_string(StopTime), ?is_timeout(Timeout) -> + Values = #{start => StartTime, + stop => StopTime}, + create_subscription(Client, Values, Timeout); +create_subscription(Client, Stream, StartTime, StopTime) + when ?is_string(Stream), ?is_string(StartTime), ?is_string(StopTime) -> + create_subscription(Client, #{stream => Stream, + start => StartTime, + stop => StopTime}); +create_subscription(Client, Filter, StartTime, StopTime) + when ?is_filter(Filter), ?is_string(StartTime), ?is_string(StopTime) -> + create_subscription(Client, #{filter => Filter, + start => StartTime, + stop => StopTime}); +create_subscription(Client, Stream, Filter, Timeout) + when ?is_string(Stream), ?is_filter(Filter), ?is_timeout(Timeout) -> + Values = #{stream => Stream, + filter => Filter}, + create_subscription(Client, Values, Timeout). +create_subscription(Client, Stream, StartTime, StopTime, Timeout) + when ?is_string(Stream), ?is_string(StartTime), ?is_string(StopTime), ?is_timeout(Timeout) -> - call(Client,{send_rpc_op,{create_subscription,self()}, - [Stream,undefined,StartTime,StopTime], - Timeout}); -create_subscription(Client,Stream,Filter,StartTime,StopTime) - when ?is_string(Stream) andalso - ?is_filter(Filter) andalso - ?is_string(StartTime) andalso + Values = #{stream => Stream, + start => StartTime, + stop => StopTime}, + create_subscription(Client, Values, Timeout); +create_subscription(Client, Stream, Filter, StartTime, StopTime) + when ?is_string(Stream), ?is_filter(Filter), ?is_string(StartTime), ?is_string(StopTime) -> - create_subscription(Client,Stream,Filter,StartTime,StopTime,?DEFAULT_TIMEOUT). - --spec create_subscription(Client, Stream, Filter,StartTime, StopTime, Timeout) -> - Result when - Client :: client(), - Stream :: stream_name(), - Filter :: simple_xml() | [simple_xml()], - StartTime :: xs_datetime(), - StopTime :: xs_datetime(), - Timeout :: timeout(), - Result :: ok | {error,error_reason()}. -create_subscription(Client,Stream,Filter,StartTime,StopTime,Timeout) -> - call(Client,{send_rpc_op,{create_subscription, self()}, - [Stream,Filter,StartTime,StopTime], - Timeout}). + create_subscription(Client, #{stream => Stream, + filter => Filter, + start => StartTime, + stop => StopTime}). +create_subscription(Client, Stream, Filter, StartTime, StopTime, Timeout) -> + Values = #{stream => Stream, + filter => Filter, + start => StartTime, + stop => StopTime}, + create_subscription(Client, Values, Timeout). %%---------------------------------------------------------------------- %% Send a request to get the given event streams @@ -859,6 +920,8 @@ kill_session(Client, SessionId, Timeout) -> %% Callback functions %%---------------------------------------------------------------------- +%% init/3 + init(_KeyOrName,{CM,{Host,Port}},Options) -> case ssh_channel(#connection{reference=CM,host=Host,port=Port},Options) of {ok,Connection} -> @@ -883,29 +946,32 @@ init(_KeyOrName,{_Host,_Port},Options) -> {error,Reason} end. +%% terminate/2 terminate(_, #state{connection=Connection}) -> ssh_close(Connection), ok. -handle_msg({hello, Options, Timeout}, From, - #state{connection=Connection,hello_status=HelloStatus} = State) -> +%% handle_msg/3 + +%% Send hello and return to the caller only after reception of the +%% server's hello. +handle_msg({hello, Options, Timeout}, + From, + #state{connection = Connection, + hello_status = HelloStatus} + = State) -> case do_send(Connection, client_hello(Options)) of - ok -> - case HelloStatus of - undefined -> - {Ref,TRef} = set_request_timer(Timeout), - {noreply, State#state{hello_status=#pending{tref=TRef, - ref=Ref, - caller=From}}}; - received -> - {reply, ok, State#state{hello_status=done}}; - {error,Reason} -> - {stop, {error,Reason}, State} - end; - Error -> + ok when HelloStatus == undefined -> %% server hello not yet received + TRef = set_request_timer(Timeout, hello), + {noreply, State#state{hello_status = #pending{tref = TRef, + caller = From}}}; + ok -> %% or yes: negotiate version + handle_capx(State); + Error -> {stop, Error, State} end; + handle_msg(get_ssh_connection, _From, #state{connection=Connection}=State) -> Reply = case Connection#connection.reference of @@ -914,29 +980,40 @@ handle_msg(get_ssh_connection, _From, #state{connection=Connection}=State) -> Connection#connection.port}}} end, {reply, Reply, State}; -handle_msg(_, _From, #state{session_id=undefined} = State) -> - %% Hello is not yet excanged - this shall never happen - {reply,{error,waiting_for_hello},State}; + +%% Request before server hello. Possible with only_open, since a +%% handle is then returned without waiting for the server. +handle_msg(_, _From, #state{session_id = undefined} = State) -> + {reply, {error, waiting_for_hello}, State}; + handle_msg(get_capabilities, _From, #state{capabilities = Caps} = State) -> {reply, Caps, State}; + handle_msg(get_session_id, _From, #state{session_id = Id} = State) -> {reply, Id, State}; -handle_msg({send, Timeout, SimpleXml}, From, - #state{connection=Connection,pending=Pending} = State) -> + +handle_msg({send, Timeout, SimpleXml}, + From, + #state{connection = Connection, + pending = Pending} + = State) -> case do_send(Connection, SimpleXml) of - ok -> - {Ref,TRef} = set_request_timer(Timeout), - {noreply, State#state{pending=[#pending{tref=TRef, - ref=Ref, - caller=From} | Pending]}}; - Error -> - {reply, Error, State} + ok -> + TRef = set_request_timer(Timeout, send), + {noreply, State#state{pending = [#pending{tref = TRef, + caller = From} + | Pending]}}; + Error -> + {reply, Error, State} end; + handle_msg({send_rpc, SimpleXml, Timeout}, From, State) -> do_send_rpc(undefined, SimpleXml, Timeout, From, State); + handle_msg({send_rpc_op, Op, Data, Timeout}, From, State) -> SimpleXml = encode_rpc_operation(Op,Data), do_send_rpc(Op, SimpleXml, Timeout, From, State); + handle_msg({get_event_streams=Op,Streams,Timeout}, From, State) -> Filter = {netconf,?NETMOD_NOTIF_NAMESPACE_ATTR, [{streams,[{stream,[{name,[Name]}]} || Name <- Streams]}]}, @@ -945,7 +1022,9 @@ handle_msg({get_event_streams=Op,Streams,Timeout}, From, State) -> handle_msg({ssh_cm, CM, {data, Ch, _Type, Data}}, State) -> ssh_connection:adjust_window(CM,Ch,size(Data)), + log(State#state.connection, recv, Data), handle_data(Data, State); + handle_msg({ssh_cm, _CM, _SshCloseMsg}, State) -> %% _SshCloseMsg can probably be one of %% {eof,Ch} @@ -962,21 +1041,29 @@ handle_msg({ssh_cm, _CM, _SshCloseMsg}, State) -> %%! connection - due to terminate/2 {stop, State}; -handle_msg({Ref,timeout}, - #state{hello_status=#pending{ref=Ref,caller=Caller}} = State) -> - ct_gen_conn:return(Caller,{error,{hello_session_failed,timeout}}), - {stop,State#state{hello_status={error,timeout}}}; -handle_msg({Ref,timeout},#state{pending=Pending} = State) -> - {value,#pending{op=Op,caller=Caller},Pending1} = - lists:keytake(Ref,#pending.ref,Pending), - ct_gen_conn:return(Caller,{error,timeout}), - R = case Op of - close_session -> stop; - _ -> noreply - end, - %% Halfhearted try to get in correct state, this matches - %% the implementation before this patch - {R,State#state{pending=Pending1, no_end_tag_buff= <<>>, buff= <<>>}}. + +handle_msg({timeout, TRef, hello}, + #state{hello_status = #pending{tref = TRef, + caller = From}} + = State) -> + ct_gen_conn:return(From, {error, {hello_session_failed, timeout}}), + {stop, State#state{hello_status = {error,timeout}}}; + +handle_msg({timeout, TRef, Op}, #state{pending = Pending} = State) -> + case lists:keytake(TRef, #pending.tref, Pending) of + {value, #pending{caller = From}, Rest} -> + ct_gen_conn:return(From, {error, timeout}), + %% Discard received bytes in hope that the server has sent + %% an incomplete message. Otherwise this is doomed to + %% leave the connection in an unusable state. + {if Op == close_session -> stop; true -> noreply end, + State#state{pending = Rest, + buf = is_binary(State#state.buf)}}; + false -> + {noreply, State} + end. + +%% close/1 %% Called by ct_util_server to close registered connections before terminate. close(Client) -> @@ -1048,63 +1135,163 @@ get_handle(Client) -> Error end. -check_options(OptList,Options) -> - check_options(OptList,undefined,undefined,Options). +%% make_options/2 -check_options([], undefined, _Port, _Options) -> - {error, no_host_address}; -check_options([], _Host, undefined, _Options) -> - {error, no_port}; -check_options([], Host, Port, Options) -> - {Host,Port,Options}; -check_options([{ssh, Host}|T], _, Port, Options) -> - check_options(T, Host, Port, Options#options{host=Host}); -check_options([{port,Port}|T], Host, _, Options) -> - check_options(T, Host, Port, Options#options{port=Port}); -check_options([{timeout, Timeout}|T], Host, Port, Options) - when is_integer(Timeout); Timeout==infinity -> - check_options(T, Host, Port, Options#options{timeout = Timeout}); -check_options([{timeout, _} = Opt|_T], _Host, _Port, _Options) -> - {error, {invalid_option, Opt}}; -check_options([Opt|T], Host, Port, #options{ssh=SshOpts}=Options) -> - %% Option verified by ssh - check_options(T, Host, Port, Options#options{ssh=[Opt|SshOpts]}). - -check_session_options([],Options) -> - {ok,Options}; -check_session_options([{timeout, Timeout}|T], Options) - when is_integer(Timeout); Timeout==infinity -> - check_session_options(T, Options#options{timeout = Timeout}); -check_session_options([Opt|_T], _Options) -> - {error, {invalid_option, Opt}}. +make_options(Opts, Rec) -> + make_options(Opts, Rec#options{port = undefined}, fun opt/2). + +opt({T, Host}, Rec) + when T == ssh; + T == host -> + Rec#options{host = Host}; + +opt({port, Port}, Rec) -> + Rec#options{port = Port}; + +opt({timeout, Tmo}, Rec) + when is_integer(Tmo); + Tmo == infinity -> + Rec#options{timeout = Tmo}; + +opt({timeout, _} = T, _) -> + throw(T); + +opt({capability, _}, Rec) -> + Rec; + +opt(Opt, #options{ssh = Opts} = Rec) -> %% option verified by ssh + Rec#options{ssh = [Opt | Opts]}. + +%% make_session_options/2 + +make_session_options(Opts, Rec) -> + make_options(Opts, Rec, fun session_opt/2). + +session_opt({capability, _}, Rec) -> + Rec; + +session_opt({timeout, Tmo}, Rec) + when is_integer(Tmo); + Tmo == infinity -> + Rec#options{timeout = Tmo}; +session_opt(T, _Rec) -> + throw(T). + +%% make_options/3 + +make_options(Opts, Rec, F) -> + try + #options{} = lists:foldl(F, Rec, Opts) + catch + T -> + {error, {invalid_option, T}} + end. %%%----------------------------------------------------------------- -set_request_timer(infinity) -> - {undefined,undefined}; -set_request_timer(T) -> - Ref = make_ref(), - {ok,TRef} = timer:send_after(T,{Ref,timeout}), - {Ref,TRef}. + +set_request_timer(infinity, _) -> + false; + +set_request_timer(Tmo, Op) -> + erlang:start_timer(Tmo, self(), Op). %%%----------------------------------------------------------------- -cancel_request_timer(undefined,undefined) -> + +cancel_request_timer(false) -> ok; -cancel_request_timer(Ref,TRef) -> - _ = timer:cancel(TRef), - receive {Ref,timeout} -> ok - after 0 -> ok - end. + +cancel_request_timer(TRef) -> + erlang:cancel_timer(TRef). %%%----------------------------------------------------------------- -client_hello(Options) when is_list(Options) -> - UserCaps = [{capability, UserCap} || - {capability, UserCap} <- Options, - is_list(hd(UserCap))], - {hello, ?NETCONF_NAMESPACE_ATTR, - [{capabilities, - [{capability,[?NETCONF_BASE_CAP++?NETCONF_BASE_CAP_VSN]}| - UserCaps]}]}. + +%% client_hello/1 +%% +%% Prepend the 1.0 base capability only if none is specified by the +%% user. Store the versions in the process dictionary until they're +%% examined upon reception of server capabilities in handle_capx/1. + +client_hello(Opts) + when is_list(Opts) -> + UserCaps = [{T, cap(lists:flatten(Cs))} || {capability = T, Cs} <- Opts], + Vsns = versions(UserCaps), + put(?KEY(protocol_vsn), Vsns), + {hello, + ?NETCONF_NAMESPACE_ATTR, + [{capabilities, [{capability, [?NETCONF_BASE_CAP, ?NETCONF_BASE_CAP_VSN]} + || [] == Vsns] + ++ UserCaps}]}. + +%% cap/1 +%% +%% Let NETCONF capabilities be specified in the shorthand documented in +%% RFC 6241. + +%% This shorthand is documented in RFC 6241 10.4 NETCONF Capabilities +%% URNS, but not in 8 Capabilities. +cap(":base:" ++ _ = Str) -> + ["urn:ietf:params:netconf", Str]; + +cap([$:|_] = Str) -> + ["urn:ietf:params:netconf:capability", Str]; + +cap(Str) -> + [Str]. + +%% versions/1 +%% +%% Extract base protocol versions from capability options. + +versions(Opts) -> + [V || {capability, L} <- Opts, + S <- L, + ?NETCONF_BASE_CAP ++ X <- [lists:flatten(S)], + V <- [lists:takewhile(fun(C) -> C /= $? end, X)]]. + +%% handle_capx/1 +%% +%% Ignore parameters as RFC 6241 (NETCONF 1.1) requires in 8.1 +%% Capabilities Exchange. Be overly lenient with whitespace since RFC +%% 6241 gives examples with significant trailing whitespace. + +handle_capx(#state{hello_status = received, capabilities = Caps} = S) -> + Remote = [V || ?NETCONF_BASE_CAP ++ X <- Caps, + [V|_] <- [string:lexemes(X, "? \t\r\n")]], + Local = erase(?KEY(protocol_vsn)), + case protocol_vsn(Local, Remote) of + false when Remote == [] -> + Reason = {incorrect_hello, no_base_capability_found}, + {stop, {error, Reason}, S}; + false -> + Reason = {incompatible_base_capability_vsn, lists:min(Remote)}, + {stop, {error, Reason}, S}; + Vsn -> + put(?KEY(chunk), Vsn /= "1.0"), + {reply, ok, rebuf(Vsn, S#state{hello_status = Vsn})} + end; + +handle_capx(#state{hello_status = {error, _} = No} = S) -> + {stop, No, S}. + +%% rebuf/2 +%% +%% Turn the message buffer into a list for 1.1 chunking if the +%% negotiated protocol version is > 1.0. + +rebuf("1.0", S) -> + S; + +rebuf(_, #state{buf = Bin} = S) -> + S#state{buf = [Bin, 3]}. + +%% protocol_vsn/2 + +protocol_vsn([], Vsns) -> + protocol_vsn(["1.0"], Vsns); + +protocol_vsn(Local, Remote) -> + lists:max([false | [V || V <- Remote, lists:member(V, Local)]]). %%%----------------------------------------------------------------- @@ -1150,111 +1337,130 @@ maybe_element(Tag,Value) -> %%%----------------------------------------------------------------- %%% Send XML data to server -do_send_rpc(PendingOp,SimpleXml,Timeout,Caller, - #state{connection=Connection,msg_id=MsgId,pending=Pending} = State) -> - case do_send_rpc(Connection, MsgId, SimpleXml) of - ok -> - {Ref,TRef} = set_request_timer(Timeout), - {noreply, State#state{msg_id=MsgId+1, - pending=[#pending{tref=TRef, - ref=Ref, - msg_id=MsgId, - op=PendingOp, - caller=Caller} | Pending]}}; - Error -> - {reply, Error, State#state{msg_id=MsgId+1}} +do_send_rpc(Op, SimpleXml, Timeout, Caller, #state{connection = Connection, + msg_id = MsgId, + pending = Pending} + = State) -> + Msg = {rpc, + [{'message-id', MsgId} | ?NETCONF_NAMESPACE_ATTR], + [SimpleXml]}, + Next = MsgId + 1, + case do_send(Connection, Msg) of + ok -> + TRef = set_request_timer(Timeout, Op), + Rec = #pending{tref = TRef, + msg_id = MsgId, + op = Op, + caller = Caller}, + {noreply, State#state{msg_id = Next, + pending = [Rec | Pending]}}; + Error -> + {reply, Error, State#state{msg_id = Next}} end. -do_send_rpc(Connection, MsgId, SimpleXml) -> - do_send(Connection, - {rpc, - [{'message-id',MsgId} | ?NETCONF_NAMESPACE_ATTR], - [SimpleXml]}). +do_send(Connection, Simple) -> + ssh_send(Connection, frame(to_xml(Simple))). -do_send(Connection, SimpleXml) -> - Xml=to_xml_doc(SimpleXml), - ssh_send(Connection, Xml). - -to_xml_doc(Simple) -> +to_xml(Simple) -> Prolog = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>", - Xml = unicode:characters_to_binary( - xmerl:export_simple([Simple], - xmerl_xml, - [#xmlAttribute{name=prolog, - value=Prolog}])), - <<Xml/binary,?END_TAG/binary>>. + Chars = xmerl:export_simple([Simple], + xmerl_xml, + [#xmlAttribute{name = prolog, + value = Prolog}]), + unicode:characters_to_binary(Chars). + +%% frame/1 + +frame(Bin) -> + case get(?KEY(chunk)) of + true -> %% 1.1 chunking + [chunk(Bin) | "\n##\n"]; + _ -> %% 1.0 framing + [Bin | ?END_TAG] + end. + +%% chunk/1 +%% +%% Chunk randomly to exercise the server. + +chunk(<<>>) -> + []; + +chunk(Bin) -> + Sz = min(rand:uniform(1024), size(Bin)), + <<B:Sz/binary, Rest/binary>> = Bin, + ["\n#", integer_to_list(Sz), $\n, B | chunk(Rest)]. %%%----------------------------------------------------------------- %%% Parse and handle received XML data -%%% Two buffers are used: -%%% * 'no_end_tag_buff' contains data that is checked and does not -%%% contain any (part of an) end tag. -%%% * 'buff' contains all other saved data - it may or may not -%%% include (a part of) an end tag. -%%% The reason for this is to avoid running binary:split/3 multiple -%%% times on the same data when it does not contain an end tag. This -%%% can be a considerable optimation in the case when a lot of data is -%%% received (e.g. when fetching all data from a node) and the data is -%%% sent in multiple ssh packages. -handle_data(NewData,#state{connection=Connection} = State0) -> - log(Connection,recv,NewData), - NoEndTag0 = State0#state.no_end_tag_buff, - Buff0 = State0#state.buff, - Data = <<Buff0/binary, NewData/binary>>, - case binary:split(Data,?END_TAG,[]) of - [_NoEndTagFound] -> - NoEndTagSize = case byte_size(Data) of - Sz when Sz<5 -> 0; - Sz -> Sz-5 - end, - <<NoEndTag1:NoEndTagSize/binary,Buff/binary>> = Data, - NoEndTag = <<NoEndTag0/binary,NoEndTag1/binary>>, - {noreply, State0#state{no_end_tag_buff=NoEndTag, buff=Buff}}; - [FirstMsg0,Buff1] -> - FirstMsg = remove_initial_nl(<<NoEndTag0/binary,FirstMsg0/binary>>), - SaxArgs = [{event_fun,fun sax_event/3}, {event_state,[]}], - case xmerl_sax_parser:stream(FirstMsg, SaxArgs) of - {ok, Simple, _Thrash} -> - case decode(Simple, State0#state{no_end_tag_buff= <<>>, - buff=Buff1}) of - {noreply, #state{buff=Buff} = State} when Buff =/= <<>> -> - %% Recurse if we have more data in buffer - handle_data(<<>>, State); - Other -> - Other - end; - {fatal_error,_Loc,Reason,_EndTags,_EventState} -> - ?error(Connection#connection.name, - [{parse_error,Reason}, - {buffer, Buff0}, - {new_data,NewData}]), - handle_error(Reason, State0#state{no_end_tag_buff= <<>>, - buff= <<>>}) - end + +handle_data(Bin, #state{buf = Head} = S) -> + case recv(Bin, Head) of + {error, Reason} -> + Conn = S#state.connection, + ?error(Conn#connection.name, [{receive_error, Reason}, + {buffer, Head}, + {bytes, Bin}]), + {stop, S}; + {Bytes, Rest} -> + handle_more(Rest, handle_xml(Bytes, S)); + Buf -> + {noreply, S#state{buf = Buf}} end. +%% handle_more/2 + +handle_more(_, {stop, _} = No) -> + No; + +handle_more(Bin, {noreply, State}) -> + handle_data(Bin, State#state{buf = true == get(?KEY(chunk))}). + +%% handle_xml/2 + +handle_xml(Bytes, State) -> + case parse(Bytes) of + {ok, Simple, _Rest} -> %% ignore trailing bytes + decode(Simple, State); + {fatal_error,_Loc,Reason,_EndTags,_EventState} -> + Conn = State#state.connection, + ?error(Conn#connection.name, [{parse_error, Reason}, + {message, Bytes}]), + {noreply, handle_error(Reason, State)} + end. + +%% parse/1 + +parse(Bytes) -> + xmerl_sax_parser:stream(<<>>, [{event_fun, fun sax_event/3}, + {event_state, []}, + {continuation_fun, fun cont/1}, + {continuation_state, Bytes}]). + +%% cont/1 -%% xml does not accept a leading nl and some netconf server add a nl after -%% each ?END_TAG, ignore them -remove_initial_nl(<<"\n", Data/binary>>) -> - remove_initial_nl(Data); -remove_initial_nl(Data) -> - Data. - -handle_error(Reason, State) -> - Pending1 = case State#state.pending of - [] -> []; - Pending -> - %% Assuming the first request gets the - %% first answer - P=#pending{tref=TRef,ref=Ref,caller=Caller} = - lists:last(Pending), - cancel_request_timer(Ref,TRef), - Reason1 = {failed_to_parse_received_data,Reason}, - ct_gen_conn:return(Caller,{error,Reason1}), - lists:delete(P,Pending) - end, - {noreply, State#state{pending=Pending1}}. +cont([] = No) -> + {<<>>, No}; + +cont([Bin | Rest]) -> + {Bin, Rest}; + +cont(Bin) -> + {Bin, <<>>}. + +%% handle_error/2 + +handle_error(_Reason, #state{pending = []} = State) -> + State; + +handle_error(Reason, #state{pending = Pending} = State) -> + %% Assuming the first request gets the first answer. + Rec = #pending{tref = TRef, + caller = Caller} + = lists:last(Pending), + cancel_request_timer(TRef), + ct_gen_conn:return(Caller,{error, {failed_to_parse_received_data, Reason}}), + State#state{pending = lists:delete(Rec, Pending)}. %% Event function for the sax parser. It builds a simple XML structure. %% Care is taken to keep namespace attributes and prefixes as in the original XML. @@ -1305,136 +1511,180 @@ parse_attrs([]) -> %%%----------------------------------------------------------------- -%%% Decoding of parsed XML data -decode({Tag,Attrs,_}=E, #state{connection=Connection,pending=Pending}=State) -> - ConnName = Connection#connection.name, - case get_local_name_atom(Tag) of - 'rpc-reply' -> - case get_msg_id(Attrs) of - undefined -> - case Pending of - [#pending{msg_id=MsgId}] -> - ?error(ConnName,[{warning,rpc_reply_missing_msg_id}, - {assuming,MsgId}]), - decode_rpc_reply(MsgId,E,State); - _ -> - ?error(ConnName,[{error,rpc_reply_missing_msg_id}]), - {noreply,State} - end; - MsgId -> - decode_rpc_reply(MsgId,E,State) - end; - hello -> - case State#state.hello_status of - undefined -> - case decode_hello(E) of - {ok,SessionId,Capabilities} -> - {noreply,State#state{session_id = SessionId, - capabilities = Capabilities, - hello_status = received}}; - {error,Reason} -> - {noreply,State#state{hello_status = {error,Reason}}} - end; - #pending{tref=TRef,ref=Ref,caller=Caller} -> - cancel_request_timer(Ref,TRef), - case decode_hello(E) of - {ok,SessionId,Capabilities} -> - ct_gen_conn:return(Caller,ok), - {noreply,State#state{session_id = SessionId, - capabilities = Capabilities, - hello_status = done}}; - {error,Reason} -> - ct_gen_conn:return(Caller,{error,Reason}), - {stop,State#state{hello_status={error,Reason}}} - end; - Other -> - ?error(ConnName,[{got_unexpected_hello,E}, - {hello_status,Other}]), - {noreply,State} - end; - notification -> - EventReceiver = State#state.event_receiver, - EventReceiver ! E, - {noreply,State}; - Other -> - %% Result of send/2, when not sending an rpc request - or - %% if netconf server sends noise. Can handle this only if - %% there is just one pending that matches (i.e. has - %% undefined msg_id and op) - case [P || P = #pending{msg_id=undefined,op=undefined} <- Pending] of - [#pending{tref=TRef,ref=Ref,caller=Caller}] -> - cancel_request_timer(Ref,TRef), - ct_gen_conn:return(Caller,E), - {noreply,State#state{pending=[]}}; - _ -> - ?error(ConnName,[{got_unexpected_msg,Other}, - {expecting,Pending}]), - {noreply,State} - end +%% decode/2 +%% +%% Decode parsed (incoming) XML. + +decode({Tag, _, _} = E, #state{} = State) -> + case decode(get_local_name_atom(Tag), E, State) of + #state{} = S -> + {noreply, S}; + {stop, #state{}} = T -> + T + end. + +%% decode/3 + +decode('rpc-reply', {_, Attrs, _} = E, State) -> + decode_rpc_reply(get_msg_id(Attrs), E, State); + +%% Incoming hello, outgoing not yet sent. +decode(hello, E, #state{hello_status = undefined} = State) -> + case decode_hello(E) of + {ok, SessionId, Capabilities} -> + State#state{session_id = SessionId, + capabilities = Capabilities, + hello_status = received}; + {error, _Reason} = No -> + State#state{hello_status = No} + end; + +%% Incoming hello, outgoing already sent: negotiate protocol version. +decode(hello, E, #state{hello_status = #pending{tref = TRef, + caller = From}} + = State) -> + cancel_request_timer(TRef), + case decode_hello(E) of + {ok, SessionId, Capabilities} -> + reply(From, handle_capx(State#state{session_id = SessionId, + capabilities = Capabilities, + hello_status = received})); + {error, _Reason} = No -> + ct_gen_conn:return(From, No), + {stop, State#state{hello_status = No}} + end; + +%% Duplicate hello: ignore. +decode(hello, E, #state{hello_status = Other} = State) -> + ConnName = (State#state.connection)#connection.name, + ?error(ConnName, [{got_unexpected_hello, E}, + {hello_status, Other}]), + State; + +decode(notification, E, State) -> + State#state.event_receiver ! E, + State; + +decode(Other, E, State) -> + decode_send({got_unexpected_msg, Other}, E, State). + +%% reply/2 +%% +%% Explicitly send a reply that can't be returned. + +reply(From, {T, Res, State}) -> + ct_gen_conn:return(From, Res), + case T of + reply -> + State; + stop -> + {T, State} end. +%% get_msg_id/1 + get_msg_id(Attrs) -> - case lists:keyfind('message-id',1,Attrs) of - {_,Str} -> - list_to_integer(Str); - false -> - undefined + case find('message-id', Attrs) of + {_,Str} -> + list_to_integer(Str); + false -> + undefined end. -decode_rpc_reply(MsgId,{_,Attrs,Content0}=E,#state{pending=Pending} = State) -> - case lists:keytake(MsgId,#pending.msg_id,Pending) of - {value, #pending{tref=TRef,ref=Ref,op=Op,caller=Caller}, Pending1} -> - cancel_request_timer(Ref,TRef), - Content = forward_xmlns_attr(Attrs,Content0), - {CallerReply,{ServerReply,State2}} = - do_decode_rpc_reply(Op,Content,State#state{pending=Pending1}), - ct_gen_conn:return(Caller,CallerReply), - {ServerReply,State2}; - false -> - %% Result of send/2, when receiving a correct - %% rpc-reply. Can handle this only if there is just one - %% pending that matches (i.e. has undefined msg_id and op) - case [P || P = #pending{msg_id=undefined,op=undefined} <- Pending] of - [#pending{tref=TRef, - ref=Ref, - msg_id=undefined, - op=undefined, - caller=Caller}] -> - cancel_request_timer(Ref,TRef), - ct_gen_conn:return(Caller,E), - {noreply,State#state{pending=[]}}; - _ -> - ConnName = (State#state.connection)#connection.name, - ?error(ConnName,[{got_unexpected_msg_id,MsgId}, - {expecting,Pending}]), - {noreply,State} - end +%% recode_rpc_reply/3 + +decode_rpc_reply(undefined, E, #state{pending = [#pending{msg_id = MsgId}]} + = State) + when MsgId /= undefined -> + ConnName = (State#state.connection)#connection.name, + ?error(ConnName, [{warning, rpc_reply_missing_msg_id}, + {assuming, MsgId}]), + decode_rpc_reply(MsgId, E, State); + +decode_rpc_reply(undefined, _, State) -> + ConnName = (State#state.connection)#connection.name, + ?error(ConnName, [{error, rpc_reply_missing_msg_id}]), + State; + +decode_rpc_reply(MsgId, + {_, Attrs, Content0} + = E, + #state{pending = Pending} + = State) -> + case lists:keytake(MsgId, #pending.msg_id, Pending) of + {value, Rec, Rest} -> + #pending{tref = TRef, op = Op, caller = From} + = Rec, + cancel_request_timer(TRef), + Content = forward_xmlns_attr(Attrs, Content0), + {Reply, T} = do_decode_rpc_reply(Op, + Content, + State#state{pending = Rest}), + ct_gen_conn:return(From, Reply), + T; + false -> %% not a send_rcp or server has sent wrong id + decode_send({got_unexpected_msg_id, MsgId}, E, State) + end. + +%% decode_send/2 +%% +%% Result of send/2,3. Only handle one at a time there since all +%% pendings have msg_id = undefined. + +decode_send(ErrorT, Elem, #state{pending = Pending} = State) -> + case [P || #pending{msg_id = undefined} = P <- Pending] of + [Rec] -> + #pending{tref = TRef, + caller = From} + = Rec, + cancel_request_timer(TRef), + ct_gen_conn:return(From, Elem), + State#state{pending = lists:delete(Rec, Pending)}; + _ -> + Conn = State#state.connection, + ?error(Conn#connection.name, [ErrorT, {expecting, Pending}]), + State end. -do_decode_rpc_reply(Op,Result,State) - when Op==lock; Op==unlock; Op==edit_config; Op==delete_config; - Op==copy_config; Op==kill_session -> - {decode_ok(Result),{noreply,State}}; -do_decode_rpc_reply(Op,Result,State) - when Op==get; Op==get_config; Op==action -> - {decode_data(Result),{noreply,State}}; -do_decode_rpc_reply(close_session,Result,State) -> +%% do_decode_rpc_reply/3 + +do_decode_rpc_reply(Op, Result, State) + when Op == lock; + Op == unlock; + Op == edit_config; + Op == delete_config; + Op == copy_config; + Op == kill_session -> + {decode_ok(Result), State}; + +do_decode_rpc_reply(Op, Result, State) + when Op == get; + Op == get_config; + Op == action -> + {decode_data(Result), State}; + +do_decode_rpc_reply(close_session, Result, State) -> case decode_ok(Result) of - ok -> {ok,{stop,State}}; - Other -> {Other,{noreply,State}} + ok -> + {ok, {stop, State}}; + Other -> + {Other, State} end; -do_decode_rpc_reply({create_subscription,Caller},Result,State) -> + +do_decode_rpc_reply({create_subscription, From}, Result, State) -> case decode_ok(Result) of - ok -> - {ok,{noreply,State#state{event_receiver=Caller}}}; - Other -> - {Other,{noreply,State}} + ok -> + {ok, State#state{event_receiver = From}}; + Other -> + {Other, State} end; -do_decode_rpc_reply(get_event_streams,Result,State) -> - {decode_streams(decode_data(Result)),{noreply,State}}; -do_decode_rpc_reply(undefined,Result,State) -> - {Result,{noreply,State}}. + +do_decode_rpc_reply(get_event_streams, Result, State) -> + {decode_streams(decode_data(Result)), State}; + +do_decode_rpc_reply(undefined, Result, State) -> + {Result, State}. @@ -1454,7 +1704,7 @@ decode_data([{Tag,Attrs,Content}]) -> case get_local_name_atom(Tag) of ok -> %% when action has return type void - ok; + ok; data -> %% Since content of data has nothing from the netconf %% namespace, we remove the parent's xmlns attribute here @@ -1525,41 +1775,43 @@ get_all_xmlns_attrs([{Key,_}=Attr|Attrs],XmlnsAttrs) -> get_all_xmlns_attrs([],XmlnsAttrs) -> XmlnsAttrs. - %% Decode server hello to pick out session id and capabilities -decode_hello({hello,_Attrs,Hello}) -> - case lists:keyfind('session-id',1,Hello) of - {'session-id',_,[SessionId]} -> - case lists:keyfind(capabilities,1,Hello) of - {capabilities,_,Capabilities} -> - case decode_caps(Capabilities,[],false) of - {ok,Caps} -> - {ok,list_to_integer(SessionId),Caps}; - Error -> - Error - end; - false -> - {error,{incorrect_hello,capabilities_not_found}} - end; - false -> - {error,{incorrect_hello,no_session_id_found}} +decode_hello({hello, _Attrs, Hello}) -> + U = make_ref(), + try + [{'session-id', _, [SessionId]}, _ | _] + = [find('session-id', Hello), no_session_id_found | U], + [{ok, Id}, _ | _] + = [catch {ok, list_to_integer(SessionId)}, invalid_session_id | U], + [true, _ | _] + = [0 < Id, invalid_session_id | U], + [{capabilities, _, Capabilities}, _ | _] + = [find(capabilities, Hello), capabilities_not_found | U], + [{ok, Caps}, _ | _] + = [decode_caps(Capabilities, [], false), false | U], + {ok, Id, Caps} + catch + error: {badmatch, [Error, false | U]} -> + Error; + error: {badmatch, [_, Reason | U]} -> + {error, {incorrect_hello, Reason}} end. -decode_caps([{capability,[],[?NETCONF_BASE_CAP++Vsn=Cap]} |Caps], Acc, _) -> - case Vsn of - ?NETCONF_BASE_CAP_VSN -> - decode_caps(Caps, [Cap|Acc], true); - _ -> - {error,{incompatible_base_capability_vsn,Vsn}} - end; -decode_caps([{capability,[],[Cap]}|Caps],Acc,Base) -> - decode_caps(Caps,[Cap|Acc],Base); -decode_caps([H|_T],_,_) -> - {error,{unexpected_capability_element,H}}; -decode_caps([],_,false) -> - {error,{incorrect_hello,no_base_capability_found}}; -decode_caps([],Acc,true) -> - {ok,lists:reverse(Acc)}. +find(Key, List) -> + lists:keyfind(Key, 1, List). + +decode_caps([{capability, [], [?NETCONF_BASE_CAP ++ _ = Cap]} | Caps], + Acc, + _) -> + decode_caps(Caps, [Cap|Acc], true); +decode_caps([{capability, [], [Cap]} | Caps], Acc, Base) -> + decode_caps(Caps, [Cap|Acc], Base); +decode_caps([H|_], _, _) -> + {error, {unexpected_capability_element, H}}; +decode_caps([], _, false) -> + {error, {incorrect_hello, no_base_capability_found}}; +decode_caps([], Acc, true) -> + {ok, lists:reverse(Acc)}. %% Return a list of {Name,Data}, where data is a {Tag,Value} list for each stream @@ -1570,7 +1822,7 @@ decode_streams({ok,[{netconf,_,Streams}]}) -> decode_streams([{streams,_,Streams}]) -> decode_streams(Streams); decode_streams([{stream,_,Stream} | Streams]) -> - {name,_,[Name]} = lists:keyfind(name,1,Stream), + {name,_,[Name]} = find(name, Stream), [{Name,[{Tag,Value} || {Tag,_,[Value]} <- Stream, Tag /= name]} | decode_streams(Streams)]; decode_streams([]) -> @@ -1814,6 +2066,190 @@ ssh_close(Connection=#connection{reference = CM}) -> log(Connection,disconnect), ok. +%% =========================================================================== + +%% recv/1 +%% +%% Extract incoming messages using either NETCONF 1.0 framing or +%% NETCONF 1.1 chunking. + +recv(Bin, true) -> + recv(Bin, [<<>>, 3]); +recv(Bin, false) -> + recv(Bin, <<>>); + +recv(Bin, [Head, Len | Chunks]) -> %% 1.1 chunking + chunk(<<Head/binary, Bin/binary>>, Chunks, Len); + +%% Start looking for the terminating end-of-message sequence ]]>]]> +%% 5 characters from the end of the buffered head, since this binary +%% has already been scanned. +recv(Bin, Head) when is_binary(Head) -> %% 1.0 framing + frame(<<Head/binary, Bin/binary>>, max(0, size(Head) - 5)). + +%% frame/2 +%% +%% Extract a message terminated by the ]]>]]> end-of-message sequence. +%% Don't need to extract characters as UTF-8 since matching byte-wise +%% is unambiguous: the high-order bit of every byte of a multi-byte +%% UTF character is 1, while the end-of-message sequence is ASCII. + +frame(Bin, Start) -> + Sz = size(Bin), + Scope = {Start, Sz - Start}, + case binary:match(Bin, pattern(), [{scope, Scope}]) of + {Len, 6} -> + <<Msg:Len/binary, _:6/binary, Rest/binary>> = Bin, + {trim(Msg), Rest}; + nomatch -> + Bin + end. + +%% pattern/0 + +pattern() -> + Key = ?KEY(pattern), + case get(Key) of + undefined -> + CP = binary:compile_pattern(<<"]]>]]>">>), + put(Key, CP), + CP; + CP -> + CP + end. + +%% trim/1 +%% +%% Whitespace before an XML declaration is an error, but be somewhat +%% lenient and strip line breaks since the RFC's are unclear on what's +%% allowed following a ]]>]]> delimiter. Typical seems to be a single +%% $\n, but strip any of " \t\r\n", and regardless of NETCONF version. + +trim(<<C, Bin/binary>>) + when C == $\n; + C == $\r; + C == $\t; + C == $ -> + trim(Bin); + +trim(Bin) -> + Bin. + +%% chunk/3 +%% +%% The final argument is either 0 to indicate that a specified number +%% of bytes of chunk data should be consumed, or at least 3 to +%% indicate an offset at which to look for a newline following a chunk +%% size. + +%% Accumulating chunk-data ... +chunk(Bin, [Sz | Chunks] = L, 0) -> + case Bin of + <<Chunk:Sz/binary, Rest/binary>> -> + chunk(Rest, acc(Chunk, Chunks), 3); %% complete chunk ... + _ -> + [Bin, 0 | L] %% ... or not + end; + +%% ... or a header. + +chunk(Bin, Chunks, Len) + when size(Bin) < 4 -> + [Bin, 3 = Len | Chunks]; + +%% End of chunks. +chunk(<<"\n##\n", Rest/binary>>, Chunks, _) -> + case Chunks of + [] -> + {error, "end-of-chunks unexpected"}; %% must be at least one + Bins -> + {lists:reverse(Bins), Rest} + end; + +%% Matching each of the 10 newline possibilities is faster than +%% searching. +chunk(<<"\n#", Head:1/binary, $\n, Rest/binary>>, Chunks, _) -> + acc(Head, Rest, Chunks); +chunk(<<"\n#", Head:2/binary, $\n, Rest/binary>>, Chunks, _) -> + acc(Head, Rest, Chunks); +chunk(<<"\n#", Head:3/binary, $\n, Rest/binary>>, Chunks, _) -> + acc(Head, Rest, Chunks); +chunk(<<"\n#", Head:4/binary, $\n, Rest/binary>>, Chunks, _) -> + acc(Head, Rest, Chunks); +chunk(<<"\n#", Head:5/binary, $\n, Rest/binary>>, Chunks, _) -> + acc(Head, Rest, Chunks); +chunk(<<"\n#", Head:6/binary, $\n, Rest/binary>>, Chunks, _) -> + acc(Head, Rest, Chunks); +chunk(<<"\n#", Head:7/binary, $\n, Rest/binary>>, Chunks, _) -> + acc(Head, Rest, Chunks); +chunk(<<"\n#", Head:8/binary, $\n, Rest/binary>>, Chunks, _) -> + acc(Head, Rest, Chunks); +chunk(<<"\n#", Head:9/binary, $\n, Rest/binary>>, Chunks, _) -> + acc(Head, Rest, Chunks); +chunk(<<"\n#", Head:10/binary, $\n, Rest/binary>>, Chunks, _) -> + acc(Head, Rest, Chunks); + +chunk(<<"\n#", Bin:11/binary, _/binary>>, _, _) -> + {error, {"chunk-size too long", Bin}}; %% 32-bits = max 10 digits + +chunk(<<"\n#", _/binary>> = Bin, Chunks, _) -> + [Bin, size(Bin) | Chunks]; + +chunk(Bin, Chunks, 3 = Len) -> + case drop(Bin) of + <<>> -> + [Bin, Len | Chunks]; + <<"\n#", _/binary>> = B -> + chunk(B, Chunks, Len); + _ -> + {error, {"not a chunk", Bin}} + end. + +%% drop/1 + +drop(<<"\n#", _/binary>> = Bin) -> + Bin; + +drop(<<C, Bin/binary>>) + when C == $\n; + C == $\r; + C == $\t; + C == $ -> + drop(Bin); + +drop(Bin) -> + Bin. + +%% acc/2 + +acc(Chunk, []) -> + [B || B <- [trim(Chunk)], <<>> /= B]; + +acc(Chunk, Chunks) -> + [Chunk | Chunks]. + +%% acc/3 + +acc(Head, Rest, Chunks) -> + case chunk_size(Head) of + {error, _Reason} = No -> + No; + Sz -> + chunk(Rest, [Sz | Chunks], 0) + end. + +%% chunk_size/1 + +chunk_size(<<C, _/binary>> = Bin) -> + try true = $0 < C, binary_to_integer(Bin) of + Sz when 0 < Sz bsr 32 -> + {error, {"chunk-size too large", Sz}}; + Sz -> + Sz + catch + error: _ -> + {error, {"chunk-size invalid", Bin}} + end. %%---------------------------------------------------------------------- %% END OF MODULE diff --git a/lib/common_test/src/ct_property_test.erl b/lib/common_test/src/ct_property_test.erl index f51f454d08..d884a6d494 100644 --- a/lib/common_test/src/ct_property_test.erl +++ b/lib/common_test/src/ct_property_test.erl @@ -32,27 +32,34 @@ %% API -export([init_per_suite/1, - quickcheck/2]). + init_tool/1, + quickcheck/2]). -include_lib("common_test/include/ct.hrl"). init_per_suite(Config) -> + case init_tool(Config) of + {skip, _}=Skip -> + Skip; + Config1 -> + Path = property_tests_path("property_test", Config1), + case compile_tests(Path, Config1) of + error -> + {fail, "Property test compilation failed in "++Path}; + up_to_date -> + add_code_pathz(Path), + [{property_dir, Path} | Config1] + end + end. + +init_tool(Config) -> case which_module_exists([eqc,proper,triq]) of - {ok,ToolModule} -> - ct:pal("Found property tester ~p",[ToolModule]), - Path = property_tests_path("property_test", Config), - case compile_tests(Path,ToolModule) of - error -> - {fail, "Property test compilation failed in "++Path}; - up_to_date -> - add_code_pathz(Path), - [{property_dir,Path}, - {property_test_tool,ToolModule} | Config] - end; - - not_found -> - ct:pal("No property tester found",[]), - {skip, "No property testing tool found"} + {ok, ToolModule} -> + ct:pal("Found property tester ~p",[ToolModule]), + [{property_test_tool, ToolModule} | Config]; + not_found -> + ct:pal("No property tester found",[]), + {skip, "No property testing tool found"} end. quickcheck(Property, Config) -> @@ -105,7 +112,8 @@ add_code_pathz(Dir) -> ok end. -compile_tests(Path, ToolModule) -> +compile_tests(Path, Config) -> + ToolModule = proplists:get_value(property_test_tool, Config), MacroDefs = macro_def(ToolModule), {ok,Cwd} = file:get_cwd(), ok = file:set_cwd(Path), diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 960252a6fe..b028078332 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -27,13 +27,8 @@ -export([install/1,install/2,run/1,run/2,run/3,run_test/1, run_testspec/1,step/3,step/4,refresh_logs/1]). - -%% Exported for VTS --export([run_make/3,do_run/4,tests/1,tests/2,tests/3]). - - -%% Misc internal functions --export([variables_file_name/1,script_start1/2,run_test2/1]). +%% Misc internal API functions +-export([variables_file_name/1,script_start1/2,run_test2/1, run_make/3]). -include("ct.hrl"). -include("ct_event.hrl"). @@ -51,7 +46,6 @@ -record(opts, {label, profile, - vts, shell, cover, cover_stop, @@ -212,25 +206,19 @@ finish(Tracing, ExitStatus, Args) -> if ExitStatus == interactive_mode -> interactive_mode; true -> - case get_start_opt(vts, true, Args) of - true -> - %% VTS mode, don't halt the node - ok; - _ -> - %% it's possible to tell CT to finish execution with a call - %% to a different function than the normal halt/1 BIF - %% (meant to be used mainly for reading the CT exit status) - case get_start_opt(halt_with, - fun([HaltMod,HaltFunc]) -> - {list_to_atom(HaltMod), - list_to_atom(HaltFunc)} end, - Args) of - undefined -> - halt(ExitStatus); - {M,F} -> - apply(M, F, [ExitStatus]) - end - end + %% it's possible to tell CT to finish execution with a call + %% to a different function than the normal halt/1 BIF + %% (meant to be used mainly for reading the CT exit status) + case get_start_opt(halt_with, + fun([HaltMod,HaltFunc]) -> + {list_to_atom(HaltMod), + list_to_atom(HaltFunc)} end, + Args) of + undefined -> + halt(ExitStatus); + {M,F} -> + apply(M, F, [ExitStatus]) + end end. script_start1(Parent, Args) -> @@ -239,7 +227,6 @@ script_start1(Parent, Args) -> %% read general start flags Label = get_start_opt(label, fun([Lbl]) -> Lbl end, Args), Profile = get_start_opt(profile, fun([Prof]) -> Prof end, Args), - Vts = get_start_opt(vts, true, undefined, Args), Shell = get_start_opt(shell, true, Args), Cover = get_start_opt(cover, fun([CoverFile]) -> ?abs(CoverFile) end, Args), CoverStop = get_start_opt(cover_stop, @@ -325,8 +312,8 @@ script_start1(Parent, Args) -> Stylesheet = get_start_opt(stylesheet, fun([SS]) -> ?abs(SS) end, Args), %% basic_html - used by ct_logs - BasicHtml = case {Vts,proplists:get_value(basic_html, Args)} of - {undefined,undefined} -> + BasicHtml = case proplists:get_value(basic_html, Args) of + undefined -> application:set_env(common_test, basic_html, false), undefined; _ -> @@ -357,7 +344,7 @@ script_start1(Parent, Args) -> application:set_env(common_test, keep_logs, KeepLogs), Opts = #opts{label = Label, profile = Profile, - vts = Vts, shell = Shell, + shell = Shell, cover = Cover, cover_stop = CoverStop, logdir = LogDir, logopts = LogOpts, basic_html = BasicHtml, @@ -415,8 +402,7 @@ run_or_refresh(Opts = #opts{logdir = LogDir}, Args) -> end end. -script_start2(Opts = #opts{vts = undefined, - shell = undefined}, Args) -> +script_start2(Opts = #opts{shell = undefined}, Args) -> case proplists:get_value(spec, Args) of Specs when Specs =/= [], Specs =/= undefined -> Specs1 = get_start_opt(join_specs, [Specs], Specs, Args), @@ -702,7 +688,7 @@ script_start3(Opts, Args) -> {error,incorrect_start_options}; {undefined,undefined,_} -> - if Opts#opts.vts ; Opts#opts.shell -> + if Opts#opts.shell -> script_start4(Opts#opts{tests = []}, Args); true -> %% no start options, use default "-dir ./" @@ -712,20 +698,6 @@ script_start3(Opts, Args) -> end end. -script_start4(#opts{vts = true, config = Config, event_handlers = EvHandlers, - tests = Tests, logdir = LogDir, logopts = LogOpts}, _Args) -> - ConfigFiles = - lists:foldl(fun({ct_config_plain,CfgFiles}, AllFiles) when - is_list(hd(CfgFiles)) -> - AllFiles ++ CfgFiles; - ({ct_config_plain,CfgFile}, AllFiles) when - is_integer(hd(CfgFile)) -> - AllFiles ++ [CfgFile]; - (_, AllFiles) -> - AllFiles - end, [], Config), - vts:init_data(ConfigFiles, EvHandlers, ?abs(LogDir), LogOpts, Tests); - script_start4(#opts{label = Label, profile = Profile, shell = true, config = Config, event_handlers = EvHandlers, @@ -759,27 +731,6 @@ script_start4(#opts{label = Label, profile = Profile, Error -> Error end; - -script_start4(#opts{vts = true, cover = Cover}, _) -> - case Cover of - undefined -> - script_usage(); - _ -> - %% Add support later (maybe). - io:format("\nCan't run cover in vts mode.\n\n", []) - end, - {error,no_cover_in_vts_mode}; - -script_start4(#opts{shell = true, cover = Cover}, _) -> - case Cover of - undefined -> - script_usage(); - _ -> - %% Add support later (maybe). - io:format("\nCan't run cover in interactive mode.\n\n", []) - end, - {error,no_cover_in_interactive_mode}; - script_start4(Opts = #opts{tests = Tests}, Args) -> do_run(Tests, [], Opts, Args). @@ -850,7 +801,6 @@ script_usage() -> "\n\t [-config ConfigFile1 ConfigFile2 .. ConfigFileN]" "\n\t [-decrypt_key Key] | [-decrypt_file KeyFile]\n\n"), io:format("Run tests in web based GUI:\n\n" - "\tct_run -vts [-browser Browser]" "\n\t [-config ConfigFile1 ConfigFile2 .. ConfigFileN]" "\n\t [-decrypt_key Key] | [-decrypt_file KeyFile]" "\n\t [-dir TestDir1 TestDir2 .. TestDirN] |" @@ -2674,7 +2624,6 @@ get_name(Dir) -> TopDir ++ "." ++ Base end. - run_make(TestDir, Mod, UserInclude) -> run_make(suites, TestDir, Mod, UserInclude, [nowarn_export_all]). diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index 9f489e9bfb..470a938c53 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -156,12 +156,7 @@ do_start(Parent, Mode, LogDir, Verbosity) -> {error,{already_started,_}} -> ok; _ -> - case whereis(vts) of - undefined -> - ct_event:add_handler(); - VtsPid -> - ct_event:add_handler([{vts,VtsPid}]) - end + ct_event:add_handler() end, %% start ct_config server diff --git a/lib/common_test/src/ct_webtool.erl b/lib/common_test/src/ct_webtool.erl deleted file mode 100644 index 32d4255217..0000000000 --- a/lib/common_test/src/ct_webtool.erl +++ /dev/null @@ -1,1214 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(ct_webtool). --behaviour(gen_server). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The general idea is: %% -%% %% -%% %% -%% 1. Scan through the path for *.tool files and find all the web %% -%% based tools. Query each tool for configuration data. %% -%% 2. Add Alias for Erlscript and html for each tool to %% -%% the webserver configuration data. %% -%% 3. Start the webserver. %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% API functions --export([start/0, start/2, stop/0]). - -%% Starting Webtool from a shell script --export([script_start/0, script_start/1]). - -%% Web api --export([started_tools/2, toolbar/2, start_tools/2, stop_tools/2]). - -%% API against other tools --export([is_localhost/0]). - -%% Debug export s --export([get_tools1/1]). --export([debug/1, stop_debug/0, debug_app/1]). - -%% gen_server callbacks --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3]). - --include_lib("kernel/include/file.hrl"). --include_lib("stdlib/include/ms_transform.hrl"). - --record(state,{priv_dir,app_data,supvis,web_data,started=[]}). - --define(MAX_NUMBER_OF_WEBTOOLS,256). --define(DEFAULT_PORT,8888).% must be >1024 or the user must be root on unix --define(DEFAULT_ADDR,{127,0,0,1}). - --define(WEBTOOL_ALIAS,{ct_webtool,[{alias,{erl_alias,"/ct_webtool",[ct_webtool]}}]}). --define(HEADER,"Pragma:no-cache\r\n Content-type: text/html\r\n\r\n"). --define(HTML_HEADER,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool</TITLE>\r\n</HEAD>\r\n<BODY BGCOLOR=\"#FFFFFF\">\r\n"). --define(HTML_HEADER_RELOAD,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool - </TITLE>\r\n</HEAD>\r\n - <BODY BGCOLOR=\"#FFFFFF\" onLoad=reloadCompiledList()>\r\n"). - --define(HTML_END,"</BODY></HTML>"). - --define(SEND_URL_TIMEOUT,5000). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% For debugging only. %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Start tracing with -%% debug(Functions). -%% Functions = local | global | FunctionList -%% FunctionList = [Function] -%% Function = {FunctionName,Arity} | FunctionName | -%% {Module, FunctionName, Arity} | {Module,FunctionName} -debug(F) -> - {ok, _} = ttb:tracer(all,[{file,"webtool.trc"}]), % tracing all nodes - {ok, _} = ttb:p(all,[call,timestamp]), - MS = [{'_',[],[{return_trace},{message,{caller}}]}], - _ = tp(F,MS), - {ok, _} = ttb:ctp(?MODULE,stop_debug), % don't want tracing of the stop_debug func - ok. -tp(local,MS) -> % all functions - ttb:tpl(?MODULE,MS); -tp(global,MS) -> % all exported functions - ttb:tp(?MODULE,MS); -tp([{M,F,A}|T],MS) -> % Other module - {ok, _} = ttb:tpl(M,F,A,MS), - tp(T,MS); -tp([{M,F}|T],MS) when is_atom(F) -> % Other module - {ok, _} = ttb:tpl(M,F,MS), - tp(T,MS); -tp([{F,A}|T],MS) -> % function/arity - {ok, _} = ttb:tpl(?MODULE,F,A,MS), - tp(T,MS); -tp([F|T],MS) -> % function - {ok, _} = ttb:tpl(?MODULE,F,MS), - tp(T,MS); -tp([],_MS) -> - ok. -stop_debug() -> - ttb:stop([format]). - -debug_app(Mod) -> - {ok, _} = ttb:tracer(all,[{file,"webtool_app.trc"},{handler,{fun out/4,true}}]), - {ok, _} = ttb:p(all,[call,timestamp]), - MS = [{'_',[],[{return_trace},{message,{caller}}]}], - {ok, _} = ttb:tp(Mod,MS), - ok. - -out(_,{trace_ts,Pid,call,MFA={M,F,A},{W,_,_},TS},_,S) - when W==webtool;W==mod_esi-> - io:format("~w: (~p)~ncall ~ts~n", [TS,Pid,ffunc(MFA)]), - [{M,F,length(A)}|S]; -out(_,{trace_ts,Pid,return_from,MFA,R,TS},_,[MFA|S]) -> - io:format("~w: (~p)~nreturned from ~ts -> ~tp~n", [TS,Pid,ffunc(MFA),R]), - S; -out(_,_,_,_) -> - ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Functions called via script. %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -script_start() -> - usage(), - halt(). -script_start([App]) -> - DefaultBrowser = - case os:type() of - {win32,_} -> iexplore; - _ -> firefox - end, - script_start([App,DefaultBrowser]); -script_start([App,Browser]) -> - io:format("Starting webtool...\n"), - {ok, _} = start(), - AvailableApps = get_applications(), - {OSType,_} = os:type(), - case lists:keysearch(App,1,AvailableApps) of - {value,{App,StartPage}} -> - io:format("Starting ~w...\n",[App]), - start_tools([],"app=" ++ atom_to_list(App)), - PortStr = integer_to_list(get_port()), - Url = case StartPage of - "/" ++ Page -> - "http://localhost:" ++ PortStr ++ "/" ++ Page; - _ -> - "http://localhost:" ++ PortStr ++ "/" ++ StartPage - end, - _ = case Browser of - none -> - ok; - iexplore when OSType == win32-> - io:format("Starting internet explorer...\n"), - {ok,R} = win32reg:open(""), - Key="\\local_machine\\SOFTWARE\\Microsoft\\IE Setup\\Setup", - ok = win32reg:change_key(R,Key), - {ok,Val} = win32reg:value(R,"Path"), - IExplore=filename:join(win32reg:expand(Val),"iexplore.exe"), - os:cmd("\"" ++ IExplore ++ "\" " ++ Url); - _ when OSType == win32 -> - io:format("Starting ~tw...\n",[Browser]), - os:cmd("\"" ++ atom_to_list(Browser) ++ "\" " ++ Url); - B when B==firefox; B==mozilla -> - io:format("Sending URL to ~w...",[Browser]), - BStr = atom_to_list(Browser), - SendCmd = BStr ++ " -raise -remote \'openUrl(" ++ - Url ++ ")\'", - Port = open_port({spawn,SendCmd},[exit_status]), - receive - {Port,{exit_status,0}} -> - io:format("done\n"), - ok; - {Port,{exit_status,_Error}} -> - io:format(" not running, starting ~w...\n", - [Browser]), - _ = os:cmd(BStr ++ " " ++ Url), - ok - after ?SEND_URL_TIMEOUT -> - io:format(" failed, starting ~w...\n",[Browser]), - erlang:port_close(Port), - os:cmd(BStr ++ " " ++ Url) - end; - _ -> - io:format("Starting ~tw...\n",[Browser]), - os:cmd(atom_to_list(Browser) ++ " " ++ Url) - end, - ok; - false -> - stop(), - io:format("\n{error,{unknown_app,~p}}\n",[App]), - halt() - end. - -usage() -> - io:format("Starting webtool...\n"), - {ok, _} = start(), - Apps = lists:map(fun({A,_}) -> A end,get_applications()), - io:format( - "\nUsage: start_webtool application [ browser ]\n" - "\nAvailable applications are: ~p\n" - "Default browser is \'iexplore\' (Internet Explorer) on Windows " - "or else \'firefox\'\n", - [Apps]), - stop(). - - -get_applications() -> - gen_server:call(ct_web_tool,get_applications). - -get_port() -> - gen_server:call(ct_web_tool,get_port). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Api functions to the genserver. %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -% -%---------------------------------------------------------------------- - -start()-> - start(standard_path,standard_data). - -start(Path,standard_data)-> - case get_standard_data() of - {error,Reason} -> - {error,Reason}; - Data -> - start(Path,Data) - end; - -start(standard_path,Data)-> - Path=get_path(), - start(Path,Data); - -start(Path,Port) when is_integer(Port)-> - Data = get_standard_data(Port), - start(Path,Data); - -start(Path,Data0)-> - Data = Data0 ++ rest_of_standard_data(), - case gen_server:start({local,ct_web_tool},ct_webtool,{Path,Data},[]) of - {error, {already_started, Pid}} -> - {ok, Pid}; - Else -> - Else - end. - -stop()-> - gen_server:call(ct_web_tool,stoppit). - -%---------------------------------------------------------------------- -%Web Api functions called by the web -%---------------------------------------------------------------------- -started_tools(Env,Input)-> - gen_server:call(ct_web_tool,{started_tools,Env,Input}). - -toolbar(Env,Input)-> - gen_server:call(ct_web_tool,{toolbar,Env,Input}). - -start_tools(Env,Input)-> - gen_server:call(ct_web_tool,{start_tools,Env,Input}). - -stop_tools(Env,Input)-> - gen_server:call(ct_web_tool,{stop_tools,Env,Input}). -%---------------------------------------------------------------------- -%Support API for other tools -%---------------------------------------------------------------------- - -is_localhost()-> - gen_server:call(ct_web_tool,is_localhost). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%%The gen_server callback functions that builds the webbpages %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -handle_call(get_applications,_,State)-> - MS = ets:fun2ms(fun({Tool,{web_data,{_,Start}}}) -> {Tool,Start} end), - Tools = ets:select(State#state.app_data,MS), - {reply,Tools,State}; - -handle_call(get_port,_,State)-> - {value,{port,Port}}=lists:keysearch(port,1,State#state.web_data), - {reply,Port,State}; - -handle_call({started_tools,_Env,_Input},_,State)-> - {reply,started_tools_page(State),State}; - -handle_call({toolbar,_Env,_Input},_,State)-> - {reply,toolbar(),State}; - -handle_call({start_tools,Env,Input},_,State)-> - {NewState,Page}=start_tools_page(Env,Input,State), - {reply,Page,NewState}; - -handle_call({stop_tools,Env,Input},_,State)-> - {NewState,Page}=stop_tools_page(Env,Input,State), - {reply,Page,NewState}; - -handle_call(stoppit,_From,Data)-> - {stop,normal,ok,Data}; - -handle_call(is_localhost,_From,Data)-> - Result=case proplists:get_value(bind_address, Data#state.web_data) of - ?DEFAULT_ADDR -> - true; - _IpNumber -> - false - end, - {reply,Result,Data}. - - -handle_info(_Message,State)-> - {noreply,State}. - -handle_cast(_Request,State)-> - {noreply,State}. - -code_change(_,State,_)-> - {ok,State}. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% The other functions needed by the gen_server behaviour -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -% Start the gen_server -%---------------------------------------------------------------------- -init({Path,Config})-> - ct_util:mark_process(), - case filelib:is_dir(Path) of - true -> - {ok, Table} = get_tool_files_data(), - insert_app(?WEBTOOL_ALIAS, Table), - case ct_webtool_sup:start_link() of - {ok, Pid} -> - case start_webserver(Table, Path, Config) of - {ok, _} -> - print_url(Config), - {ok,#state{priv_dir=Path, - app_data=Table, - supvis=Pid, - web_data=Config}}; - {error, Error} -> - {stop, {error, Error}} - end; - Error -> - {stop,Error} - end; - false -> - {stop, {error, error_dir}} - end. - -terminate(_Reason,Data)-> - %%shut down the webbserver - shutdown_server(Data), - %%Shutdown the different tools that are started with application:start - shutdown_apps(Data), - %%Shutdown the supervisor and its children will die - shutdown_supervisor(Data), - ok. - -print_url(ConfigData)-> - Server=proplists:get_value(server_name,ConfigData,"undefined"), - Port=proplists:get_value(port,ConfigData,"undefined"), - {A,B,C,D}=proplists:get_value(bind_address,ConfigData,"undefined"), - io:format("WebTool is available at http://~ts:~w/~n",[Server,Port]), - io:format("Or http://~w.~w.~w.~w:~w/~n",[A,B,C,D,Port]). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% begin build the pages -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -%The page that shows the started tools -%---------------------------------------------------------------------- -started_tools_page(State)-> - [?HEADER,?HTML_HEADER,started_tools(State),?HTML_END]. - -toolbar()-> - [?HEADER,?HTML_HEADER,toolbar_page(),?HTML_END]. - - -start_tools_page(_Env,Input,State)-> - %%io:format("~n======= ~n ~p ~n============~n",[Input]), - case get_tools(Input) of - {tools,Tools}-> - %%io:format("~n======= ~n ~p ~n============~n",[Tools]), - {ok,NewState}=handle_apps(Tools,State,start), - {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(), - show_unstarted_apps(NewState),?HTML_END]}; - _ -> - {State,[?HEADER,?HTML_HEADER,show_unstarted_apps(State),?HTML_END]} - end. - -stop_tools_page(_Env,Input,State)-> - case get_tools(Input) of - {tools,Tools}-> - {ok,NewState}=handle_apps(Tools,State,stop), - {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(), - show_started_apps(NewState),?HTML_END]}; - _ -> - {State,[?HEADER,?HTML_HEADER,show_started_apps(State),?HTML_END]} - end. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Functions that start and config the webserver -%% 1. Collect the config data -%% 2. Start webserver -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -% Start the webserver -%---------------------------------------------------------------------- -start_webserver(Data,Path,Config)-> - case get_conf_data(Data,Path,Config) of - {ok,Conf_data}-> - %%io:format("Conf_data: ~p~n",[Conf_data]), - start_server(Conf_data); - {error,Error} -> - {error,{error_server_conf_file,Error}} - end. - -start_server(Conf_data)-> - case inets:start(httpd, Conf_data, stand_alone) of - {ok,Pid}-> - {ok,Pid}; - Error-> - {error,{server_error,Error}} - end. - -%---------------------------------------------------------------------- -% Create config data for the webserver -%---------------------------------------------------------------------- -get_conf_data(Data,Path,Config)-> - Aliases=get_aliases(Data), - ServerRoot = filename:join([Path,"root"]), - MimeTypesFile = filename:join([ServerRoot,"conf","mime.types"]), - case httpd_conf:load_mime_types(MimeTypesFile) of - {ok,MimeTypes} -> - Config1 = Config ++ Aliases, - Config2 = [{server_root,ServerRoot}, - {document_root,filename:join([Path,"root/doc"])}, - {mime_types,MimeTypes} | - Config1], - {ok,Config2}; - Error -> - Error - end. - -%---------------------------------------------------------------------- -% Control the path for *.tools files -%---------------------------------------------------------------------- -get_tool_files_data()-> - Tools=get_tools1(code:get_path()), - %%io:format("Data : ~p ~n",[Tools]), - get_file_content(Tools). - -%---------------------------------------------------------------------- -%Control that the data in the file really is erlang terms -%---------------------------------------------------------------------- -get_file_content(Tools)-> - Get_data=fun({tool,ToolData}) -> - %%io:format("Data : ~p ~n",[ToolData]), - case proplists:get_value(config_func,ToolData) of - {M,F,A}-> - case catch apply(M,F,A) of - {'EXIT',_} -> - bad_data; - Data when is_tuple(Data) -> - Data; - _-> - bad_data - end; - _ -> - bad_data - end - end, - insert_file_content([X ||X<-lists:map(Get_data,Tools),X/=bad_data]). - -%---------------------------------------------------------------------- -%Insert the data from the file in to the ets:table -%---------------------------------------------------------------------- -insert_file_content(Content)-> - Table=ets:new(app_data,[bag]), - lists:foreach(fun(X)-> - insert_app(X,Table) - end,Content), - {ok,Table}. - -%---------------------------------------------------------------------- -%Control that we got a a tuple of a atom and a list if so add the -%elements in the list to the ets:table -%---------------------------------------------------------------------- -insert_app({Name,Key_val_list},Table) when is_list(Key_val_list),is_atom(Name)-> - %%io:format("ToolData: ~p: ~p~n",[Name,Key_val_list]), - lists:foreach( - fun({alias,{erl_alias,Alias,Mods}}) -> - Key_val = {erl_script_alias,{Alias,Mods}}, - %%io:format("Insert: ~p~n",[Key_val]), - ets:insert(Table,{Name,Key_val}); - (Key_val_pair)-> - %%io:format("Insert: ~p~n",[Key_val_pair]), - ets:insert(Table,{Name,Key_val_pair}) - end, - Key_val_list); - -insert_app(_,_)-> - ok. - -%---------------------------------------------------------------------- -% Select all the alias in the database -%---------------------------------------------------------------------- -get_aliases(Data)-> - MS = ets:fun2ms(fun({_,{erl_script_alias,Alias}}) -> - {erl_script_alias,Alias}; - ({_,{alias,Alias}}) -> - {alias,Alias} - end), - ets:select(Data,MS). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Helper functions %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_standard_data(Port)-> - [ - {port,Port}, - {bind_address,?DEFAULT_ADDR}, - {server_name,"localhost"} - ]. - -get_standard_data()-> - case get_free_port(?DEFAULT_PORT,?MAX_NUMBER_OF_WEBTOOLS) of - {error,Reason} -> {error,Reason}; - Port -> - [ - {port,Port}, - {bind_address,?DEFAULT_ADDR}, - {server_name,"localhost"} - ] - end. - -get_free_port(_Port,0) -> - {error,no_free_port_found}; -get_free_port(Port,N) -> - case gen_tcp:connect("localhost",Port,[]) of - {error, _Reason} -> - Port; - {ok,Sock} -> - gen_tcp:close(Sock), - get_free_port(Port+1,N-1) - end. - -rest_of_standard_data() -> - [ - %% Do not allow the server to be crashed by malformed http-request - {max_header_siz,1024}, - {max_header_action,reply414}, - %% Go on a straight ip-socket - {com_type,ip_comm}, - %% Do not change the order of these module names!! - {modules,[mod_alias, - mod_auth, - mod_esi, - mod_actions, - mod_cgi, - mod_include, - mod_dir, - mod_get, - mod_head, - mod_log, - mod_disk_log]}, - {directory_index,["index.html"]}, - {default_type,"text/plain"} - ]. - - -get_path()-> - code:priv_dir(webtool). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These functions is used to shutdown the webserver -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -% Shut down the webbserver -%---------------------------------------------------------------------- -shutdown_server(State)-> - {Addr,Port} = get_addr_and_port(State#state.web_data), - inets:stop(httpd,{Addr,Port}). - -get_addr_and_port(Config) -> - Addr = proplists:get_value(bind_address,Config,?DEFAULT_ADDR), - Port = proplists:get_value(port,Config,?DEFAULT_PORT), - {Addr,Port}. - -%---------------------------------------------------------------------- -% Select all apps in the table and close them -%---------------------------------------------------------------------- -shutdown_apps(State)-> - Data=State#state.app_data, - MS = ets:fun2ms(fun({_,{start,HowToStart}}) -> HowToStart end), - lists:foreach(fun(Start_app)-> - stop_app(Start_app) - end, - ets:select(Data,MS)). - -%---------------------------------------------------------------------- -%Shuts down the supervisor that supervises tools that is not -%Designed as applications -%---------------------------------------------------------------------- -shutdown_supervisor(State)-> - %io:format("~n==================~n"), - ct_webtool_sup:stop(State#state.supvis). - %io:format("~n==================~n"). - -%---------------------------------------------------------------------- -%close the individual apps. -%---------------------------------------------------------------------- -stop_app({child,_Real_name})-> - ok; - -stop_app({app,Real_name})-> - application:stop(Real_name); - -stop_app({func,_Start,Stop})-> - case Stop of - {M,F,A} -> - catch apply(M,F,A); - _NoStop -> - ok - end. - - - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% These functions creates the webpage where the user can select if -%% to start apps or to stop apps -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -toolbar_page()-> - "<TABLE> - <TR> - <TD> - <B>Select Action</B> - </TD> - </TR> - <TR> - <TD> - <A HREF=\"./start_tools\" TARGET=right> Start Tools</A> - </TD> - </TR> - <TR> - <TD> - <A HREF=\"./stop_tools\" TARGET=right> Stop Tools</A> - </TD> - </TR> - </TABLE>". -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% These functions creates the webbpage that shows the started apps -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -% started_tools(State)->String (html table) -% State is a record of type state -%---------------------------------------------------------------------- -started_tools(State)-> - Names=get_started_apps(State#state.app_data,State#state.started), - "<TABLE BORDER=1 WIDTH=100%> - "++ make_rows(Names,[],0) ++" - </TABLE>". -%---------------------------------------------------------------------- -%get_started_apps(Data,Started)-> [{web_name,link}] -%selects the started apps from the ets table of apps. -%---------------------------------------------------------------------- - -get_started_apps(Data,Started)-> - SelectData=fun({Name,Link}) -> - {Name,Link} - end, - MS = lists:map(fun(A) -> {{A,{web_data,'$1'}},[],['$1']} end,Started), - - [{"WebTool","/tool_management.html"} | - [SelectData(X) || X <- ets:select(Data,MS)]]. - -%---------------------------------------------------------------------- -% make_rows(List,Result,Fields)-> String (The rows of a htmltable -% List a list of tupler discibed above -% Result an accumulator for the result -% Field, counter that counts the number of cols in each row. -%---------------------------------------------------------------------- -make_rows([],Result,Fields)-> - Result ++ fill_out(Fields); -make_rows([Data|Paths],Result,Field)when Field==0-> - make_rows(Paths,Result ++ "<TR>" ++ make_field(Data),Field+1); - -make_rows([Path|Paths],Result,Field)when Field==4-> - make_rows(Paths,Result ++ make_field(Path) ++ "</TR>",0); - -make_rows([Path|Paths],Result,Field)-> - make_rows(Paths,Result ++ make_field(Path),Field+1). - -%---------------------------------------------------------------------- -% make_fields(Path)-> String that is a field i a html table -% Path is a name url tuple {Name,url} -%---------------------------------------------------------------------- -make_field(Path)-> - "<TD WIDTH=20%>" ++ get_name(Path) ++ "</TD>". - - -%---------------------------------------------------------------------- -%get_name({Nae,Url})->String that represents a <A> tag in html. -%---------------------------------------------------------------------- -get_name({Name,Url})-> - "<A HREF=\"" ++ Url ++ "\" TARGET=app_frame>" ++ Name ++ "</A>". - - -%---------------------------------------------------------------------- -% fill_out(Nr)-> String, that represent Nr fields in a html-table. -%---------------------------------------------------------------------- -fill_out(Nr)when Nr==0-> - []; -fill_out(Nr)when Nr==4-> - "<TD WIDTH=\"20%\" > </TD></TR>"; - -fill_out(Nr)-> - "<TD WIDTH=\"20%\"> </TD>" ++ fill_out(Nr+1). - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%%These functions starts applicatons and builds the page showing tools -%%to start -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -%Controls whether the user selected a tool to start -%---------------------------------------------------------------------- -get_tools(Input)-> - case uri_string:dissect_query(Input) of - []-> - no_tools; - Tools-> - FormatData=fun({_Name,Data}) -> list_to_atom(Data) end, - SelectData= - fun({Name,_Data}) -> string:equal(Name,"app") end, - {tools,[FormatData(X)||X<-Tools,SelectData(X)]} - end. - -%---------------------------------------------------------------------- -% Selects the data to start the applications the user has ordered -% starting of -%---------------------------------------------------------------------- -handle_apps([],State,_Cmd)-> - {ok,State}; - -handle_apps([Tool|Tools],State,Cmd)-> - case ets:match_object(State#state.app_data,{Tool,{start,'_'}}) of - []-> - Started = case Cmd of - start -> - [Tool|State#state.started]; - stop -> - lists:delete(Tool,State#state.started) - end, - {ok,#state{priv_dir=State#state.priv_dir, - app_data=State#state.app_data, - supvis=State#state.supvis, - web_data=State#state.web_data, - started=Started}}; - ToStart -> - case handle_apps2(ToStart,State,Cmd) of - {ok,NewState}-> - handle_apps(Tools,NewState,Cmd); - _-> - handle_apps(Tools,State,Cmd) - end - end. - -%---------------------------------------------------------------------- -%execute every start or stop data about a tool. -%---------------------------------------------------------------------- -handle_apps2([{Name,Start_data}],State,Cmd)-> - case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd) of - ok-> - Started = case Cmd of - start -> - [Name|State#state.started]; - stop -> - - lists:delete(Name,State#state.started) - end, - {ok,#state{priv_dir=State#state.priv_dir, - app_data=State#state.app_data, - supvis=State#state.supvis, - web_data=State#state.web_data, - started=Started}}; - _-> - error - end; - -handle_apps2([{Name,Start_data}|Rest],State,Cmd)-> - case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd)of - ok-> - handle_apps2(Rest,State,Cmd); - _-> - error - end. - - -%---------------------------------------------------------------------- -% Handle start and stop of applications -%---------------------------------------------------------------------- - -handle_app({Name,{start,{func,Start,Stop}}},Data,_Pid,Cmd)-> - Action = case Cmd of - start -> - Start; - _ -> - Stop - end, - case Action of - {M,F,A} -> - case catch apply(M,F,A) of - {'EXIT',_} = Exit-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "~w:~tw(~ts) ->\n" - "~tp\n\n", - [?LINE,Name,M,F,format_args(A),Exit]), - ets:delete(Data,Name); - _OK-> - ok - end; - _NoStart -> - ok - end; - - -handle_app({Name,{start,{child,ChildSpec}}},Data,Pid,Cmd)-> - case Cmd of - start -> - case catch supervisor:start_child(Pid,ChildSpec) of - {ok,_}-> - ok; - {ok,_,_}-> - ok; - {error,Reason}-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "supervisor:start_child(~p,~tp) ->\n" - "~tp\n\n", - [?LINE,Name,Pid,ChildSpec,{error,Reason}]), - ets:delete(Data,Name); - Error -> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "supervisor:start_child(~p,~tp) ->\n" - "~tp\n\n", - [?LINE,Name,Pid,ChildSpec,Error]), - ets:delete(Data,Name) - end; - stop -> - case catch supervisor:terminate_child(websup,element(1,ChildSpec)) of - ok -> - supervisor:delete_child(websup,element(1,ChildSpec)); - _ -> - error - end - end; - - - -handle_app({Name,{start,{app,Real_name}}},Data,_Pid,Cmd)-> - case Cmd of - start -> - case application:start(Real_name,temporary) of - ok-> - io:write(Name), - ok; - {error,{already_started,_}}-> - %% Remove it from the database so we dont start - %% anything already started - ets:match_delete(Data,{Name,{start,{app,Real_name}}}), - ok; - {error,_Reason}=Error-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "application:start(~p,~p) ->\n" - "~tp\n\n", - [?LINE,Name,Real_name,temporary,Error]), - ets:delete(Data,Name) - end; - - stop -> - application:stop(Real_name) - end; - -%---------------------------------------------------------------------- -% If the data is incorrect delete the app -%---------------------------------------------------------------------- -handle_app({Name,Incorrect},Data,_Pid,Cmd)-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not ~w application \'~p\'\n\n" - "Incorrect data: ~tp\n\n", - [?LINE,Cmd,Name,Incorrect]), - ets:delete(Data,Name). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% this functions creates the page that shows the unstarted tools %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -reload_started_apps()-> - "<script> - function reloadCompiledList() - { - parent.parent.top1.document.location.href=\"/webtool/webtool/started_tools\"; - } - </script>". - -show_unstarted_apps(State)-> - "<TABLE HEIGHT=100% WIDTH=100% BORDER=0> - <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\"> - <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/start_tools\" > - <TABLE BORDER=1 WIDTH=60%> - <TR BGCOLOR=\"#8899AA\"> - <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Available Tools<FONT></TD> - </TR> - <TR> - <TD WIDTH=50%> - <TABLE BORDER=0> - "++ list_available_apps(State)++" - <TR><TD COLSPAN=2> </TD></TR> - <TR> - <TD COLSPAN=2 ALIGN=\"center\"> - <INPUT TYPE=submit VALUE=\"Start\"> - </TD> - </TR> - </TABLE> - </TD> - <TD> - To Start a Tool: - <UL> - <LI>Select the - checkbox for each tool to - start.</LI> - <LI>Click on the - button marked <EM>Start</EM>.</LI></UL> - </TD> - </TR> - </TABLE> - </FORM> - </TD></TR> - <TR><TD> </TD></TR> - </TABLE>". - - - -list_available_apps(State)-> - MS = ets:fun2ms(fun({Tool,{web_data,{Name,_}}}) -> {Tool,Name} end), - Unstarted_apps= - lists:filter( - fun({Tool,_})-> - false==lists:member(Tool,State#state.started) - end, - ets:select(State#state.app_data,MS)), - case Unstarted_apps of - []-> - "<TR><TD>All tools are started</TD></TR>"; - _-> - list_apps(Unstarted_apps) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% these functions creates the page that shows the started apps %% -%% the user can select to shutdown %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -show_started_apps(State)-> - "<TABLE HEIGHT=100% WIDTH=100% BORDER=0> - <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\"> - <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/stop_tools\" > - <TABLE BORDER=1 WIDTH=60%> - <TR BGCOLOR=\"#8899AA\"> - <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Started Tools<FONT></TD> - </TR> - <TR> - <TD WIDTH=50%> - <TABLE BORDER=0> - "++ list_started_apps(State)++" - <TR><TD COLSPAN=2> </TD></TR> - <TR> - <TD COLSPAN=2 ALIGN=\"center\"> - <INPUT TYPE=submit VALUE=\"Stop\"> - </TD> - </TR> - </TABLE> - </TD> - <TD> - Stop a Tool: - <UL> - <LI>Select the - checkbox for each tool to - stop.</LI> - <LI>Click on the - button marked <EM>Stop</EM>.</LI></UL> - </TD> - </TR> - </TABLE> - </FORM> - </TD></TR> - <TR><TD> </TD></TR> - </TABLE>". - -list_started_apps(State)-> - MS = lists:map(fun(A) -> {{A,{web_data,{'$1','_'}}},[],[{{A,'$1'}}]} end, - State#state.started), - Started_apps= ets:select(State#state.app_data,MS), - case Started_apps of - []-> - "<TR><TD>No tool is started yet.</TD></TR>"; - _-> - list_apps(Started_apps) - end. - - -list_apps(Apps) -> - lists:map(fun({Tool,Name})-> - "<TR><TD> - <INPUT TYPE=\"checkbox\" NAME=\"app\" VALUE=\"" - ++ atom_to_list(Tool) ++ "\"> - " ++ Name ++ " - </TD></TR>" - end, - Apps). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Collecting the data from the *.tool files %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------- -% get_tools(Dirs) => [{M,F,A},{M,F,A}...{M,F,A}] -% Dirs - [string()] Directory names -% Calls get_tools2/2 recursively for a number of directories -% to retireve the configuration data for the web based tools. -%---------------------------------------- -get_tools1(Dirs)-> - get_tools1(Dirs,[]). - -get_tools1([Dir|Rest],Data) when is_list(Dir) -> - Tools=case filename:basename(Dir) of - %% Dir is an 'ebin' directory, check in '../priv' as well - "ebin" -> - [get_tools2(filename:join(filename:dirname(Dir),"priv")) | - get_tools2(Dir)]; - _ -> - get_tools2(Dir) - end, - get_tools1(Rest,[Tools|Data]); - -get_tools1([],Data) -> - lists:flatten(Data). - -%---------------------------------------- -% get_tools2(Directory) => DataList -% DataList : [WebTuple]|[] -% WebTuple: {tool,[{web,M,F,A}]} -% -%---------------------------------------- -get_tools2(Dir)-> - get_tools2(tool_files(Dir),[]). - -get_tools2([ToolFile|Rest],Data) -> - case get_tools3(ToolFile) of - {tool,WebData} -> - get_tools2(Rest,[{tool,WebData}|Data]); - {error,_Reason} -> - get_tools2(Rest,Data); - nodata -> - get_tools2(Rest,Data) - end; - -get_tools2([],Data) -> - Data. - -%---------------------------------------- -% get_tools3(ToolFile) => {ok,Tool}|{error,Reason}|nodata -% Tool: {tool,[KeyValTuple]} -% ToolFile - string() A .tool file -% Now we have the file get the data and sort it out -%---------------------------------------- -get_tools3(ToolFile) -> - case file:consult(ToolFile) of - {error,open} -> - {error,nofile}; - {error,read} -> - {error,format}; - {ok,[{version,"1.2"},ToolInfo]} when is_list(ToolInfo)-> - webdata(ToolInfo); - {ok,[{version,_Vsn},_Info]} -> - {error,old_version}; - {ok,_Other} -> - {error,format} - end. - - -%---------------------------------------------------------------------- -% webdata(TupleList)-> ToolTuple| nodata -% ToolTuple: {tool,[{config_func,{M,F,A}}]} -% -% There are a little unneccesary work in this format but it is extendable -%---------------------------------------------------------------------- -webdata(TupleList)-> - case proplists:get_value(config_func,TupleList,nodata) of - {M,F,A} -> - {tool,[{config_func,{M,F,A}}]}; - _ -> - nodata - end. - - -%============================================================================= -% Functions for getting *.tool configuration files -%============================================================================= - -%---------------------------------------- -% tool_files(Dir) => ToolFiles -% Dir - string() Directory name -% ToolFiles - [string()] -% Return the list of all files in Dir ending with .tool (appended to Dir) -%---------------------------------------- -tool_files(Dir) -> - case file:list_dir(Dir) of - {ok,Files} -> - filter_tool_files(Dir,Files); - {error,_Reason} -> - [] - end. - -%---------------------------------------- -% filter_tool_files(Dir,Files) => ToolFiles -% Dir - string() Directory name -% Files, ToolFiles - [string()] File names -% Filters out the files in Files ending with .tool and append them to Dir -%---------------------------------------- -filter_tool_files(_Dir,[]) -> - []; -filter_tool_files(Dir,[File|Rest]) -> - case filename:extension(File) of - ".tool" -> - [filename:join(Dir,File)|filter_tool_files(Dir,Rest)]; - _ -> - filter_tool_files(Dir,Rest) - end. - - -%%%----------------------------------------------------------------- -%%% format functions -ffunc({M,F,A}) when is_list(A) -> - io_lib:format("~w:~tw(~ts)\n",[M,F,format_args(A)]); -ffunc({M,F,A}) when is_integer(A) -> - io_lib:format("~w:~tw/~w\n",[M,F,A]). - -format_args([]) -> - ""; -format_args(Args) -> - Str = lists:append(["~tp"|lists:duplicate(length(Args)-1,",~tp")]), - io_lib:format(Str,Args). diff --git a/lib/common_test/src/ct_webtool_sup.erl b/lib/common_test/src/ct_webtool_sup.erl deleted file mode 100644 index 04fbbf8745..0000000000 --- a/lib/common_test/src/ct_webtool_sup.erl +++ /dev/null @@ -1,76 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(ct_webtool_sup). - --behaviour(supervisor). - -%% External exports --export([start_link/0,stop/1]). - -%% supervisor callbacks --export([init/1]). - -%%%---------------------------------------------------------------------- -%%% API -%%%---------------------------------------------------------------------- -start_link() -> - supervisor:start_link({local,ct_websup},ct_webtool_sup, []). - -stop(Pid)-> - exit(Pid,normal). -%%%---------------------------------------------------------------------- -%%% Callback functions from supervisor -%%%---------------------------------------------------------------------- - -%%---------------------------------------------------------------------- -%% Func: init/1 -%% Returns: {ok, {SupFlags, [ChildSpec]}} | -%% ignore | -%% {error, Reason} -%%---------------------------------------------------------------------- -init(_StartArgs) -> - ct_util:mark_process(), - %%Child1 = - %%Child2 ={webcover_backend,{webcover_backend,start_link,[]},permanent,2000,worker,[webcover_backend]}, - %%{ok,{{simple_one_for_one,5,10},[Child1]}}. - {ok,{{one_for_one,100,10},[]}}. - -%%%---------------------------------------------------------------------- -%%% Internal functions -%%%---------------------------------------------------------------------- - - - - - - - - - - - - - - - - - - - diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl deleted file mode 100644 index 38e549d2d6..0000000000 --- a/lib/common_test/src/vts.erl +++ /dev/null @@ -1,927 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - --module(vts). - --export([start/0, - init_data/5, - stop/0, - report/2]). - --export([config_data/0, - start_link/0]). - --export([start_page/2, - title_frame/2, - menu_frame/2, - welcome_frame/2, - config_frame/2, - browse_config_file/2, - add_config_file/2, - remove_config_file/2, - run_frame/2, - add_test_dir/2, - remove_test_dir/2, - select_case/2, - select_suite/2, - run_test/2, - result_frameset/2, - result_summary_frame/2, - no_result_log_frame/2, - redirect_to_result_log_frame/2]). - --export([test_info/3]). - --define(START_PAGE,"/vts_erl/vts/start_page"). - --define(tests,vts_tests). - -%% Colors --define(INFO_BG_COLOR,"#C0C0EA"). - --record(state,{tests=[],config=[],event_handler=[],test_runner, - running=0,reload_results=false,start_dir,current_log_dir, - logopts=[],total=0,ok=0,fail=0,skip=0,testruns=[]}). - - -%%%----------------------------------------------------------------- -%%% User API -start() -> - {ok, _} = ct_webtool:start(), - ct_webtool:start_tools([],"app=vts"). - -init_data(ConfigFiles,EvHandlers,LogDir,LogOpts,Tests) -> - call({init_data,ConfigFiles,EvHandlers,LogDir,LogOpts,Tests}). - -stop() -> - ct_webtool:stop_tools([],"app=vts"), - ct_webtool:stop(). - -report(What,Data) -> - call({report,What,Data}). - -%%%----------------------------------------------------------------- -%%% Return config data used by ct_webtool -config_data() -> - {ok,LogDir} = - case lists:keysearch(logdir,1,init:get_arguments()) of - {value,{logdir,[LogD]}} -> {ok,filename:absname(LogD)}; - false -> file:get_cwd() - end, - {vts, - [{web_data,{"VisualTestServer",?START_PAGE}}, - {alias,{erl_alias,"/vts_erl",[?MODULE]}}, - {alias,{"/log_dir",LogDir}}, - {start,{child,{{local,?MODULE}, - {?MODULE,start_link,[]}, - permanent,100,worker,[?MODULE]}}} - ]}. - -start_link() -> - case whereis(?MODULE) of - undefined -> - Self = self(), - Pid = spawn_link(fun() -> init(Self) end), - MRef = erlang:monitor(process,Pid), - receive - {Pid,started} -> - erlang:demonitor(MRef, [flush]), - {ok,Pid}; - {'DOWN',MRef,process,_,Reason} -> - {error,{vts,died,Reason}} - end; - Pid -> - {ok,Pid} - end. - -start_page(_Env,_Input) -> - call(start_page). -title_frame(_Env,_Input) -> - call(title_frame). -welcome_frame(_Env,_Input) -> - call(welcome_frame). -menu_frame(_Env,_Input) -> - call(menu_frame). -config_frame(_Env,_Input) -> - call(config_frame). -browse_config_file(_Env,Input) -> - call({browse_config_file,Input}). -add_config_file(_Env,Input) -> - call({add_config_file,Input}). -remove_config_file(_Env,Input) -> - call({remove_config_file,Input}). -run_frame(_Env,_Input) -> - call(run_frame). -add_test_dir(_Env,Input) -> - call({add_test_dir,Input}). -remove_test_dir(_Env,Input) -> - call({remove_test_dir,Input}). -select_suite(_Env,Input) -> - call({select_suite,Input}). -select_case(_Env,Input) -> - call({select_case,Input}). -run_test(_Env,_Input) -> - call(run_test). -result_frameset(_Env,_Input) -> - call(result_frameset). -redirect_to_result_log_frame(_Env,_Input) -> - call(redirect_to_result_log_frame). -result_summary_frame(_Env,_Input) -> - call(result_summary_frame). -no_result_log_frame(_Env,_Input) -> - call(no_result_log_frame). - -aborted() -> - call(aborted). - -test_info(_VtsPid,Type,Data) -> - call({test_info,Type,Data}). - -init(Parent) -> - register(?MODULE,self()), - process_flag(trap_exit,true), - ct_util:mark_process(), - Parent ! {self(),started}, - {ok,Cwd} = file:get_cwd(), - InitState = #state{start_dir=Cwd}, - loop(InitState). - -loop(State) -> - receive - {{init_data,Config,EvHandlers,LogDir,LogOpts,Tests},From} -> - %% ct:pal("State#state.current_log_dir=~p", [State#state.current_log_dir]), - NewState = State#state{config=Config,event_handler=EvHandlers, - current_log_dir=LogDir, - logopts=LogOpts,tests=Tests}, - _ = ct_install(NewState), - return(From,ok), - loop(NewState); - {start_page,From} -> - return(From,start_page1()), - loop(State); - {title_frame,From} -> - return(From,title_frame1()), - loop(State); - {welcome_frame,From} -> - return(From,welcome_frame1()), - loop(State); - {menu_frame,From} -> - return(From,menu_frame1()), - loop(State); - {config_frame,From} -> - return(From,config_frame1(State)), - loop(State); - {{browse_config_file,_Input},From} -> - return(From,ok), - loop(State); - {{add_config_file,Input},From} -> - {Return,State1} = add_config_file1(Input,State), - _ = ct_install(State1), - return(From,Return), - loop(State1); - {{remove_config_file,Input},From} -> - {Return,State1} = remove_config_file1(Input,State), - _ = ct_install(State1), - return(From,Return), - loop(State1); - {run_frame,From} -> - return(From,run_frame1(State)), - loop(State); - {{add_test_dir,Input},From} -> - {Return,State1} = add_test_dir1(Input,State), - return(From,Return), - loop(State1); - {{remove_test_dir,Input},From} -> - {Return,State1} = remove_test_dir1(Input,State), - return(From,Return), - loop(State1); - {{select_suite,Input},From} -> - {Return,State1} = select_suite1(Input,State), - return(From,Return), - loop(State1); - {{select_case,Input},From} -> - {Return,State1} = select_case1(Input,State), - return(From,Return), - loop(State1); - {run_test,From} -> - State1 = run_test1(State), - return(From,redirect_to_result_frameset1()), - loop(State1); - {result_frameset,From} -> - return(From,result_frameset1(State)), - loop(State); - {redirect_to_result_log_frame,From} -> - return(From,redirect_to_result_log_frame1(State)), - loop(State); - {result_summary_frame,From} -> - return(From,result_summary_frame1(State)), - loop(State); - stop_reload_results -> - ok = file:set_cwd(State#state.start_dir), - loop(State#state{reload_results=false}); - {no_result_log_frame,From} -> - return(From,no_result_log_frame1()), - loop(State); - {aborted,From} -> - return(From,ok), - loop(State#state{test_runner=undefined,running=0}); - {{report,What,Data},From} -> - State1 = report1(What,Data,State), - return(From,ok), - loop(State1); - {stop,From} -> - return(From,ok); - {'EXIT',Pid,Reason} -> - case State#state.test_runner of - Pid -> - io:format("Test run error: ~tp\n",[Reason]), - loop(State); - _ -> - loop(State) - end; - {{test_info,_Type,_Data},From} -> - return(From,ok), - loop(State) - end. - -call(Msg) -> - case whereis(?MODULE) of - undefined -> {error,no_proc}; - Pid -> - MRef = erlang:monitor(process,Pid), - Ref = make_ref(), - Pid ! {Msg,{self(),Ref}}, - receive - {Ref, Result} -> - erlang:demonitor(MRef, [flush]), - Result; - {'DOWN',MRef,process,_,Reason} -> - {error,{process_down,Pid,Reason}} - end - end. - -return({To,Ref},Result) -> - To ! {Ref, Result}, - ok. - -run_test1(State=#state{tests=Tests,current_log_dir=LogDir, - logopts=LogOpts}) -> - Self=self(), - RunTest = fun() -> - ct_util:mark_process(), - case ct_run:do_run(Tests,[],LogDir,LogOpts) of - {error,_Reason} -> - aborted(); - _ -> - ok - end, - unlink(Self) - end, - Pid = spawn_link(RunTest), - {Total,Tests1} = - receive - {{test_info,start_info,{_,_,Cases}},From} -> - return(From,ok), - {Cases,Tests}; - EXIT = {'EXIT',_,_} -> - self() ! EXIT, - {0,[]} - after 30000 -> - {0,[]} - end, - State#state{test_runner=Pid,running=length(Tests1), - total=Total,ok=0,fail=0,skip=0,testruns=[]}. - - -ct_install(#state{config=Config,event_handler=EvHandlers, - current_log_dir=LogDir}) -> - ct_run:install([{config,Config},{event_handler,EvHandlers}],LogDir). -%%%----------------------------------------------------------------- -%%% HTML -start_page1() -> - header("Visual Test Server Start Page",start_page_frameset()). - -start_page_frameset() -> - frameset( - "ROWS=\"60,*\"", - [frame(["NAME=\"title\" SRC=\"./title_frame\""]), - frameset( - "COLS=\"150,*\"", - [frame(["NAME=\"menu\" SRC=\"./menu_frame\""]), - frame(["NAME=\"main\" SRC=\"./welcome_frame\""])])]). - - -title_frame1() -> - header(body("BGCOLOR=lightgrey TEXT=darkgreen",title_body())). - -title_body() -> - p("ALIGN=center",font("SIZE=\"+3\"",b("Visual Test Server"))). - -welcome_frame1() -> - header(body(welcome_body())). - -welcome_body() -> - table( - "WIDTH=100% HEIGHT=60%", - [tr("VALIGN=middle", - td("ALIGN=center", - font("SIZE=6", - ["Welcome to the",br(), - "Visual Test Server"])))]). - -menu_frame1() -> - header(body(menu_body())). - -menu_body() -> - [h2("Content"), - ul([ - li(href(["TARGET=\"main\""],"./config_frame","Config")), - li(href(["TARGET=\"main\""],"./run_frame","Run")), - li(href(["TARGET=\"main\""],"./result_frameset","Result")) - ]), - h2("Logs"), - ul([ - li(href(["TARGET=\"new\""],"/log_dir/index.html","Last Runs")), - li(href(["TARGET=\"new\""],"/log_dir/all_runs.html","All Runs")) - ]) - ]. - -config_frame1(State) -> - header("Config",body(config_body(State))). - -config_body(State) -> - Entry = [input("TYPE=file NAME=browse SIZE=40"), - input("TYPE=hidden NAME=file")], - BrowseForm = - form( - "NAME=read_file_form METHOD=post ACTION=\"./browse_config_file\"", - table( - "BORDER=0", - [tr(td("1. Locate config file")), - tr(td(Entry))])), - AddForm = - form( - "NAME=add_file_form METHOD=post ACTION=\"./add_config_file\"", - table( - "BORDER=0", - [tr(td("2. Paste full config file name here")), - tr( - [td(input("TYPE=text NAME=file SIZE=40")), - td("ALIGN=center", - input("TYPE=submit onClick=\"file.value=browse.value;\"" - " VALUE=\"Add\""))])])), - - {Text,RemoveForm} = - case State#state.config of - [] -> - T = "Before running the tests, one or more configuration " - "files may be added. Locate the config file, copy its " - "full name, paste this into the text field below, then " - "click the \"Add\" button.", - R = "", - {T,R}; - Files -> - T = "The currently known configuration files are listed below. " - "To add a file, type the filename in the entry and " - "click the \"Add\" button. " - "To remove a file, select it and click the \"Remove\" " - "button.", - ConfigFiles = [option(File) || File <- Files], - Select = select("NAME=file TITLE=\"Select Config File\"" - " MULTIPLE=true", - ConfigFiles), - R = - form(["NAME=remove_config METHOD=post ", - "ACTION=\"./remove_config_file\""], - table( - "BORDER=0", - [tr(td("ALIGN=center",Select)), - tr(td("ALIGN=center", - input("TYPE=submit VALUE=\"Remove\"")))])), - {T,R} - end, - - [h1("ALIGN=center","Config"), - table( - "WIDTH=450 ALIGN=center CELLPADDING=5", - [tr(td(["BGCOLOR=",?INFO_BG_COLOR],Text)), - tr(td("")), - tr(td("")), - tr(td("ALIGN=left",BrowseForm)), - tr(td("ALIGN=left",AddForm)), - tr(td("ALIGN=left",RemoveForm))])]. - -add_config_file1(Input,State) -> - State1 = - case get_input_data(Input,"file") of - "" -> - State; - File -> - State#state{config=[File|State#state.config]} - end, - Return = config_frame1(State1), - {Return,State1}. - -remove_config_file1(Input,State) -> - Files = get_all_input_data(Input,"file"), - State1 = State#state{config=State#state.config--Files}, - Return = config_frame1(State1), - {Return,State1}. - - - -run_frame1(State) -> - header("Run Test",body(run_body(State))). - -run_body(#state{running=Running}) when Running>0 -> - [h1("ALIGN=center","Run Test"), - p(["Test are ongoing: ",href("./result_frameset","Results")])]; -run_body(State) -> - ConfigList = - case State#state.config of - [] -> - ul(["none"]); - CfgFiles -> - ul([li(File) || File <- CfgFiles]) - end, - ConfigFiles = [h3("Config Files"), - ConfigList], - {ok,CWD} = file:get_cwd(), - CurrWD = [h3("Current Working Directory"), ul(CWD)], - AddDirForm = - form( - "NAME=add_dir_form METHOD=post ACTION=\"./add_test_dir\"", - table( - "BORDER=0", - [tr(td("COLSPAN=2","Enter test directory")), - tr( - [td(input("TYPE=text NAME=dir SIZE=40")), - td("ALIGN=center", - input("TYPE=submit onClick=\"dir.value=browse.value;\"" - " VALUE=\"Add Test Dir\""))])])), - {LoadedTestsTable,Submit} = - case create_testdir_entries(State#state.tests,1) of - [] -> {"",""}; - TestDirs -> - Heading = tr([th(""), - th("ALIGN=left","Directory"), - th("ALIGN=left","Suite"), - th("ALIGN=left","Case")]), - {table("CELLPADDING=5",[Heading,TestDirs]), - submit_button()} - end, - Body = - table( - "WIDTH=450 ALIGN=center", - [tr(td("")), - tr(td("")), - tr(td(ConfigFiles)), - tr(td("")), - tr(td(CurrWD)), - tr(td("")), - tr(td(AddDirForm)), - tr(td("")), - tr(td(LoadedTestsTable)), - tr(td(Submit)) - ]), - [h1("ALIGN=center","Run Test"), Body]. - -create_testdir_entries([{Dir,Suite,Case}|Tests],N) -> - [testdir_entry(Dir,Suite,Case,N)|create_testdir_entries(Tests,N+1)]; -create_testdir_entries([],_N) -> - []. - -testdir_entry(Dir,Suite,Case,N) -> - NStr = vts_integer_to_list(N), - tr([td(delete_button(NStr)), - td(Dir), - td(suite_select(Dir,Suite,NStr)), - td(case_select(Dir,Suite,Case,NStr))]). - -delete_button(N) -> - form(["NAME=remove_dir_form METHOD=post ACTION=\"./remove_test_dir\""], - [input(["TYPE=hidden NAME=dir VALUE=\'",N,"\'"]), - input(["TYPE=submit VALUE=X"])]). - -suite_select(Dir,Suite,N) -> - case filelib:wildcard(filename:join(Dir,"*_SUITE.erl")) of - [] -> - select("NAME=suite TITLE=\"Select suite\"",""); - Suites0 -> - Suites = [filename:basename(filename:rootname(S)) || S <- Suites0], - select("NAME=suite TITLE=\"Select suite\"", - options(["all"|Suites],atom_to_list(Suite),N,"select_suite")) - end. - -case_select(_Dir,all,_,N) -> - select("NAME=case TITLE=\"Select case\"", - options(["all"],"all",N,"select_case")); -case_select(Dir,Suite,Case,N) -> - MakeResult = - case application:get_env(common_test, auto_compile) of - {ok,false} -> - ok; - _ -> - UserInclude = - case application:get_env(common_test, include) of - {ok,UserInclDirs} when length(UserInclDirs) > 0 -> - [{i,UserInclDir} || UserInclDir <- UserInclDirs]; - _ -> - [] - end, - ct_run:run_make(Dir,Suite,UserInclude) - end, - case MakeResult of - ok -> - true = code:add_pathz(Dir), - case catch apply(Suite,all,[]) of - {'EXIT',Reason} -> - io:format("\n~tp\n",[Reason]), - red(["COULD NOT READ TESTCASES!!",br(), - "See erlang shell for info"]); - {skip,_Reason} -> - select("NAME=case TITLE=\"Select case\"", - options(["all"],"all",N,"select_case")); - AllCasesAtoms -> - AllCases = [atom_to_list(C) || C <- AllCasesAtoms, - is_atom(C)], - select("NAME=case TITLE=\"Select case\"", - options(["all"|AllCases],atom_to_list(Case), - N,"select_case")) - end; - _Error -> - red(["COMPILATION ERROR!!",br(), - "See erlang shell for info",br(), - "Reload this page when errors are fixed"]) - end. - - -options([Selected|Elements],Selected,N,Func) -> - [option(["SELECTED ", - "onClick=\"document.location.href=\'./",Func,"?n=",N, - "&selected=",Selected,"\';\""], - Selected)| - options(Elements,Selected,N,Func)]; -options([Element|Elements],Selected,N,Func) -> - [option(["onClick=\"document.location.href=\'./",Func,"?n=",N, - "&selected=",Element,"\';\""], - Element)| - options(Elements,Selected,N,Func)]; -options([],_Selected,_N,_Func) -> - []. - -add_test_dir1(Input, State) -> - State1 = - case get_input_data(Input,"dir") of - "" -> State; - Dir0 -> - Dir = case ct_util:is_test_dir(Dir0) of - true -> Dir0; - false -> ct_util:get_testdir(Dir0, all) - end, - case filelib:is_dir(Dir) of - true -> - Test = ct_run:tests(Dir), - State#state{tests=State#state.tests++Test}; - false -> - State - end - end, - Return = run_frame1(State1), - {Return,State1}. - -remove_test_dir1(Input,State) -> - N = list_to_integer(get_input_data(Input,"dir")), - State1 = State#state{tests=delete_test(N,State#state.tests)}, - Return = run_frame1(State1), - {Return,State1}. - -delete_test(1,[_|T]) -> - T; -delete_test(N,[H|T]) -> - [H|delete_test(N-1,T)]. - -select_suite1(Input,State) -> - N = list_to_integer(get_input_data(Input,"n")), - Suite = list_to_atom(get_input_data(Input,"selected")), - Tests1 = replace_suite(N,Suite,State#state.tests), - State1 = State#state{tests=Tests1}, - Return = run_frame1(State1), - {Return,State1}. - -replace_suite(1,Suite,[{Dir,_,_}|T]) -> - [Test] = ct_run:tests(Dir,Suite), - [Test|T]; -replace_suite(N,Suite,[H|T]) -> - [H|replace_suite(N-1,Suite,T)]. - -select_case1(Input,State) -> - N = list_to_integer(get_input_data(Input,"n")), - Case = list_to_atom(get_input_data(Input,"selected")), - Tests1 = replace_case(N,Case,State#state.tests), - State1 = State#state{tests=Tests1}, - Return = run_frame1(State1), - {Return,State1}. - -replace_case(1,Case,[{Dir,Suite,_}|T]) -> - [Test] = ct_run:tests(Dir,Suite,Case), - [Test|T]; -replace_case(N,Case,[H|T]) -> - [H|replace_case(N-1,Case,T)]. - - -submit_button() -> - form(["NAME=run_test_form METHOD=post ACTION=\"./run_test\""], - [input("TYPE=submit VALUE=\"Run Test\"")]). - - -redirect_to_result_frameset1() -> - Head = - ["<META HTTP-EQUIV=\"refresh\" CONTENT=\"1; URL=./result_frameset\">"], - [header("",Head,body("Please wait..."))]. - -result_frameset1(State) -> - header("Results",result_frameset2(State)). - -result_frameset2(State) -> - ResultLog = - case {State#state.current_log_dir,State#state.running} of - {undefined,0} -> - "./no_result_log_frame"; - {undefined,_} -> - "./redirect_to_result_log_frame"; - {_Dir,0} -> - filename:join(["/log_dir","index.html"]); - {_Dir,_} when State#state.testruns == [] -> - %% crash before first test - "./no_result_log_frame"; - {_Dir,_} -> - {_,CurrentLog} = hd(State#state.testruns), - CurrentLog - end, - frameset( - "COLS=\"200,*\"", - [frame(["NAME=\"result_summary\" SRC=\"./result_summary_frame\""]), - frame(["NAME=\"result_log\" SRC=\"",ResultLog,"\""])]). - -redirect_to_result_log_frame1(State) -> - ResultLog = - case {State#state.testruns,State#state.running} of - {[],0} -> - "./no_result_log_frame"; - {[],_} -> - "./redirect_to_result_log_frame"; - {[{_,CurrentLog}|_],_} -> - CurrentLog - end, - Head = ["<META HTTP-EQUIV=\"refresh\" CONTENT=\"1; URL=",ResultLog,"\">"], - [header("",Head,body("Please wait..."))]. - -result_summary_frame1(State) -> - case {State#state.running,State#state.reload_results} of - {0,false} -> - header("Result Summary",body(result_summary_body(State))); - _ -> - Head = - "<SCRIPT LANGUAGE=\"JavaScript1.2\">\n" - "\n" - "function startReloadInterval() {\n" - " intervalId = setInterval(\"reloadPage()\",5000)\n" - "}\n" - "\n" - "function reloadPage() {\n" - " location.reload()\n" - " parent.result_log.location.reload()\n" -% " parent.result_log.scrollBy(0, window.innerHeight)\n" - "}\n" - "</SCRIPT>\n", - header("Result Summary",Head, - body("onLoad=\"startReloadInterval()\" BGCOLOR=\"#FFFFFF\"", - result_summary_body(State))) - end. - -result_summary_body(State) -> - N = State#state.ok + State#state.fail + State#state.skip, - [h2("Result Summary"), - p([b(vts_integer_to_list(N))," cases executed (of ", - b(vts_integer_to_list(State#state.total)),")"]), - p([green([b(vts_integer_to_list(State#state.ok))," successful"]),br(), - red([b(vts_integer_to_list(State#state.fail))," failed"]),br(), - orange([b(vts_integer_to_list(State#state.skip))," skipped"])]), - executed_test_list(State)]. - -executed_test_list(#state{testruns=[]}) -> - []; -executed_test_list(#state{testruns=TestRuns}) -> - [h2("Executed Tests"), - table( - "", - [tr(td(href("TARGET=\"result_log\"",Log,Name))) || - {Name,Log} <- lists:reverse(TestRuns)])]. - - -no_result_log_frame1() -> - header("Test Results",body(no_result_log_body())). - -no_result_log_body() -> - [h1("ALIGN=center","Test Results"), - p(["There are currently no test results available. ", - br(),href("TARGET=\"main\"","./run_frame","You can run tests here")])]. - -report1(tests_start,{TestName,_N},State) -> - {ok,LogDir} = ct_logs:get_log_dir(), - TestRuns = - case State#state.testruns of - [{TestName,_}|_]=TR -> - TR; - TR -> - [{TestName,get_test_log(TestName,LogDir)}|TR] - end, - State#state{testruns=TestRuns}; -report1(tests_done,{_Ok,_Fail,_Skip},State) -> - {ok, _} = timer:send_after(5000, self(),stop_reload_results), - State#state{running=State#state.running-1,reload_results=true}; -report1(tc_start,{_Suite,_Case},State) -> - State; -report1(tc_done,{_Suite,init_per_suite,_},State) -> - State; -report1(tc_done,{_Suite,end_per_suite,_},State) -> - State; -report1(tc_done,{_Suite,init_per_group,_},State) -> - State; -report1(tc_done,{_Suite,end_per_group,_},State) -> - State; -report1(tc_done,{_Suite,_Case,ok},State) -> - State#state{ok=State#state.ok+1}; -report1(tc_done,{_Suite,_Case,{failed,_Reason}},State) -> - State#state{fail=State#state.fail+1}; -report1(tc_done,{_Suite,_Case,{skipped,_Reason}},State) -> - State#state{skip=State#state.skip+1}; -report1(tc_user_skip,{_Suite,_Case,_Reason},State) -> - State#state{skip=State#state.skip+1}; -report1(tc_auto_skip,{_Suite,_Case,_Reason},State) -> - State#state{skip=State#state.skip+1}; -report1(loginfo,_,State) -> - State. - -get_test_log(TestName,LogDir) -> - [Log] = - filelib:wildcard( - filename:join([TestName++".logs","run*","suite.log.html"])), - filename:join(["/log_dir",LogDir,Log]). - - - -%get_description(Suite,Case) -> -% case erlang:function_exported(Suite,Case,0) of -% true -> -% case catch apply(Suite,Case,[]) of -% {'EXIT',_Reason} -> -% "-"; -% Info -> -% case lists:keysearch(doc,1,Info) of -% {value,{doc,Doc}} when is_list(Doc) -> -% Doc; -% _ -> -% "-" -% end -% end; -% false -> -% "-" -% end. - -%%%----------------------------------------------------------------- -%%% Internal library -header(Body) -> - header("","",Body). -header(Title,Body) -> - header(Title,"",Body). -header(Title,Head,Body) -> - ["Pragma:no-cache\r\n", - "Content-type: text/html\r\n\r\n", - html_header(Title,Head,Body)]. - -html_header(Title,Head,Body) -> - ["<HTML>\n", - "<HEAD>\n", - "<TITLE>", Title, "</TITLE>\n", - Head, - "</HEAD>\n", - Body, - "</HTML>"]. - -body(Text) -> - ["<BODY BGCOLOR=\"#FFFFFF\">\n",Text,"<\BODY>\n"]. -body(Args,Text) -> - ["<BODY ", Args, ">\n", Text,"<\BODY>\n"]. - - -frameset(Args,Frames) -> - ["<FRAMESET ",Args,">\n", Frames, "\n</FRAMESET>\n"]. -frame(Args) -> - ["<FRAME ",Args, ">\n"]. - -table(Args,Text) -> - ["<TABLE ", Args, ">\n", Text, "\n</TABLE>\n"]. -tr(Text) -> - ["<TR>\n", Text, "\n</TR>\n"]. -tr(Args,Text) -> - ["<TR ", Args, ">\n", Text, "\n</TR>\n"]. -th(Text) -> - ["<TH>", Text, "</TH>"]. -th(Args,Text) -> - ["<TH ", Args, ">\n", Text, "\n</TH>\n"]. -td(Text) -> - ["<TD>", Text, "</TD>"]. -td(Args,Text) -> - ["<TD ", Args, ">", Text, "</TD>"]. - -b(Text) -> - ["<B>",Text,"</B>"]. -%em(Text) -> -% ["<EM>",Text,"</EM>\n"]. -%pre(Text) -> -% ["<PRE>",Text,"</PRE>"]. -href(Link,Text) -> - ["<A HREF=\"",Link,"\">",Text,"</A>"]. -href(Args,Link,Text) -> - ["<A HREF=\"",Link,"\" ",Args,">",Text,"</A>"]. -form(Args,Text) -> - ["<FORM ",Args,">\n",Text,"\n</FORM>\n"]. -input(Args) -> - ["<INPUT ", Args, ">\n"]. -select(Args,Text) -> - ["<SELECT ", Args, ">\n", Text, "\n</SELECT>\n"]. -option(Text) -> - ["<OPTION>\n", Text, "\n</OPTION>\n"]. -option(Args,Text) -> - ["<OPTION ", Args, ">\n", Text, "\n</OPTION>\n"]. -h1(Args,Text) -> - ["<H1 ", Args, ">",Text,"</H1>\n"]. -h2(Text) -> - ["<H2>",Text,"</H2>\n"]. -h3(Text) -> - ["<H3>",Text,"</H3>\n"]. -%%h4(Text) -> -%% ["<H4>",Text,"</H4>\n"]. -font(Args,Text) -> - ["<FONT ",Args,">\n",Text,"\n</FONT>\n"]. -p(Text) -> - ["<P>",Text,"</P>\n"]. -p(Args, Text) -> - ["<P ", Args, ">",Text,"</P>\n"]. -ul(Text) -> - ["<UL>", Text, "</UL>\n"]. -li(Text) -> - ["<LI>", Text, "</LI>\n"]. -br() -> - "<BR>\n". - -red(Text) -> color(red,Text). -green(Text) -> color(green,Text). -orange(Text) -> color(orange,Text). -color(Color,Text) when is_atom(Color) -> - font(["COLOR=",atom_to_list(Color)],Text). - -get_all_input_data(Input,Key)-> - List = parse(Input), - get_all_input_data(List,Key,[]). -get_all_input_data([{Key,Value}|List],Key,Acc) -> - get_all_input_data(List,Key,[Value|Acc]); -get_all_input_data([{_OtherKey,_Value}|List],Key,Acc) -> - get_all_input_data(List,Key,Acc); -get_all_input_data([],_Key,Acc) -> - Acc. - -get_input_data(Input,Key)-> - case lists:keysearch(Key,1,parse(Input)) of - {value,{Key,Value}} -> - Value; - false -> - undefined - end. - -parse(Input) -> - uri_string:dissect_query(Input). - -vts_integer_to_list(X) when is_atom(X) -> - atom_to_list(X); -vts_integer_to_list(X) when is_integer(X) -> - integer_to_list(X). diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 388d5d46c6..1d50f4f97f 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -219,17 +219,8 @@ get_opts(Config) -> end, LogDir = case os:getenv("CT_USE_TMP_DIR") of - false -> - case os:type() of - {win32,_} -> - if TempDir == undefined -> PrivDir; - true -> TempDir - end; - _ -> - PrivDir - end; - _ -> - TempDir + false -> PrivDir; + _ -> TempDir end, %% Copy test variables to app environment on new node diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index 8dcb69c1c6..ddc518f474 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.17.3 +COMMON_TEST_VSN = 1.18 |