(*****************************************************************************)
(*>                                                                         <*)
(*>  DOORS   .PAS -  Written by Eric Oman                                   <*)
(*>                                                                         <*)
(*>  Online door procedures.                                                <*)
(*>                                                                         <*)
(*****************************************************************************)
{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit doors;

interface

uses
  crt, dos,

  {rcg11172000 no overlay under Linux.}
  {overlay,}

  execbat,
  common;

function process_door(s:astr):astr;
procedure write_dorinfo1_def(rname:boolean);     { RBBS-PC DORINFO1.DEF }
procedure write_door_sys(rname:boolean);         { GAP DOOR.SYS }
procedure write_chain_txt;                       { WWIV CHAIN.TXT }
procedure write_callinfo_bbs(rname:boolean);     { Wildcat! CALLINFO.BBS }
procedure write_sfdoors_dat(rname:boolean);      { Spitfire SFDOORS.DAT }
procedure dodoorfunc(kind:char; cline:astr);

implementation

function timestr:astr;
var i:astr;
begin
  {str(nsl/60,i);}
  {i:=copy(i,2,length(i));}
  {i:=copy(i,1,pos('.',i)-1);}
  i:=cstrr(nsl/60,10);
  timestr:=i;
end;

function process_door(s:astr):astr;
var i:integer;
    sda,namm:astr;
    sdoor:string[255];
begin
  namm:=caps(thisuser.realname);
  sdoor:='';
  for i:=1 to length(s) do begin
    if copy(s,i,1)='@' then begin
      sda:='';
      case upcase(s[i+1]) of
        'B':if spd<>'KB' then sda:=spd else sda:='0';
        'D':begin
              loaduboard(fileboard);
              sda:=memuboard.dlpath;
            end;
        'F':sda:=copy(namm,1,pos(' ',namm)-1);
        'G':if okansi then sda:='1' else sda:='0';
        'I':begin
              loaduboard(fileboard);
              sda:=systat.gfilepath;
              {rcg11242000 DOSism.}
              {if (copy(sda,length(sda),1)<>'\') then sda:=sda+'\';}
              if (copy(sda,length(sda),1)<>'/') then sda:=sda+'/';
              sda:=sda+memuboard.filename+'.DIR';
            end;
        'L':begin
              if (pos(' ',namm)=0) then sda:=namm else
                sda:=copy(namm,pos(' ',namm)+1,length(namm));
            end;
        'N':sda:=caps(thisuser.name);
        'T':sda:=timestr;
        'R':sda:=(copy(nam,pos('#',nam)+1,length(nam)));
      end;
      sdoor:=sdoor+sda;
      inc(i);
    end
    else sdoor:=sdoor+copy(s,i,1);
  end;
  process_door:=sdoor;
end;

procedure write_dorinfo1_def(rname:boolean);  (* RBBS-PC's DORINFO1.DEF *)
var fp:text;
    first,last:astr;
    s:astr;
begin
  assign(fp,'dorinfo1.def');
	rewrite(fp);
	writeln(fp,stripcolor(systat.bbsname));
	first:=copy(systat.sysopname,1,pos(' ',systat.sysopname)-1);
	last:=copy(systat.sysopname,length(first)+2,length(systat.sysopname));
  writeln(fp,first);
  writeln(fp,last);
  if spd='KB' then writeln(fp,'COM0') else writeln(fp,'COM'+cstr(modemr.comport));
  if spd='KB' then s:='0' else s:=spd;
  writeln(fp,s+' BAUD,N,8,1');
  writeln(fp,'0');
  if (rname) then begin
    if pos(' ',thisuser.realname)=0 then begin
      first:=thisuser.realname;
      last:='';
    end else begin
      first:=copy(thisuser.realname,1,pos(' ',thisuser.realname)-1);
      last:=copy(thisuser.realname,length(first)+2,length(thisuser.realname));
    end;
    first:=allcaps(first);
    last:=allcaps(last);
  end else begin
    if pos(' ',thisuser.name)=0 then begin
      first:=thisuser.name;
      last:='';
    end else begin
      first:=copy(thisuser.name,1,pos(' ',thisuser.name)-1);
      last:=copy(thisuser.name,length(first)+2,length(thisuser.name));
    end;
  end;
  writeln(fp,caps(first));
  writeln(fp,caps(last));
  writeln(fp,thisuser.citystate);
  if (ansi in thisuser.ac) then writeln(fp,'1') else writeln(fp,'0');
  writeln(fp,thisuser.sl);
  s:=timestr;
  if length(s)>3 then s:='999';
  writeln(fp,s);
  writeln(fp,'0');
  close(fp);
end;

procedure write_door_sys(rname:boolean);    (* GAP's DOOR.SYS *)
var fp:text;
    i:integer;
    s:astr;
begin
  assign(fp,'door.sys');
  rewrite(fp);
  if spd<>'KB' then writeln(fp,'COM'+cstr(modemr.comport)+':') else writeln(fp,'COM0:');
  if spd<>'KB' then writeln(fp,spd) else writeln(fp,cstr(modemr.waitbaud));
	writeln(fp,' 8');
	writeln(fp,' 1');
	writeln(fp,' N');
	if wantout then writeln(fp,' Y') else writeln(fp,' N');
	writeln(fp,' Y');
	if sysop then writeln(fp,' Y') else writeln(fp,' N');
	if alert in thisuser.ac then writeln(fp,' Y') else writeln(fp,' N');
  if (rname) then writeln(fp,thisuser.realname) else writeln(fp,thisuser.name);
  writeln(fp,thisuser.citystate);
  writeln(fp,copy(thisuser.ph,1,3)+' '+copy(thisuser.ph,5,8));
  writeln(fp,copy(thisuser.ph,1,3)+' '+copy(thisuser.ph,5,8));
  writeln(fp,thisuser.pw);
  writeln(fp,cstr(thisuser.sl));
  writeln(fp,cstr(thisuser.loggedon));
  writeln(fp,thisuser.laston);
  writeln(fp,cstrl(trunc(nsl)));
  writeln(fp,cstr(trunc(nsl) div 60));
  if okansi then writeln(fp,'GR') else writeln(fp,'NG');
  writeln(fp,cstr(thisuser.pagelen));
	if novice in thisuser.ac then writeln(fp,' N') else writeln(fp,' Y');
  s:='';
  for i:=1 to 7 do
    if chr(i+64) in thisuser.ar then s:=s+cstr(i);
  writeln(fp,s);
  writeln(fp,'7');
	writeln(fp,'12/31/99');
	writeln(fp,' '+cstr(usernum));
	writeln(fp,' X');
	writeln(fp,' '+cstr(thisuser.uploads));
	writeln(fp,' '+cstr(thisuser.downloads));
	writeln(fp,' '+cstr(trunc(thisuser.dk)));
	writeln(fp,' 999999');
  close(fp);
end;

procedure write_chain_txt;
var fp:text;
    ton,tused:real;
    s:string[20];

  function bo(b:boolean):astr;
  begin
    if b then bo:='1' else bo:='0';
  end;

begin
  assign(fp,'chain.txt');
  rewrite(fp);
  with thisuser do begin
    writeln(fp,usernum);                      { user number        }
    writeln(fp,name);                         { user name          }
    writeln(fp,realname);                     { real name          }
    writeln(fp,'');                           { "call sign" ?      }
    writeln(fp,ageuser(bday));                { age                }
    writeln(fp,sex);                          { sex                }
    str(credit:7,s); writeln(fp,s+'.00');     { credit             }
    writeln(fp,laston);                       { laston date        }
    writeln(fp,linelen);                      { # screen columns   }
    writeln(fp,pagelen);                      { # screen rows      }
    writeln(fp,sl);                           { SL                 }
    writeln(fp,bo(so));                       { is he a SysOp?     }
    writeln(fp,bo(cso));                      { is he a CoSysOp?   }
    writeln(fp,bo(okansi));                   { is graphics on?    }
    writeln(fp,bo(incom));                    { is remote?         }
    str(nsl:10:2,s); writeln(fp,s);           { time left (sec)    }
    writeln(fp,systat.gfilepath);             { gfiles path        }
    writeln(fp,systat.gfilepath);             { data path          }
    writeln(fp,'SYSOP.LOG');                  { SysOp log filespec }
    s:=spd; if (s='KB') then s:='0';          { baud rate          }
    writeln(fp,s);
    writeln(fp,modemr.comport);               { COM port           }
    writeln(fp,stripcolor(systat.bbsname));   { system name        }
    writeln(fp,systat.sysopname);             { SysOp's name       }
    with timeon do begin
      ton:=hour*3600.0+min*60.0+sec;
      tused:=timer-ton;
      if (tused<0) then tused:=tused+3600.0*24.0;
    end;
    writeln(fp,trunc(ton));                   { secs on f/midnight }
    writeln(fp,trunc(tused));                 { time used (sec)    }
    writeln(fp,uk);                           { upload K           }
    writeln(fp,uploads);                      { uploads            }
    writeln(fp,dk);                           { download K         }
    writeln(fp,downloads);                    { downloads          }
    writeln(fp,'8N1');                        { COM parameters     }
  end;
  close(fp);
end;

procedure write_callinfo_bbs(rname:boolean);
var fp:text;
		s:astr;

  function bo(b:boolean):astr;
  begin
    if b then bo:='1' else bo:='0';
  end;

begin
  assign(fp,'callinfo.bbs');
  rewrite(fp);
  with thisuser do begin
    if (rname) then writeln(fp,allcaps(thisuser.realname)) else writeln(fp,allcaps(thisuser.name));
    if spd='300' then s:='1' else
      if spd='1200' then s:='2' else
      if spd='2400' then s:='0' else
      if spd='9600' then s:='3' else
      if spd='KB' then s:='5' else
      s:='4';
    writeln(fp,s);
    writeln(fp,allcaps(thisuser.citystate));
    writeln(fp,cstr(thisuser.sl));
    writeln(fp,timestr);
    if okansi then writeln(fp,'COLOR') else writeln(fp,'MONO');
    writeln(fp,thisuser.pw);
    writeln(fp,cstr(usernum));
    writeln(fp,'0');
    writeln(fp,copy(time,1,5));
    writeln(fp,copy(time,1,5)+' '+date);
    writeln(fp,'A');
    writeln(fp,'0');
    writeln(fp,'999999');
    writeln(fp,'0');
    writeln(fp,'999999');
    writeln(fp,thisuser.ph);
    writeln(fp,thisuser.laston+' 00:00');
    if (novice in thisuser.ac) then writeln(fp,'NOVICE') else writeln(fp,'EXPERT');
    writeln(fp,'All');
    writeln(fp,'01/01/80');
    writeln(fp,cstr(thisuser.loggedon));
    writeln(fp,cstr(thisuser.pagelen));
    writeln(fp,'0');
    writeln(fp,cstr(thisuser.uploads));
    writeln(fp,cstr(thisuser.downloads));
    writeln(fp,'8  { Databits }');
    if ((incom) or (outcom)) then writeln(fp,'REMOTE') else writeln(fp,'LOCAL');
    if ((incom) or (outcom)) then writeln(fp,'COM'+cstr(modemr.comport)) else writeln(fp,'COM0');
    writeln(fp,thisuser.bday);
    if spd='KB' then writeln(fp,cstr(modemr.waitbaud)) else writeln(fp,spd);
    if ((incom) or (outcom)) then writeln(fp,'TRUE') else writeln(fp,'FALSE');
    if (spdarq) then write(fp,'MNP/ARQ') else write(fp,'Normal');
    writeln(fp,' Connection');
    writeln(fp,'12/31/99 23:59');
    writeln(fp,'1');
    writeln(fp,'1');
  end;
  close(fp);
end;

procedure write_sfdoors_dat(rname:boolean);   { Spitfire SFDOORS.DAT }
var fp:text;
    s:astr;
begin
  assign(fp,'SFDOORS.DAT');
  rewrite(fp);
  writeln(fp,cstr(usernum));
  if (rname) then writeln(fp,allcaps(thisuser.realname)) else writeln(fp,allcaps(thisuser.name));
  writeln(fp,thisuser.pw);
  if (rname) then begin
    if (pos(' ',thisuser.realname)=0) then s:=thisuser.realname
    else s:=copy(thisuser.realname,1,pos(' ',thisuser.realname)-1);
  end else begin
    if (pos(' ',thisuser.name)=0) then s:=thisuser.name
    else s:=copy(thisuser.name,1,pos(' ',thisuser.name)-1);
  end;
  writeln(fp,s);
  if (spd='KB') then writeln(fp,'0') else writeln(fp,cstr(modemr.comport));
  writeln(fp,timestr);
  writeln(fp,'0');   { seconds since midnight }
  writeln(fp,start_dir);
  if okansi then writeln(fp,'TRUE') else writeln(fp,'FALSE');
  writeln(fp,cstr(thisuser.sl));
  writeln(fp,cstr(thisuser.uploads));
  writeln(fp,cstr(thisuser.downloads));
  writeln(fp,cstr(systat.timeallow[thisuser.sl]));
  writeln(fp,'0');   { time on (seconds) }
  writeln(fp,'0');   { extra time (seconds) }
  writeln(fp,'FALSE');
  writeln(fp,'FALSE');
  writeln(fp,'FALSE');
  if (spd='KB') then writeln(fp,'0') else writeln(fp,spd);
  close(fp);
end;

procedure dodoorfunc(kind:char; cline:astr);
var doorstart,doorend,doortime:datetimerec;
    s,cline2:astr;
    retcode,savsl,savdsl:integer;
    realname:boolean;
begin
  realname:=FALSE;
  if ((sqoutsp(cline)='') and (incom)) then begin
    print('This command is inoperative!');
    if (cso) then print('(An MString of "" will shell to DOS LOCALLY!)');
    exit;
  end;

  if ((realsl<>-1) and (realdsl<>-1)) then begin
    savsl:=thisuser.sl; savdsl:=thisuser.dsl;
    thisuser.sl:=realsl; thisuser.dsl:=realdsl;
    saveuf;
  end;

(*  sprint(#3#3+'[> '+#3#0+'Opening door on '+
         #3#5+date+' '+time+#3#0+' ...  Please wait.');*)
  cline2:=cline;
  if copy(allcaps(cline2),1,2)='R;' then begin
    realname:=TRUE;
    cline2:=copy(cline2,3,length(cline2)-2);
  end;
  s:=process_door(cline2);
  case kind of
    'C':begin
          commandline('Outputting CHAIN.TXT (WWIV) ...');
          write_chain_txt;
        end;
    'D':begin
          commandline('Outputting DORINFO1.DEF (RBBS-PC) ...');
          write_dorinfo1_def(realname);
        end;
    'G':begin
          commandline('Outputting DOOR.SYS (GAP) ...');
          write_door_sys(realname);
        end;
    'S':begin
          commandline('Outputting SFDOORS.DAT (Spitfire) ...');
          write_sfdoors_dat(realname);
        end;
    'W':begin
          commandline('Outputting CALLINFO.BBS (Wildcat!) ...');
          write_callinfo_bbs(realname);
        end;
  end;
  commandline('Now running "'+s+'"');
  sysoplog('>> '+date+' '+time+'- Door "'+s+'"');
  close(sysopf);

  getdatetime(doorstart);
  shel1; shelldos(FALSE,s,retcode); shel2;
  getdatetime(doorend);
  timediff(doortime,doorstart,doorend);

  chdir(start_dir);
  append(sysopf);

  if ((realsl<>-1) and (realdsl<>-1)) then begin
    reset(uf); seek(uf,usernum); read(uf,thisuser); close(uf);
    thisuser.sl:=savsl; thisuser.dsl:=savdsl;
  end;

  com_flush_rx;
  getdatetime(tim);

  sysoplog('>> '+date+' '+time+'- Returned (spent '+longtim(doortime)+')');
end;

end.