|
|
|
Example 3 includes a pair of programs designated requester (X25CHECK) and
server (X25SERV) using direct access to X.25 at level 3. These programs must
be compiled in compatibility mode. The X.25 features used in these programs
are the set supported on MPE-V. Example 4 uses the additional X.25 features
supported on MPE XL. The program functions are described in the comments
included with the program listings.
 |
NOTE: 3kRanger made changes
marked by comment {3k} to correct compile errors and simple
enhancements. The PDF manual contains the original code.
Both 3A and 3B include a file: $include
'decl'$. This is shown in the PDF as part of the
program listing.
3kRanger separated that include file
out as Exam3inc.pas, so both programs could include it.
3kRanger does not have X.25 hardware or configured at this time,
so no enhancements could be considered since the programs fail to
create an X.25 socket.
|
Program 3A (X25CHECK)
Download
{NetIPC Example-3-Program3A}
{ MPEV pascalprep netipc3a,netipc3a.pub;info="set 'native=false'"}
{ MPEiX pasxllk netipc3a,netipc3x.pub,,,"set 'native=true'" }
$list off$
{*****************************************************************}
{ }
{ SOURCE : CHECK }
{ }
{ DESCRIPTION : }
{ Simplified version. }
{ This program checks that connections to remote nodes or even }
{ to local node can be actually achieved. It also allows to }
{ estimate the performances of the network. It communicates with }
{ program X25SERV that runs on remote nodes. }
{ X25CHECK sends 10 times a message to the remote server which }
{ echoes them back. }
{ It checks for both connection and communication errors. }
{ This version of X25CHECK is not compatible with the version of }
{ the product (doesn't work with the official server). }
{ Compile in compatibility mode. }
{*****************************************************************}
$if 'native'$
$standard_level 'HP_PASCAL'$ {3k}
$else$
$standard_level 'HP3000'$ {3k}
$uslinit$ {3k}
$endif$
$GLOBAL$
PROGRAM x25chk ( input, output );
{$include 'decl'$}
$include 'Exam3inc.pas'$ {3k}
FUNCTION ask_y_n : boolean;
var
c : string [1];
begin {ask_y_n}
repeat
writeln;
prompt ('Do you want to run the test once again?(y/n) >> ');
readln (c);
until (c='y') or (c='Y') or (c='n') or (c='N') or (c='');
if (c='y') or (c='Y') then ask_y_n := true
else ask_y_n := false;
end; {ask_y_n}
PROCEDURE check ( result : integer;
event : event_type );
var
msg : string [80];
len : integer;
r : integer;
begin {check}
IPCErrmsg ( result, msg, len, r );
setstrlen (msg,len);
if r <> 0 then begin
writeln ('Can''t get the error message ...');
QUIT (123);
end else begin
writeln ('An error occurred during ', c_event_msg [event]);
writeln ('with the following identification : ');
writeln (msg);
p_retry := ask_y_n;
end;
end; {check}
{----------------------INIT_desc-----------------------------------}
{ Create call descriptor with dedicated protocol relative address }
{ Create destination desc to connect with the server }
{------------------------------------------------------------------}
PROCEDURE init_desc ( var rc : rc_type );
var
j, prot_addr : shint;
opt : opt_type;
net_name,
node_name : string [8];
net_name_len,
node_name_len : shint;
begin
{----------------------------------}
{ Creation of the call descriptor. }
{----------------------------------}
Initopt ( opt, 2, r );
if r <> 0 then begin
check ( r, i_addopt );
rc := no_call_desc;
end else
begin {initopt}
prot_addr := c_prot_addr_x25chk;
Addopt ( opt, 0, c_prot_add_code, 2, prot_addr, r );
if r <> 0 then
begin
check ( r, i_addopt );
rc := no_call_desc;
end else begin
prompt
('Enter the name of the network you are working on >> ');
readln (net_name);
net_name_len := strlen (net_name);
Addopt ( opt, 1, c_net_name_code, net_name_len, net_name,
r );
if r <> 0 then begin
check ( r, i_addopt );
rc := no_call_desc;
end else begin
writeln ( '--- IPCCreate' ); {3k}
IPCCreate ( 3, 2,, opt, p_call_desc, result );
if result <> 0 then begin
check ( result, i_create );
rc := no_call_desc;
end else begin
{------------------------------------}
{Creation of the destination desc }
{------------------------------------}
writeln;
prompt
('Enter the name of the node you want to check >> ');
readln (node_name);
node_name_len := strlen (node_name);
prot_addr := c_prot_addr_server;
writeln ( '--- IPCDest' ); {3k}
IPCDest ( 3, node_name, node_name_len, 2, prot_addr,
2,,, p_dest_desc, result );
if result <> 0 then begin
check ( result, i_dest );
rc := no_dest_desc;
end;{else dest}
end;{else create}
end;{else addopt}
end;{else addopt}
end;{else initopt}
end;{init_desc}
{------------------------------CONNECT-----------------------------}
{ Send CALL to the server and wait for CALL CONF }
{ Evaluate the set up time }
{------------------------------------------------------------------}
PROCEDURE connect ( var rc : rc_type );
var
chrono : integer;
begin
chrono := timer;
{------------------------------------}
{ Send CALL packet to remote server }
{------------------------------------}
writeln ( '--- IPCConnect' ); {3k}
IPCConnect ( p_call_desc, p_dest_desc,,, p_vc_desc, result );
if result <> 0 then begin
check ( result, i_connect );
rc := no_vc_desc;
end else begin
writeln ('CALL packet sent ...');
{------------------------------------}
{Get CALL CONF packet from the server}
{------------------------------------}
writeln ( '--- IPCRecv' ); {3k}
IPCRecv ( p_vc_desc,,,,, result );
p_set_up_time := timer-chrono;
if result <> 0 then begin
check ( result, i_recv_call_conf );
rc := error;
end else begin
writeln ('CALL CONF packet received ...');
writeln;
end;
{-----------------------------------}
{ The connection is now opened. }
{-----------------------------------}
end; {else connect}
end; {connect}
PROCEDURE data_transfer ( var rc : rc_type );
var
buffer : buffer_type;
buffer_len : integer;
chrono : integer;
i : shint;
{-------------------------DATA_TRANSFER----------------------------}
{ PURPOSE : Manage the data transfer with the server }
{ Evaluate the transit time }
{------------------------------------------------------------------}
begin {data transfer}
i := 1;
chrono := timer;
while (i <= c_nb_loop) and (rc = done) do begin
buffer := c_patern;
buffer_len := c_buffer_len;
{-----------------------------------}
{ Send data packet on the line. }
{-----------------------------------}
IPCSend ( p_vc_desc, buffer, buffer_len,,, result );
writeln ('DATA packet sent ...');
if result <> 0 then begin
check ( result, i_send );
rc := error;
end else begin
{-----------------------------------}
{ Receive data packet echoed by the }
{ remote server. }
{-----------------------------------}
writeln ( '--- IPCRecv' ); {3k}
IPCRecv ( p_vc_desc, buffer, buffer_len,,, result );
writeln ('DATA packet received ...');
writeln;
if result <> 0 then begin
check ( result, i_recv );
rc := error;
end else
i := i+1;
end;{else send}
end;{while}
p_transit_time := timer - chrono;
end;{data transfer}
{-------------------------SHUTDOWN---------------------------------}
{ PURPOSE : Shutdown call, destination and vc descriptor }
{ according to the value of rc. }
{ Display the results of set up and transit time }
{ Ask to retry }
{------------------------------------------------------------------}
PROCEDURE shutdown;
begin
if rc <= error then begin
{----------------------------------}
{ Shutdown the vc descriptor. }
{ Send CLEAR on the line. }
{----------------------------------}
IPCShutdown ( p_vc_desc,,, result );
if result <> 0 then check ( result, i_shut_connection );
writeln ('CLEAR packet sent ...');
end;
if rc <= no_vc_desc then begin
{----------------------------------}
{ Shutdown the destination desc. }
{----------------------------------}
IPCShutdown ( p_dest_desc,,, result );
if result <> 0 then check ( result, i_shut_dest );
end;
if rc <= no_dest_desc then begin
{----------------------------------}
{ Shutdown the call descriptor. }
{----------------------------------}
IPCSHUTDOWN ( p_call_desc,,, result );
if result <> 0 then check ( result, i_shut_source )
end;
if rc = done then begin
{----------------------------------}
{ Display the results. }
{----------------------------------}
writeln ('The following figures have been measured on the ',
'network :' );
writeln (' Set up time : ',
p_set_up_time:10,' ms');
writeln (' Transit time : ',
(p_transit_time/(c_nb_loop*2)):10:0,' ms');
p_retry := ask_y_n ;
end;
end;{shutdown}
BEGIN
p_retry := false;
repeat
rc := done;
INIT_DESC ( RC );
if rc = done then begin
CONNECT ( rc );
if rc = done then begin
DATA_TRANSFER ( rc );
end;
end;
SHUTDOWN;
until p_retry = false;
END.
Program 3B (X25SERV)
Download
{NetIPC Example-3-Program3B}
{ MPEV pascalprep netipc3b,netipc3b.pub;info="set 'native=false'"}
{ MPEiX pasxllk netipc3b,netipc3y.pub,,,"set 'native=true'" }
$list off$
{******************************************************************}
{ }
{ SOURCE : X25SERV }
{ }
{ DESCRIPTION : }
{ }
{ The purpose of that program is to answer to a remote program }
{ X25CHECK which verifies that the connections have been actually }
{ established. }
{ The server receives messages and echoes them to the remote }
{ calling node. }
{ The server has a dedicated protocol relative address. }
{ This version of X25SERV is not compatible with the version of }
{ the product. }
{ Compile in compatibility mode. }
{******************************************************************}
$if 'native'$
$standard_level 'HP_PASCAL'$ {3k}
$else$
$standard_level 'HP3000'$ {3k}
$uslinit$ {3k}
$endif$
program x25serv ( input, output );
{$include 'decl'$ {include file of type and constants}
$include 'Exam3inc.pas'$ {3k}
{----------------------------Check_init----------------------------}
{ PURPOSE : Checks the results of IPC calls. Used during the }
{ initialization phase when errors are not discarded but }
{ displayed to the operator. }
{ }
{------------------------------------------------------------------}
PROCEDURE check_init ( result:integer );
VAR
msg : string [80];
msg_len : integer;
r : integer;
BEGIN
if result <> 0 then begin
IPCErrmsg ( result, msg, msg_len, r );
setstrlen (msg,msg_len);
if r <> 0 then begin
writeln('Can''t get the error message');
{QUIT (123); {3k}
terminate; {3k}
end{if}
else begin
writeln
('X25SERV: error occurred during initialization of the');
writeln
(' server with the following identification:');
writeln (msg);
{QUIT (125); {3k}
terminate; {3k}
end;
end;
END;{check_init}
PROCEDURE create_descriptor;
var
prot_addr : shint;
opt : opt_type;
net_name : name_type;
net_name_len : shint;
wrtdata : shint;
begin {create_descriptor}
{-------------------------------------}
{ Creation of the descriptor dedicated}
{ to the server. }
{-------------------------------------}
Initopt ( opt, 2 );
prot_addr := c_prot_addr_server;
Addopt ( opt, 0, c_prot_add_code, 2, prot_addr, result );
check_init (result);
prompt ('Enter the name of the network you are working on >> ');
readln (net_name);
net_name := strltrim (net_name);
net_name := strrtrim (net_name); {eliminates blanks}
{useful when server is run
from a stream}
net_name_len:= strlen (net_name);
Addopt ( opt, 1, c_net_name_code, net_name_len, net_name,
result );
check_init ( result );
writeln ( '-- IPCCreate' ); {3k}
IPCCreate ( 3, 2,, opt, p_call_desc, result );
check_init ( result );
writeln('Call descriptor : ',p_call_desc);
{------------------------------------}
{ Disable the timer on the call }
{ descriptor. }
{------------------------------------}
wrtdata := 0 ;
IPCControl ( p_call_desc, 3, wrtdata, 2,,,, result );
check_init (result);
end; {create_descriptor}
PROCEDURE echo;
var
opt : opt_type;
calling_address: packed array [1..16] of nibble;
i,
option_code,
addr_len,
data_len : shint;
buffer : buffer_type;
buffer_len : integer;
begin {echo}
{------------------------------------}
{ Initialize an option field to get }
{ the calling node address. }
{------------------------------------}
Initopt ( opt, 1 );
Addopt ( opt, 0, c_calling_add_code, 8, calling_address, r );
{------------------------------------}
{ Wait for a connection request. }
{ ie Incoming CALL. }
{------------------------------------}
writeln ( '-- IPCRecvcn' ); {3k}
IPCRecvcn ( p_call_desc, p_vc_desc,, opt, result );
if result = 0 then begin
writeln('Call Received.........');
{------------------------------------}
{ Get the calling address from the }
{ CALL pkt. }
{------------------------------------}
data_len := 8;
option_code := c_calling_add_code;
Readopt ( opt, 0, option_code, data_len, calling_address, r );
writeln ('Calling node address = ');
{the first nibble contains the addr len}
addr_len := calling_address [1];
for i:= 2 to addr_len+1 do write (calling_address [i]:1);
writeln ;
{------------------------------------}
{ Loop on data transfer. }
{------------------------------------}
i:= 1;
while (i <= c_nb_loop) and (result = 0) do begin
buffer_len := c_buffer_len;
{------------------------------------}
{ Receive pkt from X25CHECK. }
{------------------------------------}
writeln ( '-- IPCRecv' ); {3k}
IPCRecv ( p_vc_desc, buffer, buffer_len,,, result );
if result = 0 then begin
writeln('Data packet received..........');
{------------------------------------}
{ Echo the same buffer. }
{------------------------------------}
IPCSend ( p_vc_desc, buffer, buffer_len,,, result );
if result = 0 then i:=i+1;
end;{if}
end; {while}
end;
end;{echo }
PROCEDURE shutdown_connection;
var
buffer : buffer_type;
buffer_len : integer;
begin
{------------------------------------}
{ End of connection. }
{ Wait for X25CHECK to CLEAR first }
{------------------------------------}
if result = 0 then begin
buffer_len := 1;
writeln ( '-- IPCRecv' ); {3k}
IPCRecv ( p_vc_desc, buffer, buffer_len,,, result );
{------------------------------------}
{ This IPCRECV should complete with }
{ an error indicating a CLEAR recvd. }
{------------------------------------}
if result = c_clear_rcvd then
{------------------------------------}
{ We can shutdown the vc descriptor }
{------------------------------------}
IPCShutdown ( p_vc_desc,,, result );
end;
end;{shutdown_connection}
PROCEDURE shutdown_call_desc;
begin {shutdown_call_desc}
IPCShutdown ( p_call_desc,,, result );
end; {shutdown_call_desc}
begin {main server}
CREATE_DESCRIPTOR;
while true do {endless loop} begin
ECHO;
SHUTDOWN_CONNECTION;
end;
SHUTDOWN_CALL_DESC;
end. {main server}
Include file: Exam3inc.pas
Download
{NetIPC Example-3-Exam3inc.pas}
{ decl }
{*************************************************************}
{ Declarations for X52CHECK and X25SERVR }
{*************************************************************}
CONST
c_prot_addr_x25chk = 31000; {X25CHECK protocol address}
c_prot_addr_server = 31001; {X25SERV protocol address}
{These decimal addresses are in the range 30767..32767 where PM }
{ is not required }
c_patern='abcdefghijklmnopqrstuvwxyz0123456789';
c_buffer_len = 36;
c_nb_loop =10;
c_calling_add_code = 141;
c_prot_add_code = 128;
c_net_name_code = 140;
c_clear_rcvd = 67; {SOCKERR for a CLEAR packet received}
TYPE
$if 'not native'$ {3k}
shint = -32768..32767; {3k}
$else$ {3k}
shint = Shortint; {3k}
$endif$ {3k}
nibble = 0..15;
byte = 0..255;
rc_type = (done,
error,
no_vc_desc,
no_dest_desc,
no_call_desc);
event_type = (i_addopt,
i_create,
i_dest,
i_connect,
i_recv_call_conf,
i_send,
i_recv,
i_shut_source,
i_shut_dest,
i_shut_connection);
event_msg_type = array [event_type] of string [80];
opt_type = packed record { }
length : shint; { }
num_entries : shint; {Declarations}
data : packed array [1..256] of shint;{ }
end; { for }
buffer_type = string [c_buffer_len] ; { }
{ NetIPC }
socket_type = (call,destination,vc); { }
name_type = string [50]; { }
name_len = shint;
CONST
c_event_msg = event_msg_type
['construction of option record',
'creation of the local call descriptor',
'creation of the destination descriptor',
'CALL packet sending',
'CALL CONF packet reception',
'DATA packet sending',
'DATA packet reception',
'shutdown of call descriptor',
'shutdown of destination descriptor',
'CLEAR packet sending'];
VAR
rc : rc_type;
result : integer;
r : shint;
p_call_desc : integer;
p_vc_desc : integer;
p_dest_desc : integer;
p_retry : boolean;
p_set_up_time : integer;
p_transit_time : integer;
{*****************************************************************}
{******* Declaration for the NetIPC intrinsics ******}
{*****************************************************************}
PROCEDURE Addopt ;INTRINSIC;
PROCEDURE Initopt ;INTRINSIC;
PROCEDURE Readopt ;INTRINSIC;
PROCEDURE IPCControl ;INTRINSIC;
PROCEDURE IPCCreate ;INTRINSIC;
PROCEDURE IPCDest ;INTRINSIC;
PROCEDURE IPCConnect ;INTRINSIC;
PROCEDURE IPCRecvcn ;INTRINSIC;
PROCEDURE IPCRecv ;INTRINSIC;
PROCEDURE IPCSend ;INTRINSIC;
PROCEDURE IPCShutdown ;INTRINSIC;
PROCEDURE IPCErrmsg ;INTRINSIC;
PROCEDURE GETPRIVMODE ;INTRINSIC;
PROCEDURE GETUSERMODE ;INTRINSIC;
{****** Other intrinsics used in the programs ******}
PROCEDURE quit ;INTRINSIC;
PROCEDURE terminate ;INTRINSIC; {3k}
FUNCTION timer:integer ;INTRINSIC;
3kRanger Runtime Example
3kRanger does not have X.25 hardware or configured at this time.
Fox 25:netipc3a.pub
Enter the name of the network you are working on >> FOX
--- IPCCreate
An error occurred during creation of the local call descriptor
with the following identification :
PROTOCOL IS NOT ACTIVE. (SOCKERR 9)
Do you want to run the test once again?(y/n) >> n
Fox 25:
Fox 25:netipc3b.pub
Enter the name of the network you are working on >> FOX
-- IPCCreate
X25SERV: error occurred during initialization of the
server with the following identification:
PROTOCOL IS NOT ACTIVE. (SOCKERR 9)
Fox 25:
|
