 |
» |
|
|
|
Example 4 is a pair of programs designated SNMIPC1 and SNMIPC2 using
direct access to X.25 level 3. These programs can be compiled in native
mode. The program comments describe which of the X.25 features are
used in these sample programs. Program 4A (SNMIPC1) | |
(************************************************************************)
(* This program pair, SNMIPC1 and SNMIPC2, tests X25 features including:*)
(* *)
(* 1. Call User Data up to 128 bytes *)
(* 2. fast select *)
(* 3. special facilities *)
(* 4. catch all socket *)
(* 5. transfer of 2000 bytes packet *)
(* 6. no address flag *)
(* 7. deferred connection acceptance *)
(* 8. display calling node's x25 address *)
(* *)(* Since this program uses the catch all socket, the NA capability is *)
(* required. *)
(* To compile in Native Mode, compile with "pasxl SNMIPC1,,$null" and *)
(* link with "link $oldpass, NMIPC1". Run NMIPC1 before running NMIPC2.*)
(* *)
(* CONFIGURATION ENVIRONMENT : *)
(* Network Name : DIRECT *)
(* Facility Name : FACFULL (contains Fast Select flag) *)
(* SVCPATH : POOL with IO security *)
(* X25 address : 30101 *)
(* No Network Directory entries needed. *)
(* *)
(************************************************************************) |
$stats off$ (* compiler option *)
$statement_number on$
$code_offsets on$
$tables on$
$lines 120$
$standard_level 'hp_modcal'$
$type_coercion 'conversion'$
program nmipc1 (input,output);
TYPE
byte = 0..255; (* this is one byte long *)
bit4 = 0..15; (* this is one nibble long *)
shortint = -32768..32767; (* this is two bytes long *) |
CONST
X25 = 2; (* X25 protocol *)
CUD_MAX = 128; (* number bytes of CUD *)
VAR
sd_local: integer; (* local socket descriptor *)
cd_local: integer; (* local connection descriptor *)
optioncode: shortint; (* optioncode return from readopt *)
optlen: integer; (* opt length *)
dlen: integer; (* data length *)
flag: packed array[1..4] of byte; (* flags parameter *)
x25_flags: packed array[1..4] of byte; (* x25 flags parameter *)
result: integer; (* back from IPC call *)
result16: shortint; (* back from opt calls *)
i: integer; (* loop counter for messages *)
msg : packed array[1..2000] of byte; (* message for send and receive *)
data : packed array[1..12] of char; (* send data *)
opt: packed array [0..500] of byte;(* options array *)
cud: packed array [1..CUD_MAX] of byte; (* # bytes of CUD *)
wdata : packed array[1..80] of char; (* for ipccontrol wdata *)
readdata : packed array[1..500] of byte; (* for ipccontrol readdata *)
rlen : integer; (* length for readdata *)
sf : packed array[1..109] of byte; (* 109 bytes of facility_field *)
net_name : packed array[1..8] of char;(* network name *)
cnaddr : packed array[1..8] of byte ; (* calling node address *) |
(* IPC intrinsics used *)
procedure readopt; intrinsic;
procedure addopt; intrinsic;
procedure initopt; intrinsic;
procedure ipccheck; intrinsic;
procedure ipcconnect; intrinsic;
procedure ipccontrol; intrinsic;
procedure ipccreate; intrinsic;
procedure ipcdest; intrinsic;
procedure ipcerrmsg; intrinsic;
procedure ipcget; intrinsic;
procedure ipcgive; intrinsic;
procedure ipcrecv; intrinsic;
procedure ipcrecvcn; intrinsic;
procedure ipcsend; intrinsic;
procedure ipcshutdown; intrinsic;
|
(******************)
(* Program start *)
(******************)
begin
writeln ('*** Program nmipc1 : X25 features test program ***');
(***************************** IPCCREATE ********************************)
(* initialize opt array entry *)
initopt ( opt, 2, result16 );
if result16 <> 0 then
writeln ('initopt for ipccreate failed');
(* add the option for Catch_all Socket : bit 2 *)
flag[1] := 32; (* flag : 01000000000000000000000000000000 *)
flag[2] := 0;
flag[3] := 0;
flag[4] := 0;
addopt ( opt, 0, 144, 4, flag, result16 );
if result16 <> 0 then
writeln ('addopt for ipccreate catch-all failed');
(* add network name *)
net_name := 'direct';
addopt ( opt, 1, 140, 6, net_name, result16 );
if result16 <> 0 then
writeln ('addopt for ipccreate network name failed');
writeln;
writeln('***** IPCCREATE start ');
ipccreate ( 3, X25, , opt, sd_local, result );
if result <> 0 then
writeln ('ipccreate of local socket failed ', result );
(*********************** IPCRECVCN ********************************)
initopt ( opt, 4, result16 );
if result16 <> 0 then
writeln ('initopt for ipcrecvcn failed');
(* Set CUD receive for IPCRECVCN *)
for i := 1 to CUD_MAX do (* clean up CUD *)
cud[i] := 0;
addopt(opt, 0, 5, CUD_MAX, cud, result16);
if result16 <> 0 then
writeln('addopt IPCRECVCN CUD failed ',result16);
(* Set facility_field for IPCRECVCN *)
for i := 1 to 109 do (* clean up SF *)
sf[i] := 0;
addopt(opt, 1, 145, 109, sf, result16);
if result16 <> 0 then
writeln('addopt IPCRECVCN SF failed', result16);
(* add calling node address *)
addopt(opt, 2, 141, 8,cnaddr,result16);
if result16 <> 0 then
writeln('addopt IPCRECVCN calling node address failed', result16);
(* add X25_flags for receive fast select : bit 7 = 1 *)
x25_flags[1] := 0; (* clean up X25_flags *)
x25_flags[2] := 0;
x25_flags[3] := 0;
x25_flags[4] := 0;
addopt(opt, 3, 144, 4,x25_flags,result16);
if result16 <> 0 then
writeln('addopt IPCRECVCN x25 flags failed', result16);
(* set deferred flags for receive connection : bit 18 *)
flag[1] := 0; (* flags : 00000000000000000100000000000000 *)
flag[2] := 0;
flag[3] := 32;
flag[4] := 0; (* deferred *)
|
writeln;
writeln('***** IPCRECVCN deferred');
ipcrecvcn ( sd_local, cd_local, flag, opt, result );
if result <> 0 then
writeln ('ipcrecvcn failed', result);
(* check receive CUD *)
optlen := CUD_MAX;
readopt(opt,0,optioncode,optlen,cud,result16);
if result16 <> 0 then
writeln('readdata failed (cud) ',result16:1);
if optlen <> CUD_MAX then
writeln('CUD length error : (length = ',optlen:1, ' )');
i := 1;
while i <= optlen do
begin
if cud[i] <> i then
writeln('CUD error : #',i:1,' ',cud[i]);
i := i + 1;
end;
(* check facilities *)
optlen := 109; |
readopt(opt,1,optioncode,optlen, sf,result16);
if result16 <> 0 then
writeln('readdata failed (special facility) ',result16:1);
writeln('facilities received in Incoming call packet (length = ',optlen:1,')');
for i := 1 to optlen do
write (sf[i]:1,' ');
writeln; |
(* check calling node address *)
optlen := 8;
readopt(opt,2,optioncode,optlen, cnaddr,result16);
if result16 <> 0 then
writeln('readdata failed (calling node address) ',result16:1);
writeln('Calling Node Address (length = ',optlen:1,')');
for i := 1 to optlen do
begin
write ((cnaddr[i] div 16):1);
write ((cnaddr[i] mod 16):1);
end;
writeln;
(* check X25_flag : 000000010000000000000000000000000 *)
optlen := 4;
readopt(opt,3,optioncode,optlen,x25_flags,result16);
if result16 <> 0 then
writeln('readdata failed (X25_flags) ', result16:1);
if (x25_flags[1] <> 1) and (x25_flags[2] <> 0) and
(x25_flags[3] <> 0) and (x25_flags[4] <> 0) then
writeln('error fast select flag should be set');
(************************ IPCCONTROL ***********************************) |
(* set pass parameter for IPCCONTROL *)
initopt(wdata, 2, result16);
if result16 <> 0 then
writeln('initopt for ipccontrol failed');
(* send Call User Data back to calling node *)
for i := 1 to CUD_MAX do
cud[i] := CUD_MAX - i;
addopt(wdata, 0, 2,CUD_MAX, cud, result16);
if result16 <> 0 then
writeln('addopt for ipccontrol cud failed ',result16);
(* add special facility *)
sf[1] := hex('04');
sf[2] := hex('01');
addopt(wdata, 1, 145, 2, sf, result16);
if result16 <> 0 then
writeln('addopt for ipccontrol sf failed ',result16);
(* IPCCONTROL to accept the connection *)
writeln;
writeln('***** IPCCONTROL accept ');
ipccontrol( cd_local, 9, wdata,500, , , , result);
if result <> 0 then
writeln('ipccontrol failed ', result);
|
(****************** IPCRECV (2000 bytes) ******************************)
for i := 1 to 2000 do msg[i] := 0; (* initialize msg and dlen *)
dlen := 2000;
writeln;
writeln('***** IPCRECV (2000 bytes data) ');
ipcrecv ( cd_local, msg, dlen, , , result );
if result <> 0 then
writeln('IPCRECV 2000 failed ', result:1);
if dlen <> 2000 then
writeln('error data length = ',dlen:1);
(* Check that the correct data was received in the first vector *)
i := 1;
while i <= dlen do
begin
if msg[i] <> (i mod 100) then
writeln ('receive error data : #',i:1,' ',msg[i]);
i := i + 1;
end;
|
(************************ IPCSEND *************************************)
(* Now send a single vectored message to the local side *)
data := 'ok last one.';
dlen := 12;
writeln;
writeln('***** IPCSEND last message');
ipcsend ( cd_local, data, dlen, , , result );
if result <> 0 then
writeln ('ipcsend failed', result);
(************************ IPCRECV (skip error #67) ********************)
(* wait for remote side to shutdown first *)
(* receive an error code #67 *)
dlen := 1;
writeln;
writeln('***** IPCRECV ');
ipcrecv ( cd_local, data, dlen, , , result );
(* receive an error code #67 *)
if result <> 67 then
writeln('IPCRECV failed ', result:1);
|
(************************ IPCSHUTDOWN *********************************)
(* shutdown the local connection descriptor *)
writeln;
writeln('***** IPCSHUTDOWN (cd)');
ipcshutdown ( cd_local, , , result );
if result <> 0 then
writeln ('ipcshutdown cd_local failed', result);
(************************ IPCSHUTDOWN *********************************)
(* shutdown the local socket descriptor *)
writeln;
writeln('***** IPCSHUTDOWN (sd)');
ipcshutdown ( sd_local, , , result );
if result <> 0 then
writeln ('ipcshutdown sd_local failed', result);
end. |
Program 4B (SNMIPC2) | |
(************************************************************************}
(* This program pair, SNMIPC1 and SNMIPC2, tests X25 features including:*)
(* *)
(* 1. Call User Data up to 128 bytes *)
(* 2. fast select *)
(* 3. special facilities *)
(* 4. catch all socket *)
(* 5. transfer of 2000 bytes packet *)
(* 6. no address flag *)
(* 7. deferred connection acceptance *)
(* 8. display calling node's x25 address *)
(* *)
(* Since this program uses the catch all socket, the NA capability is *)
(* required. *)
(* To compile in Native Mode, compile with "pasxl SNMIPC2,,$null" and *) |
(* link with "link $oldpass, NMIPC2". Run NMIPC1 before running NMIPC2.*)
(* *)
(* CONFIGURATION ENVIRONMENT : *)
(* Network Name : DIRECT *)
(* Facility Name : FACFULL (contains Fast Select flag) *)
(* SVCPATH : POOL with IO security *)
(* X25 address : doesn't matter *)
(* No Network Directory entries needed. *)
(* *)
(************************************************************************)
$stats off$ (* compiler option *)
$statement_number on$
$code_offsets on$
$tables on$
$lines 120$
$standard_level 'hp_modcal'$
$type_coercion 'conversion'$
program nmipc2 (input,output);
|
TYPE
byte = 0..255; (* this is one byte long *)
bit4 = 0..15; (* this is one nibble long *)
shortint = -32768..32767; (* this is two bytes long *)
CONST
X25 = 2; (* X25 lever III protocol *)
CUD_MAX = 128; (* number byte of CUD *)
SOCK_ADDR = 32000; (* socket's address *)
VAR
sd_remote: integer; (* remote socket descriptor *)
cd_remote: integer; (* remote connection descriptor *) dd: integer; (* destination descriptor *)
dlen: integer; (* data length *)
optlen: integer; (* opt length *)
optioncode: shortint; (* option code *)
flag : packed array[1..4] of byte; (* flag *)
x25_flags: packed array [1..4] of byte; (*x25_flags parameter *)
result: integer; (* back from IPC call *)
result16: shortint; (* back from opt calls *)
i: integer; (* loop counter for messages *)
msg : packed array[1..2000] of byte; (* message for send and receive *)
expect : packed array[1..12] of char; (* expect data *)
adrs: packed array[1..2] of byte; (* socket's address *)
opt: packed array [0..500] of byte; (* options array *)
xchico : packed array [1..50] of bit4; (* chico Dest_net_addre *)
cud: packed array [1..CUD_MAX] of byte; (* CUD *)
data: packed array[1..12] of char; (* receive data *)
readdata : packed array[1..200] of byte; (* readdata for readopt *)
sf : packed array[1..109] of byte; (* 109 bytes of facility_field *)
net_name : packed array[1..8] of char; (* network name *)
fac_name : packed array[1..8] of char; (* facility name *)
(* IPC intrinsics used *) |
procedure readopt; intrinsic;
procedure addopt; intrinsic;
procedure initopt; intrinsic;
procedure ipccheck; intrinsic;
procedure ipcconnect; intrinsic;
procedure ipccontrol; intrinsic;
procedure ipccreate; intrinsic;
procedure ipcdest; intrinsic;
procedure ipcerrmsg; intrinsic;
procedure ipcget; intrinsic;
procedure ipcgive; intrinsic;
procedure ipcrecv; intrinsic;
procedure ipcrecvcn; intrinsic;
procedure ipcsend; intrinsic;
procedure ipcshutdown; intrinsic;
(*****************)
(* Program start *)
(*****************)
begin
writeln ('### Program nmipc2 : X25 features test program ### ');
********************* IPCCREATE *************************************)
|
(* initialize opt array entry *)
initopt ( opt, 1, result16 );
if result16 <> 0 then
writeln('ipccreate initopt failed', result16);
(* add the option for Network Name *)
net_name := 'direct';
(* add the option for NETWORK NAME *)
addopt (opt, 0, 140, 6, net_name, result16);
if result16 <> 0 then
writeln('ipccreate addopt failed', result16);
writeln;
writeln('##### IPCCREATE ');
ipccreate ( 3, X25, , opt, sd_remote, result );
if result <> 0 then
writeln ('ipccreate of remote socket failed', result);
(***************************** IPCDEST **********************************)
(* Get the destination descriptor to the local socket from the remote *)
(* socket. *)
(* We are calling the catch-all socket, so no address will be put in the*)
(* call, however we have the satisfy IPCDEST with something *)
adrs[1] := SOCK_ADDR div 256; (* first 8 bits of 32000 *)
adrs[2] := SOCK_ADDR mod 256; (* last 8 bits of 32000 *)
initopt ( opt, 1, result16 );
if result16 <> 0 then
writeln ('initopt for ipcdest failed');
(* add DEST_NET_ADDR opt to ipcdest *)
xchico[1] := 0; (* 0002 : protocol is X25 *)
xchico[2] := 0;
xchico[3] := 0;
xchico[4] := 2;
xchico[5] := 0; (* 0000 : address for the SVC *)
xchico[6] := 0;
xchico[7] := 0;
xchico[8] := 0;
xchico[9] := 5; (* 5 : length of X25 address *)
xchico[10] := 3; (* 30101: chico X25 address *)
xchico[11] := 0;
xchico[12] := 1;
xchico[13] := 0;
xchico[14] := 1;
(* add remote node X25 address *)
addopt(opt, 0, 16, 7, xchico, result16);
if result16 <> 0 then
writeln ('addopt for ipcdest failed',result16);
writeln;
writeln('##### IPCDEST ');
ipcdest ( 3, , , X25, adrs, 2, , opt, dd, result );
if result <> 0 then
writeln ('ipcdest failed ' , result );
(********************** IPCCONNECT *********************************)
initopt ( opt, 4, result16 );
if result16 <> 0 then
writeln ('initopt for ipcconnect failed',result16);
(* this sets the "no_address" flag; and allows to access 128 bytes of CUD *)
(* with fast select *)
x25_flags[1] := 0; (* X25_flags : 00000000000000001000000000000000 *)
x25_flags[2] := 0;
x25_flags[3] := 64;
x25_flags[4] := 0;
addopt(opt, 0, 144, 4, x25_flags, result16);
if result16 <> 0 then
writeln ('addopt for ipcconnect x25_flag failed',result16);
(* add call_user_data_send *)
for i := 1 to CUD_MAX do
cud[i] := i;
addopt(opt, 1, 2, CUD_MAX, cud, result16);
if result16 <> 0 then
writeln ('addopt for ipcconnect cud failed',result16);
(* add facility name *)
fac_name := 'FACFULL ';
addopt(opt, 2, 142, 8, fac_name, result16);
if result16 <> 0 then
writeln('addopt for facility name failed ',result16);
(* add some special facilities *)
sf[1] := hex('04');
sf[2] := hex('01');
addopt(opt, 3, 145, 2, sf, result16);
if result16 <> 0 then
writeln ('addopt for ipcconnect sf failed',result16);
(* Connect to the local socket using the destination descriptor. *)
writeln;
writeln ('##### IPCCONNECT');
ipcconnect ( sd_remote, dd, , opt, cd_remote, result );
if result <> 0 then
writeln ('ipcconnect failed ', result );
(****************************** IPCRECV *****************************)
initopt(opt, 2, result16);
if result16 <> 0 then
writeln('initopt for ipcrecv failed');
for i := 1 to CUD_MAX do
cud[i] := 0;
optlen := CUD_MAX;
addopt(opt, 0, 5, optlen, cud, result16);
if result16 <> 0 then
writeln('addopt IPCRECV cud failed ', result16:1);
for i := 1 to 50 do
sf[i] := 0;
|
optlen := 50;
addopt(opt, 1, 145, optlen, sf,result16);
if result16 <> 0 then
writeln('addopt IPCRECV sf failed ', result16:1);
writeln;
writeln('##### IPCRECV ');
ipcrecv ( cd_remote, , , ,opt, result );
if result <> 0 then
writeln ('ipcrecv to complete connection failed ',result);
(* check receive CUD *)
optlen := CUD_MAX;
readopt(opt, 0, optioncode, optlen,cud,result16);
if result16 <> 0 then
writeln('CUD readopt failed ', result16:1);
if optlen <> CUD_MAX then
writeln('CUD length error : (length = ',optlen:1, ' )');
i := 1;
while i <= optlen do
begin
if cud[i] <> (CUD_MAX - i) then
writeln('CUD error : #',i:1,' ',cud[i]);
i := i + 1;
end;
|
(* check special facility *)
optlen := 50;readopt(opt, 1, optioncode, optlen,sf,result16);
if result16 <> 0 then
writeln('SF readopt failed ',result16:1);
writeln
('facilities received in call accepted packet (length = ',optlen:1,')');
for i := 1 to optlen do
write(sf[i]:1,' ');
writeln;
(****************************** IPCSEND (2000 bytes) *****************)
for i := 1 to 2000 do
msg[i] := i mod 100;
writeln;
writeln('##### IPCSEND (2000 bytes data)');
ipcsend ( cd_remote, msg, 2000, , , result );
if result <> 0 then writeln('send 2000 bytes data failed ',result:1);
(****************************** IPCRECV ******************************)
dlen := 12;
writeln;
writeln('##### IPCRECV last message');
ipcrecv( cd_remote, data, dlen,,, result);
if result <> 0 then
writeln('ipcrecv failed ',result);
(* check the correct data was received *)
if dlen <> 12 then
writeln('receive data length error (length = ',dlen:1,')')
else
begin
expect := 'ok last one.';
for i := 1 to dlen do
if data[i] <> expect[i] then
writeln('receive data error #',i:1,' ',data[i]);
end;
(************************* IPCSHUTDOWN (cd) **************************)
(* shutdown the connection descriptor *)
writeln;
writeln('##### IPCSHUTDOWN (cd) ');
ipcshutdown ( cd_remote, , , result );
if result <> 0 then
writeln ('ipcshutdown cd_local failed',result);
(************************* IPCSHUTDOWN (dd) **************************)
(* shutdown the connection descriptor *)
writeln;
writeln('##### IPCSHUTDOWN (dd) ');
ipcshutdown ( dd, , , result );
if result <> 0 then
writeln ('ipcshutdown dd failed',result);
(************************* IPCSHUTDOWN (sd) ******************************)
(* shutdown the socket descriptor *)
writeln;
writeln('##### IPCSHUTDOWN (sd) ');
ipcshutdown ( sd_remote, , , result );
if result <> 0 then
writeln ('ipcshutdown sd_local failed',result);
end.
|
|
