{$M-,X+}
program udp;

include {NOLIST} 'domain:jsys.def';
include {NOLIST} 'domain:mdep.def';
include {NOLIST} 'domain:master.def';
include {NOLIST} 'domain:udp.def';
include {NOLIST} 'domain:iomsg.hdr';
include {NOLIST} 'domain:msub.hdr';

const	udp_log_all=false; (* if true log all packets in and out *)

var	iq_handle:integer;
	src_port, dst_port, identification:field16;
	src_address, dst_address:field32;
	the_buffer:buffer_type_pointer;
	myfbp:file_blk_ptr;


procedure set_server(addr:field32;
		     port:field16);

{ Invoked by resolvers when a change in
  nameservers is desired. }

begin  {set_server}
    dst_address:=addr;
    dst_port:=port;
end;  {set_server}

procedure udp_initialize(server:boolean);

{ Initialize UDP for use by either the nameserver or resolver.
  The value of server identifies the calling program and
  therefore which port number to assign to src_port.
  Initial resolver destination address and port are assumed
  to be ISIA, port 53.  Enable Arpanet Wizard capability, 
  and set up network queue for the Internet Protocol, 
  identified by the iq_handle.

  Notes:  The source host address is set here because it is 
  required to compute the udp checksum.  Identification is 
  initialized here and incremented in udp_send. }

var	ac1, ac2, ac3, jobnum, runtime, max_count, ret:integer;
	enable_cap:set of 0..35;	{bits of 36-bit word}
	port_low_bits:field8;
	qdb:^qdb_type;

