Subj : TCP<->Fossil sockets unit
To   : All
From : Alexander Grotewohl
Date : Tue Mar 09 2021 01:58:05

here's the promised sockets unit. the documentation for the trumpet lib is
kinda hard to find nowadays, but if you find an old URL you can fetch it from
archive.org

Alex


{ trumpet sockets unit for bp7 }
{ needs work.. outbound ip currently hardcoded }

unit sockets;

interface

uses
  crt, dos;

type
  pdriver_info_rec = ^driver_info_rec;
  driver_info_rec = record
    myip: array[0..3] of byte;
    netmask: array[0..3] of byte;
    gateway: array[0..3] of byte;
    dnsserver: array[0..3] of byte;
    timeserver: array[0..3] of byte;
    mtu: integer;
    def_ttl: byte;
    def_tos: byte;
    tcp_mss: integer;
    tcp_rwin: integer;
    debug: integer;
    domain: array[0..255] of char;
  end;

  psession_info_rec = ^session_info_rec;
  session_info_rec = record
    ip_srce: array[0..3] of byte;
    ip_dest: array[0..3] of byte;
    ip_prot: byte;
    active : byte;
  end;

function driver_info(var rec: pdriver_info_rec): boolean;
function driver_doio: byte;

function tcp_open(var h: word; port: word; listen: boolean): byte;
function tcp_connect(var h: word; port: word): byte;
function tcp_listen(var h: word; port: word): byte;
function tcp_close(h: word): byte;
function tcp_get(h: word; buf: pchar; cnt: word; timeout: word; var res: word):
byte;
function tcp_put(h: word; buf: pchar; cnt: word; timeout: word; var res: word):
byte;
function tcp_status(h: word; var tcp_state: byte; var incnt, outcnt: word; var 
ec: psession_info_rec): byte;

implementation

function driver_info(var rec: pdriver_info_rec): boolean;
var
  regs: registers;
begin
  driver_info:=false;
  rec:=nil;
  fillchar(regs, sizeof(regs), 0);
  regs.ah:=$00;
  regs.al:=$FF;
  intr($61, regs);
  { should actually check for TCP_DRVR lol }
  if (regs.al=0) then
    begin
      rec:=Ptr(regs.es, regs.di);
      driver_info:=true;
    end;
   writeln(rec^.myip[0], ' ', rec^.myip[1], ' ', rec^.myip[2], ' ', rec^.myip[3
);
end;

function driver_doio: byte;
var
  regs: registers;
begin
  fillchar(regs, sizeof(regs), 0);
  regs.ah:=$02;
  intr($61, regs);
  driver_doio:=regs.dl;
end;

type
  tip = array[0..3] of byte;

function tcp_open(var h: word; port: word; listen: boolean): byte;
var
  regs: registers;
  ip: tip;
begin
  fillchar(regs, sizeof(regs), 0);
  regs.ah:=$10;
  { normal }
  if (listen) then
    begin
      regs.al:=1;
      regs.bx:=port;
      regs.cx:=0;
      { dx = timeout, $00 = non-blocking, $FFFF = infinite }
      regs.dx:=$FFFF;
      { in this case we might be able to bind
        a specific ip address? }
      regs.si:=0;
      regs.di:=0;
    end else
    begin
      regs.al:=0;
      regs.bx:=0;
      regs.cx:=port;
      regs.dx:=60;


      { some temp test stuff }
      ip[0]:=192;
      ip[1]:=168;
      ip[2]:=1;
      ip[3]:=10;

      regs.si:=(ip[3] shl 8) or ip[2];
      regs.di:=(ip[1] shl 8) or ip[0];
    end;

  intr($61, regs);
  h:=regs.bx;
  tcp_open:=regs.dl;
end;

{ needs ip.. }
function tcp_connect(var h: word; port: word): byte;
begin
  tcp_connect:=tcp_open(h, port, false);
end;

function tcp_listen(var h: word; port: word): byte;
begin
  tcp_listen:=tcp_open(h, port, true);
end;

function tcp_close(h: word): byte;
var
  regs: registers;
begin
  fillchar(regs, sizeof(regs), 0);
  regs.ah:=$11;
  regs.al:=$01;
  regs.bx:=h;
  { per docs timeout must be non-zero to release handle }
  {regs.dx:=$01;}
  regs.dx:=$02; { 1 = abort so.. try 2?}

  intr($61, regs);
  tcp_close:=regs.dl;
end;

function tcp_get(h: word; buf: pchar; cnt: word; timeout: word; var res: word):
byte;
var
  regs: registers;
begin
  fillchar(regs, sizeof(regs), 0);
  regs.ah:=$12;
  regs.al:=$01;
  regs.bx:=h;
  regs.cx:=cnt;
  regs.dx:=timeout;

  regs.es:=seg(buf^);
  regs.di:=ofs(buf^);

  intr($61, regs);
  res:=regs.ax;
  tcp_get:=regs.dl;
end;

function tcp_put(h: word; buf: pchar; cnt: word; timeout: word; var res: word):
byte;
var
  regs: registers;
begin
  fillchar(regs, sizeof(regs), 0);
  regs.ah:=$13;
  regs.al:=$04;
  {regs.al:=$00;}
  regs.bx:=h;
  regs.cx:=cnt;
  regs.dx:=timeout;

  regs.es:=seg(buf^);
  regs.di:=ofs(buf^);

  intr($61, regs);
  res:=regs.ax;
  tcp_put:=regs.dl;
end;

function tcp_status(h: word; var tcp_state: byte; var incnt, outcnt: word; var 
ec: psession_info_rec): byte;
var
  regs: registers;
begin
  fillchar(regs, sizeof(regs), 0);
  regs.ah:=$14;
  regs.al:=$00;
  regs.bx:=h;

  intr($61, regs);
  tcp_state:=regs.dh; { 1 = not connected, 4 = connected.. others? }
  incnt:=regs.ax;
  outcnt:=regs.cx;

  rec:=Ptr(regs.es, regs.di);

  tcp_status:=regs.dl;
end;

end.

--- Mystic BBS v1.12 A46 2020/08/26 (Windows/32)
 * Origin: --[!dreamland BBS bbs.dreamlandbbs.org (1:218/530)

.