HP 3000 Manuals HP 3000 Manuals
Example 3
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.
Program 3A (X25CHECK)
{*************************************************************}
{ 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
shint = -32768..32767;
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;
FUNCTION timer:integer ;INTRINSIC;
{}
{}
{*****************************************************************}
{ }
{ 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. }
{*****************************************************************}
$GLOBAL$
PROGRAM x25chk (input,output);
$include 'decl'$
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
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;
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 }
{------------------------------------}
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}
{------------------------------------}
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. }
{------------------------------------}
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)
{******************************************************************}
{ }
{ 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. }
{******************************************************************}
program x25serv (input,output);
$include 'decl'$ {include file of type and constants}
{----------------------------Check_init-----------------------------}
{ PURPOSE : Checks the results of IPC calls. Used during the initi- }
{ alization phase when errors are not discarded but dis- }
{ played 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);
end{if}
else
begin
writeln('X25SERV: error occurred during initialization of the');
writeln(' server with the following identification:');
writeln (msg);
QUIT (125);
end;{else}
end;{if}
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);
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. }
{------------------------------------}
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 = ');
addr_len := calling_address [1]; {the first nibble contains the addr len}
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. }
{------------------------------------}
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;
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}