begin {udp_initialize}
    
    newl(the_buffer);

    {enable Arpanet Wizard capability}
    jsys( rpcap, -2, ret;fhslf;ac1,
	  ac2, enable_cap );   {get current user capabilities}
    if ret=3
    then begin
	     myfbp:=ofile(err);
	     writeln(myfbp^.fident, 'jsys RPCAP failed ');
	     jsys_err(noabort, -1, myfbp);
	     cfile(myfbp);
	 end;
    enable_cap:=enable_cap+[24];     {set arpanet-wizard (bit 24)}
    jsys(epcap, -2, ret;fhslf,
	 ac2, enable_cap);      {enable arpanet wizard capability}
    if ret=3
    then begin	
	     myfbp:=ofile(err);
	     writeln(myfbp^.fident, 'jsys EPCAP failed');
	     jsys_err(noabort, -1, myfbp);
	     cfile(myfbp);
	 end;
    
    {set source host address}
    jsys(gthst_, -2, ret;gthsz_;ac1,    {get host address} 
	 ac2, ac3, src_address); 
    if ret=3
    then begin
	     myfbp:=ofile(err);
	     writeln(myfbp^.fident, 'jsys GTHST failed');
	     jsys_err(noabort, -1, myfbp);
	     cfile(myfbp);
	 end;

    {assign src_port (both), and initial dst_address and dst_port
     (resolver only)}
    if server
    then if test_version
	 then src_port:=test_port
	 else src_port:=dns_port
    else begin	{resolver}
	     {make up a source port number--use job number plus
	      randomly select lower 8 bits so different source 
	      each time run so no duplicates from last run}

	     jsys(gjinf, -1, ret;; ac1, ac2, jobnum);    {get job number}
	     jsys(time, -1, ret;; runtime);	          {get runtime}
	     port_low_bits:=((runtime div "100) mod "100);{bits 21-28}
	     src_port:=jobnum*"100+port_low_bits+"20;  {source port #}
	     dst_address:=dns_dserve;
	     dst_port:=dns_port;
	 end;

    identification := 0;   {initialize}

    {set up network queue}
    {queue descriptor block}
    newl(qdb);
    with qdb^ do
    begin
	iqprv.ptcl:=17;                 {UDP}
	iqfhv:=0;			{arbitrary-receive from 
					 all foreign hosts}
	iqshv:=0;
	iqptv.src_port:=src_port;
	iqptv.dst_port:=0;		{arbitary-receive from all ports}
	iqprm.ptcl:=377b;
	iqfhm:=0;			{receive from all hosts}
	iqshm:=0;
	iqptm.src_port:=177777b;
	iqptm.dst_port:=0;		{receive from all ports}
    end;

    {assign network queue for Internet protocol}
    repeat
	jsys(asniq_, -2, ret;0:qdb^, 0, 0;iq_handle, max_count);
	if ret=3 
	then if not server
	     then begin  {try next port}
		      src_port:=src_port+1;
		      if src_port="ffff
		      then begin
			       myfbp:=ofile(fatl);
			       writeln(myfbp^.fident, 'jsys ASNIQ failed');
			       jsys_err(abort, -1, myfbp);
			   end
		      else qdb^.iqptv.src_port:=src_port;
		  end
	     else begin
		      myfbp:=ofile(fatl);
		      writeln(myfbp^.fident, 'jsys ASNIQ failed');
		      jsys_err(abort, -1, myfbp);
		  end;
    until ret<>3;
    
    {if insufficient buffer allocation terminate program}
    if max_count<144
    then begin   {buffer too small}
	     myfbp:=ofile(fatl);
	     writeln(myfbp^.fident, 'maximum buffer size insufficient (',
		     max_count:3, ' words), try again later');
	     jsys_err(abort, -1, myfbp);
	 end; {buffer too small}
end; {udp_initialize}


procedure udp_exit;

var	ret:integer;

begin  {udp_exit}
    {release the queue}
    jsys(reliq_, -2, ret; iq_handle, 0, 0);
    if ret=3
    then begin
	     myfbp:=ofile(err);
	     writeln(myfbp^.fident, 'jsys RELIQ failed');
	     jsys_err(noabort, -1, myfbp);
	     cfile(myfbp);
	 end
end;  {udp_exit}


function udp_checksum(var buffer:buffer_type):field16;

{ Compute the UDP checksum, which is the 16-bit ones 
  complement of the ones complement sum (add with end
  around carry) of the pseudo header, udp header and
  data taken 16 bits at a time. The checksum field is 
  included in the computation. }

var    checksum, datalength, i, sumhigh, temp:integer;

begin  {udp_checksum}

with buffer do
begin
    {sum of pseudoheader}
    checksum:=(sorc_adr mod "10000)+(sorc_adr div "10000)+
	      (dest_adr mod "10000)+(dest_adr div "10000)+
	      protocol+udplength;

    {sum of udp header}
    checksum:=checksum+sorc_port+dest_port+
	      udplength+udpchecksum;

    with buffer.data.header do
    begin    {sum udp data--header first then remainder
	      in 16 bit groups}
	temp:=ord(response)*"8000 + opcode*"800 +
	      ord(aa)*"400 + ord(tc)*"200 + ord(rd)*"100 + 
	      ord(ra)*"80 + unused*"10 + rcode;
	checksum:=checksum+id+temp+qdcount+ 
		  ancount+nscount+arcount;
    end; {with}	

    datalength:=iplength-ip_hdr_sz-udp_hdr_sz-dmn_hdr_sz; 
       { Note: Use iplength rather than udplength since it
	 has been protected by ipchecksum for received datagrams }
	
    {sum high order octets first}
    i:=1;
    sumhigh:=0;
    while i<=datalength do
    begin
	sumhigh:=sumhigh+data.data_recs[i];
	i:=i+2;
    end; 
    
    checksum:=checksum+sumhigh*256;
    {sum low order octets}
    i:=2;
    while i<=datalength do
    begin {add low order octet}
	checksum:=checksum+data.data_recs[i];
	i:=i+2;
    end; 

    {convert to ones complement sum of 16-bit 
     words by adding 16-bit carry}
    checksum:=(checksum mod "10000)+(checksum div "10000);
    checksum:=(checksum mod "10000)+(checksum div "10000);

    {return ones complement of result}
    udp_checksum:="ffff-checksum;

end; {with}    
end; {udp_checksum}


function udp_receive(var pkt:message_template;
		     wait_pkt:boolean):boolean;

{ Receive UDP messages from 0 to 548 octets. 
  If wait_pkt is true then wait until a message is received,
  else check for messages, and return.  If a message
  was received, return true as the value of the function.
  Messages longer than 548 octets or with invalid
  checksums are discarded. }

var	i, ret, wait_flag,
	checksum, datalength, error_code:integer;
	message_received:boolean;

begin {udp_receive}
    if wait_pkt 
    then wait_flag:=0
    else wait_flag:=RIQNW_; 

    {receive internet datagram}
    
    repeat  {until message received or not wait}
	the_buffer^.count:=145;	{maximum buffer size in words}

	{receive Internet datagram}
	jsys(rcvin_, -2, ret;wait_flag:iq_handle, 
	     the_buffer^, 0;error_code);
	if ret=3
	then begin  {error}
		 message_received:=false;
		 if (error_code <> 777777b) and
		     (error_code <> -1)
		 then begin
			  myfbp:=ofile(err);
			  writeln(myfbp^.fident, 'jsys RCVIN failed');
			  jsys_err(noabort, error_code, myfbp);
			  cfile(myfbp);
		      end;
	     end  {error}
	else begin {message received}
		 {check bounds on datalength}
		 datalength:=the_buffer^.iplength-ip_hdr_sz-udp_hdr_sz;	 {datalength in octets}

		 if (datalength>548) or (datalength<0)
		 then {datalength out of bounds}
		      begin
			  message_received:=false;
			  myfbp:=ofile(err);
			  writeln(myfbp^.fident,' UDP message discarded due to length');
				     end
		 else begin {datalength ok}
			  {check UDP checksum}	
			  if the_buffer^.udpchecksum=0
			  then 	{no checksum--assume data valid}
			      checksum:=0
			  else	{compute checksum}
			      checksum:=udp_checksum(the_buffer^);

			  if checksum<>0
			  then  {checksum error}
			      begin
				  message_received:=false;
				  myfbp:=ofile(err);
				  writeln(myfbp^.fident,' UDP checksum errror');
				  cfile(myfbp);
				  end
			  else begin {copy message}
				   message_received:=true;
				   pkt.xmit_using:=dgm;
				   pkt.octet_cnt:=datalength-dmn_hdr_sz;
				   pkt.raw_pkt:=the_buffer^.data;
				   if datalength > 512
				   then pkt.raw_pkt.header.tc:=true;    
				   with pkt,the_buffer^
				   do	begin
					    to_address:=dest_adr;
					    to_port:=dest_port;
					    from_address:=sorc_adr;
					    from_port:=sorc_port
					    end;
				   dst_address:=the_buffer^.sorc_adr;
				   dst_port:=the_buffer^.sorc_port;
			       end; {copy message}
		      end;  {datalength ok}
	     end; {message received}
    until message_received or (not wait_pkt);
    udp_receive:=message_received;	
end; {udp_receive}


procedure udp_send(var pkt:message_template);

{ Send a user datagram using UDP/IP for
  messages of up to 548 octets in length.
  Increment identification here. }

var	i, j, error_code, ret:integer;

begin {udp_send}

with the_buffer^, pkt.raw_pkt do
begin	
    {prepare output buffer}
	 {buffer length in words, rounded up }
    count:=1 {count word} +
	     ((ip_hdr_sz+udp_hdr_sz+dmn_hdr_sz+pkt.octet_cnt+3) div 4);

    {prepare ip datagram header}
    version:=4;
    ihl:= 5;                       {header length in 32-bit words} 
    tos:=0;			   {normal type of service}
    {ip datagram length in octets}
    iplength:=ip_hdr_sz+udp_hdr_sz+dmn_hdr_sz+pkt.octet_cnt;
    ident:=identification;
    flagrsvd:=0;	           {reserved}
    flagdf:=0;			   {may fragment}
    flagmf:=0;			   {last fragment}
    fragment:=0;		   {fragment offset}
    ttl:=100;			   {time to live = 100 gateway hops} 
    protocol:=17;		   {udp}
    with pkt
    do if from_address<>0
    then begin
	     sorc_adr:=from_address;
	     sorc_port:=from_port
	     end
    else begin
	     sorc_adr:=src_address;
	     sorc_port:=src_port
	     end;		{internet protocol will fill in but
				    it is required for udp checksum}
    with pkt
    do if to_address<>0
    then begin
	     dest_adr:=to_address;
	     dest_port:=to_port
	     end
    else begin
	     dest_adr:=dst_address;
	     dest_port:=dst_port
	     end;

    {udp header}
    udplength:=udp_hdr_sz+dmn_hdr_sz+pkt.octet_cnt;   {in octets}
    udpchecksum:=0;		  {initialize for checksum computation}

    {udp data}
    data:=pkt.raw_pkt;
 
    {udp checksum}
    udpchecksum:=udp_checksum(the_buffer^);
    if udpchecksum=0 
    then udpchecksum:="ffff;

    if udp_log_all
    then      begin
		   myfbp:=ofile(log);
		   writeln(myfbp^.fident,' UDP message sent');
		   cfile(myfbp);
	      end;
    
    {send internet datagram}
    jsys(sndin_, -2, ret;iq_handle, the_buffer^, 0;error_code);

    if ret=3
    then begin {error message}
	     myfbp:=ofile(err);
	     writeln(myfbp^.fident, 'jsys SNDIN failed');
	     jsys_err(noabort, error_code, myfbp);
	     cfile(myfbp);
	 end;  {error message}
    
    {increment internet identification}
    if identification<"ffff
    then identification:=identification+1
    else identification:=0;

end; {with}    
end. {udp_send}