DP Tool Club 31/CDASC_31_1996_juillet_aout.iso/internet/rnr214.zip/RNRFUNC.PAS

Pascal/Delphi Source File | 1996-04-01 | 68KB | 2,892 lines

unit rnrfunc;

{

rnrfunc.pas - rnr functions

also see genericf.pas - split off into a separate unit to get around code
  segment size limitation

}

{$I rnr-def.pas}

interface

uses dos,genericf,rnrglob,rnrconf,rnrio,rnrfile,rnrnov;

const
  yeselevenchars=true;
  noelevenchars=false;

  yesheadersearch=true;
  noheadersearch=false;

  couldnotreadfilecookie='(could not read file)';

function basesitename(s: string): string;
function newseqnumber: integer;
function newmessageid: string;
function getalreadyread(s: string): articlefilenametype;
function joinedtogroup(var group: string): boolean;
function expandsource(var source: string; var sourcekind: sourcetype): boolean;
function joinedtoexactgroup(group: string): boolean;
function parseheadername(s: string): string;
function parseheadervalue(s: string): string;
function wafflegetconfig(tag: string): string;
function uupcgetconfig(tag: string): string;
function getconfig(tag: string): string;
function getheaderline(infilename, fieldname: string): string;
function rfcdateheadertodate(datestr: string): datet;
function ymdtodate(yyyymmdd: string): datet;
function datetostring(adate: datet): string;

{var only for efficiency}
function xsubjseq(c1,c2: char; var s1,s2: subjstringt): boolean;
function xfirstsubjg(c1,c2: char; var s1,s2: subjstringt): boolean;

function subjseq(var s1,s2: subjstringt): boolean;
function firstsubjg(var s1,s2: subjstringt): boolean;
function canonicalfirstchar(var subject: subjstringt): char;

function firstartfirst(a,b: integer): boolean;  {assuming subjseq() is true}
function isavalidgroup(group: string): boolean;
function getgroupdir(group: string): string;
function groupsattr(group: string; attr: string): string;
function groupbattr(group: string; attr: string): boolean;
function sourcedesc(source: string; sourcekind: sourcetype): string;
function getnextgroup: string;
function importantgroup(group: string): boolean;
function alreadyseen(newsgroups: string): boolean;
function getpwinfoforuser(field164,field165,fieldunix: integer;
 someuser: string): string;
function getpwinfo(field164,field165,fieldunix: integer): string;
function getpwinfo164foruser(field: integer; someuser: string): string;
function getpwinfo165foruser(field: integer; someuser: string): string;
function getpwinfounixforuser(field: integer; someuser: string): string;
function getfullnameforuser(someuser: string): string;
function extwafexpand(s: string; percenti: string; percentf: string): string;
function wafexpand(s: string): string;
function makesame(var s: string; prefix,shouldbe: string): boolean;
function chopfirstaddr(var addresses: string): string;
function expandonemail(address: string): string;
function expandmail(addresses: string): string;
function screenline(s: string): string;
function onekey(prompt: string; validkeys: string): char;
function nonhighlightonekey(prompt: string; validkeys: string): char;
function onekeydef(prompt: string; validkeys: string; default: char): char;
function ismailgroup(group: string): boolean;
function isnormalgroup(group: string): boolean;
function getsyscmd(cmd: string): string;
function searchart(filename: string; upsearchtext: string;
 headersearch: boolean): boolean;
function searchnov(filename: string; upsearchtext: string): boolean;
function ismoderated(group: string): boolean;
function isheaderinlist(header, uheaderlist: string): boolean;
function getaddressfromline(s: string): string;
function isreasonableaddress(addr: string): boolean;
function nthlayout(whichlayout: integer): layoutt;

{var only for efficiency}
function isabreakline(var s: string): boolean;

function findproblemwithmessage(messagefn: string): string;
function toomuchquoting(messagefn: string): boolean;
function toolongline(messagefn: string; maxlen: integer): boolean;
function showdebug(s: string): boolean;
function unreadarticlesin(asource: string; sourcekind: sourcetype):
 articlefilenametype;
function highestreadin(asource: string; sourcekind: sourcetype):
 articlefilenametype;
function textintext(asubtext: string; awholetext: string): boolean;


implementation

function pathizegroup(group: string; elevenchars: boolean): string;

var
  result: string;
  mangledgroup: string;
  component: string;

begin
  result := '';

  mangledgroup := crepl(group,'.',' ');

  while mangledgroup<>'' do
    begin
      component := chopfirstw(mangledgroup);

      if length(component)<=8 then
        result := result+component
      else if elevenchars then
        result := result+copy(component,1,8)+'.'+
         copy(component, max(9,length(component)-2), 3)
      else
        result := result+copy(component,1,8);

      if mangledgroup<>'' then
        result := result+'\';
    end;

  pathizegroup := result;
end;

function basesitename;

var
  result: string;
  atbang: integer;
  atpercent: integer;
  atat: integer;
  work: string;
  atdot: integer;

begin
  result := uucpname;

  atbang := pos('!',s);
  atpercent := pos('%',s);
  atat := pos('@',s);
  if atbang>0 then
    begin
      work := s;
      while atbang>0 do
        begin
          result := copy(work,1,atbang-1);
          work := copy(work,atbang+1,255);
          atbang := pos('!',work);
        end;
    end
  else if atpercent>0 then
    begin
      result := copy(s,atpercent+1,255);
      atat := pos('@',result);
      if atat>0 then
        result := copy(result,1,atat-1);
    end
  else if atat>0 then
    begin
      result := copy(s,atat+1,255);
    end;

  atdot := pos('.',result);
  if atdot>0 then
    result := copy(result,1,atdot-1);

  basesitename := result;
end;

function newseqnumber;

var
  seqf: text;
  seqfn: string;
  seqdn: string;
  newseq: integer;

begin
  newseq := 42;
  if xiface=ifacewaffle then
    if (ifaceversion='1.64') or (ifaceversion=ifaceversionunix) then
      begin
        seqdn := configdir+'\system';
        seqfn := 'seqf';
      end
    else
      begin
        seqdn := configdir+'\uucp';
        seqfn := 'sequence';
      end
  else if xiface=ifaceuupc then
    begin
      seqdn := configdir+'\uucp';
      seqfn := 'sequence';
    end
  else if xiface=ifaceuufree then
    begin
      seqdn := configdir+'\uucp';
      seqfn := 'sequence';
      if not fexists(seqfn) then
        begin
          seqdn := configdir+'\system';
          seqfn := 'seqf';
        end;
    end;

{} {I think this should be maybemkhier but it's a pain from this low-level code}
{
  maybemkhier(seqdn);
}
  mkhier(seqdn);

  seqfn := withbackslash(seqdn)+seqfn;

  safereset(seqf,seqfn);
  if fileresult=0 then
    begin
      readln(seqf,newseq);
      close(seqf);
    end;

  rewrite(seqf);
  writeln(seqf,integertozstring(newseq+1,4));
  close(seqf);

  newseqnumber := newseq;
end;

function newmessageid;

var
  result: string;

begin
  result := '<'+itoa(year mod 100)+integertozstring(month,2)+
   integertozstring(dayofmonth,2)+'.'+currenttimedigits+'.'+
   randomdigit+randomletter+randomdigit+'.'+newsreadername;

{preserve waffle's indicator mechanism}
  if (xiface=ifacewaffle) and (ifaceversion<>ifaceversionunix) then
    result := result+'.'+
     'w'+copy(ifaceversion,1,1)+copy(ifaceversion,3,2)+'w'
  else
    result := result+'.'+fromuserid;

  result := result+'@'+fqdn+'>';

  newmessageid := result;
end;

function getalreadyread;

begin
  getalreadyread := atol(ltrim(trim(copy(s,pos(' ',s)+1,255))));
end;

function closegroup(partial,full: string): boolean;

var
  result: boolean;
  partwork, fullwork: string;
  partat, fullat: integer;

begin
  result := false;

  if (numoccur('.',partial)=numoccur('.',full)) then
    begin
      result := true;

      partwork := partial+'.';
      fullwork := full+'.';

      while result and (pos('.',partwork)>0) do
        begin
          partat := pos('.',partwork);
          fullat := pos('.',fullwork);

          result := result and
           (copy(partwork,1,partat-1)=copy(fullwork,1,partat-1));

          if result then
            begin
              partwork := copy(partwork,partat+1,255);
              fullwork := copy(fullwork,fullat+1,255);
            end;
        end;
    end;

  closegroup := result;
end;

{joinedtogroup changes the parameter if and only if it isn't joined}
{to, and something else could be found that _is_ joined to}

{it looks for a initials group, or if not a substring group, or if}
{neither a mail folder}

function joinedtogroup;

var
  result: boolean;
  eachg: string;
  newname: string;
  subname: string;
  mailname: string;

begin
  result := false;

  newname := '';
  subname := '';
  mailname := '';

  reset(joinf);

  while not eof(joinf) and not result do
    begin
      readln(joinf,eachg);
      eachg := getfirstw(eachg);

      if eachg=group then
        result := true
      else
        begin
          if ismailgroup(eachg) then
            begin
            if mailname='' then
              if closegroup(group,eachg) then
                mailname := eachg;
            if mailname='' then
              if pos(group,eachg)<>0 then
                mailname := eachg;
            end
          else
            if newname='' then
              if closegroup(group,eachg) then
                newname := eachg
              else if subname='' then
                if pos(group,eachg)<>0 then
                  subname := eachg;
        end;
    end;

  if not result and (newname<>'') then
    begin
      group := newname;
      result := true;
    end;

  if not result and (subname<>'') then
    begin
      group := subname;
      result := true;
    end;

  if not result and (mailname<>'') then
    begin
      group := mailname;
      result := true;
    end;

  joinedtogroup := result;
end;

function expandsource;

var
  result: boolean;
  unslashed: string;

begin
  result := false;

  unslashed := unslash(source);

  if joinedtogroup(source) then
    begin
      sourcekind := sourcegroup;
      result := true;
    end
  else if trusted then
    if dexists(unslashed) then
      begin
        source := unslashed;
        sourcekind := sourcedir;
        result := true;
      end;

  expandsource := result;
end;

function joinedtoexactgroup;

var
  result: boolean;
  eachg: string;

begin
  result := false;

  reset(joinf);

  while not eof(joinf) and not result do
    begin
      readln(joinf,eachg);
      eachg := getfirstw(eachg);

      if eachg=group then
        result := true
    end;

  joinedtoexactgroup := result;
end;

function parseheadername;

begin
  parseheadername := copy(s,1,pos(':',s)-1);
end;

function parseheadervalue;

begin
  parseheadervalue := copy(s,pos(':',s)+2,255);
end;

function wafflegetconfig;

var
  result: string;
  infile: text;
  s: string;
  foundtag: string;

begin
  result := '';

  oldfilemode := filemode;
  if not nofilemode then
    filemode := $40;   {read only, deny none}

  if customstatic<>'' then
    begin
      safereset(infile,customstatic);
      if fileresult=0 then
        begin
          while (result='') and not eof(infile) do
            begin
              readln(infile,s);
              if s<>'' then
                if copy(s,1,1)<>'#' then
                  begin
                    foundtag := trim(ltrim(lower(parseheadername(s))));
                    if foundtag=tag then
                      begin
                        result := trim(ltrim(parseheadervalue(s)));
                      end;
                  end;
            end;
          close(infile);
        end;
    end;

  if result='' then
    begin

      safereset(infile,wafenv);

      if fileresult=0 then
        begin
          while (result='') and not eof(infile) do
            begin
              readln(infile,s);
              if s<>'' then
                if copy(s,1,1)<>'#' then
                  begin
                    foundtag := lower(trim(ltrim(parseheadername(s))));
                    if foundtag=tag then
                      begin
                        result := trim(ltrim(parseheadervalue(s)));
                      end;
                  end;
            end;
          close(infile);
        end;
    end;

  filemode := oldfilemode;

  wafflegetconfig := result;
end;

function uupcgetoneconfig(fn: string; tag: string): string;

var
  result: string;
  infile: text;
  s: string;
  foundtag: string;

begin
  result:= '';

  if fn<>'' then
    begin
      safereset(infile,fn);
      if fileresult=0 then
        begin
          while (result='') and not eof(infile) do
            begin
              readln(infile,s);
              if s<>'' then
                if copy(s,1,1)<>'#' then
                  begin
                    foundtag := trim(ltrim(copy(s,1,pos('=',s)-1)));
                    if lower(foundtag)=tag then
                      result := trim(ltrim(copy(s,pos('=',s)+1,255)));
                  end;
            end;
          close(infile);
        end;
    end;

  uupcgetoneconfig:= result;

end;

function uupcgetconfig(tag: string): string;

var
  result: string;

begin
  result := '';
  result := uupcgetoneconfig(uupcusr,tag);
  if result='' then
    result := uupcgetoneconfig(uupcsys,tag);
  uupcgetconfig := result;
end;

procedure changetag(var changed: boolean; var tag: string;
 basetag: string; waffletag, uupctag, othertag: string);

begin
  if not changed then
    if tag=basetag then
      begin
        tag := othertag;
        if xiface=ifacewaffle then
          tag := waffletag
        else if xiface=ifaceuupc then
          tag := uupctag
        else if xiface=ifaceuufree then
          tag := waffletag;
      end;
end;

function getconfig;

const
  x='';

var
  result: string;
  n: string;
  c: boolean;

begin
  result := x;

  n := tag;
  c := false;

{   changed,base tag     ,waffle tag ,uupc tag      ,other tag }

changetag(c,n,'tempdir'  ,'temporary','tempdir'     ,x);
changetag(c,n,'mailbox'  ,x          ,'mailbox'     ,x);
changetag(c,n,'fqdn'     ,'node'     ,'domain'      ,x);
changetag(c,n,'uucpname' ,'uucpname' ,'nodename'    ,x);
changetag(c,n,'spooldir' ,'spool'    ,'spool'       ,x);
changetag(c,n,'userdir'  ,'user'     ,'user'        ,x);
changetag(c,n,'outboxdir','outbox'   ,'outbox'      ,x);
changetag(c,n,'configdir','waffle'   ,'confdir'     ,x);
changetag(c,n,'fullname' ,x          ,'name'        ,x);
changetag(c,n,'home'     ,x          ,'home'        ,x);
changetag(c,n,'smarthost','smarthost','mailserv'    ,x);
changetag(c,n,'backbone' ,'backbone' ,'backbone'    ,x);
changetag(c,n,'organ'    ,'organ'    ,'organization',x);
changetag(c,n,'replyto'  ,'replyto'  ,'replyto'     ,x);
changetag(c,n,'newsroot' ,x          ,'newsdir'     ,x);

  if n<>x then
    if xiface=ifacewaffle then
      result := wafflegetconfig(n)
    else if xiface=ifaceuupc then
      result := uupcgetconfig(n)
    else if xiface=ifaceuufree then
      result := wafflegetconfig(n);

  getconfig := result;
end;

function getheaderline;

var
  result: string;
  infile: file;
  foundline: boolean;
  s: string;
  ufieldname: string;
  headerbytesseen: integer;
  morelinesinheader: boolean;
  wastes: string;
  i,j: integer;

function nextlinefrombuf: string;

var
  result: string;
  gotlf: boolean;
  c: char;

    begin {nextlinefrombuf}
      result := '';

      gotlf := false;

      while (headerbytesseen<headerbytesinmem) and not gotlf do
        begin
          inc(headerbytesseen);
          c := headerbuf[headerbytesseen];

          if (c=lf) then
            gotlf := true
          else if c<>cr then
            result := result+c;

        end;

      nextlinefrombuf := result;
    end; {nextlinefrombuf}

begin
  result := '';
  ufieldname := upper(fieldname);

  foundline := false;

  if headerinmem<>infilename then
    begin

      oldfilemode := filemode;
      if not nofilemode then
        filemode := $40;   {read only, deny none}

      assign(infile,infilename);
      {$I-}
      reset(infile,1);
      {$I+}

      if ioresult=0 then
        begin
          blockread(infile,headerbuf,headerbufsize,headerbytesinmem);
          headerinmem := infilename;
          close(infile);
        end
      else
        begin
          for i := 1 to headerbufsize do
            headerbuf[i] := ' ';
          result := couldnotreadfilecookie;
          foundline := true;
        end;

      filemode := oldfilemode;

      for i := 1 to headertlsize do
        begin
          headertrackedlines[i].first := #0;
          headertrackedlines[i].offset := -1;
        end;

      headertrackedlines[1].first := upcase(headerbuf[1]);
      headertrackedlines[1].offset := 1;

      j := 1;
      i := 0;
      while (i<headerbufsize-2) and (j<headertlsize) do
        begin
          inc(i);
          if headerbuf[i]=lf then
            if headerbuf[i+2]=lf then
              i := headerbufsize {found the empty line}
            else
              begin
                inc(j);
                headertrackedlines[j].first := upcase(headerbuf[i+1]);
                headertrackedlines[j].offset := i+1;
              end;
        end;

{$ifdef testfastheaders}
for i := 1 to min(10,headertlsize) do
  writeln(headertrackedlines[i].offset:3,' ',headertrackedlines[i].first);
delay(1000);
{$endif}

    end;

{$ifdef veryoldheader}

  foundblank := false;

  while not eof(f) and not foundblank and not foundline do
    begin
      readln(f,s);
      if copy(upper(ltrim(s)),1,length(fieldname))=ufieldname then
        begin
          foundline := true;
          result := ltrim(trim(copy(trim(s),length(fieldname)+1,255)));
          if not eof(f) then
            begin
              readln(f,s);
              if copy(s,1,1)=' ' then
                result := result+s;
            end;
        end
      else if s='' then
        foundblank := true;
    end;
  close(f);
{$endif}

{$ifdef oldheader}

  foundblank := false;

  headerbytesseen := 0;
  while (headerbytesseen<headerbytesinmem) and
   not foundblank and not foundline do
    begin
      s := nextlinefrombuf;
      if copy(upper(ltrim(s)),1,length(fieldname))=ufieldname then
        begin
          foundline := true;
          result := ltrim(trim(copy(trim(s),length(fieldname)+1,255)));
          if headerbytesseen<headerbytesinmem then
            begin
              morelinesinheader := true;
              while morelinesinheader do
                begin
                  s := nextlinefrombuf;
                  if (copy(s,1,1)=' ') or (copy(s,1,1)=tab) then
                    begin
                      s := ltrim(s);

{handle References: line specially - always get the last part}

                      if ufieldname='REFERENCES:' then
                        begin
                          if length(s)>200 then
                            result := s
                          else
                            begin
                              if length(result)+length(s)>200 then
                                wastes := chopfirstw(result);
                              if length(result)+length(s)>200 then
                                wastes := chopfirstw(result);
                              if length(result)+length(s)>200 then
                                wastes := chopfirstw(result);
                              if length(result)+length(s)>200 then
                                wastes := chopfirstw(result);
                              result := result+' '+s;
                            end;
                        end
                      else
                        result := result+' '+s;
                    end
                  else
                    morelinesinheader := false;
                end;
            end;
        end
      else if s='' then
        foundblank := true;
    end;

{$endif}

  j := 0;
  while (j<headertlsize) and not foundline do
    begin
      inc(j);
      if headertrackedlines[j].first=ufieldname[1] then
        begin
          headerbytesseen := headertrackedlines[j].offset-1;
          s := nextlinefrombuf;
          if copy(upper(ltrim(s)),1,length(fieldname))=ufieldname then
            begin
              foundline := true;
              result := ltrim(copy(trim(s),length(fieldname)+1,255));
              if headerbytesseen<headerbytesinmem then
                begin
                  morelinesinheader := true;
                  while morelinesinheader do
                    begin
                      s := nextlinefrombuf;
                      if (copy(s,1,1)=' ') or (copy(s,1,1)=tab) then
                        begin
                          s := ltrim(s);

{handle References: line specially - always get the last part}

                          if ufieldname='REFERENCES:' then
                            begin
                              if length(result)+length(s)>200 then
                                wastes := chopfirstw(result);
                              result := result+' '+s;
                            end
                          else
                            result := result+' '+s;
                        end
                      else
                        morelinesinheader := false;
                    end;
                end;
            end;
        end;
    end;

  getheaderline := result;
end;

{}{} {doesn't handle time zones at all - but at least when a user}
     {posts twice on the same day, the tz will be the same each time}
     {and thus correctly ordered for that user's posts}

function rfcdateheadertodate;

var
  result: datet;
  workstr: string;
  dayofmonth: longint;
  monthstr: string;
  month: longint;
  year: longint;
  gmthour: longint;

begin
  result := 9999*16384;

  if datestr<>'' then
    begin
      workstr := datestr;
      dayofmonth := snatchint(workstr);
      workstr := ltrim(workstr);
      monthstr := copy(workstr,1,3);
      month := monthstringtointeger(monthstr);
      workstr := ltrim(lchop(workstr,4));
      year := snatchint(workstr);
      if year<100 then
        inc(year,1900);
      gmthour := snatchint(workstr);
      result := year*16384+month*1024+dayofmonth*32+gmthour;
    end;

  rfcdateheadertodate := result;
end;

function ymdtodate;

var
  result: datet;

  workstr: string;
  dayofmonth: longint;
  month: longint;
  year: longint;
  gmthour: longint;

begin
  result := 9999*16384;

  if yyyymmdd<>'' then
    begin
      workstr := yyyymmdd;
      year := snatchint(workstr);
      month := snatchint(workstr);
      dayofmonth := snatchint(workstr);
      if year<100 then
        inc(year,1900);
      gmthour := 0;
      result := year*16384+month*1024+dayofmonth*32+gmthour;
    end;

  ymdtodate := result;
end;

function datetostring(adate: datet): string;

var
  result: string;

begin
  datetostring := ymdtostring(
   adate div 16384,
   (adate mod 16384) div 1024,
   (adate mod 1024) div 32);
end;

{var only for efficiency}

function canonicalsubj(var subject: subjstringt): subjstringt;

var
  result: subjstringt;
  tempstr: string;
  i: integer;

begin
  result := '';

  if subjectlength=255 then
    result := subject
  else
    result := copy(subject,1,subjectlength);

  if subjectscaseinsensitive then
    result := upper(result);

  if squashspaces then
    begin
      tempstr := '';
      for i := 1 to length(result) do
        if (result[i]<>' ') and (result[i]<>tab) then
          tempstr := tempstr+result[i];
      result := tempstr;
    end;

  canonicalsubj := result;
end;

{var only for efficiency}

{no longer used, since every time I call it I already have canonicalsubj}

function canonicalfirstchar;

var
  result: char;
  tempi: integer;

begin
  result := ' ';

  if subject<>'' then
    begin
      if not squashspaces then
        result := subject[1]
      else
        begin

{$ifdef slow}
          tempstr := ltrim(subject)+' ';  {if it's empty, return space}
          result := tempstr[1];
{$endif}

          for tempi := 1 to length(subject) do
            if (result=' ') and (subject[tempi]<>tab) then
              result := subject[tempi];
        end;

      if subjectscaseinsensitive then
        result := upcase(result);
    end;

  canonicalfirstchar := result;
end;

{var only for efficiency}

{ string comparison for the shorter string -- unless it's empty }

function subjshortequal(var s1,s2: subjstringt): boolean;

var
  result: boolean;

  len1: integer;
  len2: integer;

begin
  result := false;

  len1 := length(s1);
  len2 := length(s2);

  if (len1=0) and (len2=0) then
    result := true
  else if (len1=0) or (len2=0) then
    result := false
  else if len1=len2 then
    result := (s1=s2)
  else if (len1<len2) and (len1>=equatetruncated) then
    result := (s1=copy(s2,1,len1))
  else if (len2<len1) and (len2>=equatetruncated) then
    result := (copy(s1,1,len2)=s2)
  else
    result := false;  {lengths aren't the same, so can't be equal}

  subjshortequal := result;
end;

{s1 and s2 var for efficiency}
procedure copytocanon(var s1,s2: subjstringt; var canon1,canon2: subjstringt);

begin
  canon1 := canonicalsubj(s1);
  canon2 := canonicalsubj(s2);
end;

function xsubjseq;

var
  result: boolean;
  canon1,canon2: subjstringt;

begin
  result := false;

  if equatetruncated<>0 then
    begin
      if (s1='') or (s2='') or (c1=c2) then
        begin
          copytocanon(s1,s2,canon1,canon2);
          result := subjshortequal(canon1,canon2);
        end
      else
        result := false;
    end
  else
    begin
      if (s1='') or (s2='') or (c1=c2) then
        begin
          copytocanon(s1,s2,canon1,canon2);
          result := (canon1=canon2);
        end
      else
        result := false;
    end;

  xsubjseq := result;
end;

function xfirstsubjg;

var
  result: boolean;
  canon1: subjstringt;
  canon2: subjstringt;

begin
  result := false;

  if (s1='') or (s2='') then
    begin
      copytocanon(s1,s2,canon1,canon2);
      result := (canon1>canon2);
    end
  else if c1<c2 then
    result := false
  else
    begin
      copytocanon(s1,s2,canon1,canon2);
      result := (canon1>canon2);
      if equatetruncated<>0 then
        result := result and not subjshortequal(canon1,canon2);
    end;

  xfirstsubjg := result;
end;

function subjseq;

var
  c1,c2: char;

begin
  c1 := canonicalfirstchar(s1);
  c2 := canonicalfirstchar(s2);

  subjseq := xsubjseq(c1,c2,s1,s2);
end;

function firstsubjg;

var
  c1,c2: char;

begin
  c1 := canonicalfirstchar(s1);
  c2 := canonicalfirstchar(s2);

  firstsubjg := xfirstsubjg(c1,c2,s1,s2);
end;

function hasheq(h1,h2: hashedt): boolean;

begin
  hasheq := (h1[1]=h2[1]) and (h1[2]=h2[2]);
end;

function firstartfirst;

var
  result: boolean;

begin
  result := true;

{$ifdef testhash}

if true then
  begin
    writeln('#',a,' mes=',hmessageidsp^[a,1]:5,' ',hmessageidsp^[a,2]:5);
    writeln('#',a,' ref=',
     hreferencesp[1]^[a,1]:5,' ',hreferencesp[1]^[a,2]:5,' ',
     hreferencesp[2]^[a,1]:5,' ',hreferencesp[2]^[a,2]:5,' ',
     hreferencesp[3]^[a,1]:5,' ',hreferencesp[3]^[a,2]:5,' ',
     hreferencesp[4]^[a,1]:5,' ',hreferencesp[4]^[a,2]:5);
    writeln('#',b,' mes=',hmessageidsp^[b,1]:5,' ',hmessageidsp^[b,2]:5);
    writeln('#',b,' ref=',
     hreferencesp[1]^[b,1]:5,' ',hreferencesp[1]^[b,2]:5,' ',
     hreferencesp[2]^[b,1]:5,' ',hreferencesp[2]^[b,2]:5,' ',
     hreferencesp[3]^[b,1]:5,' ',hreferencesp[3]^[b,2]:5,' ',
     hreferencesp[4]^[b,1]:5,' ',hreferencesp[4]^[b,2]:5);

  if hasheq(hmessageidsp^[b],hreferencesp[1]^[a]) then
    writeln('#',b,' ',filenamesp^[b],' before #',a,' ',filenamesp^[a])
  else if hasheq(hmessageidsp^[b],hreferencesp[2]^[a]) then
    writeln('#',b,' ',filenamesp^[b],' before #',a,' ',filenamesp^[a])
  else if hasheq(hmessageidsp^[b],hreferencesp[3]^[a]) then
    writeln('#',b,' ',filenamesp^[b],' before #',a,' ',filenamesp^[a])
  else if hasheq(hmessageidsp^[b],hreferencesp[4]^[a]) then
    writeln('#',b,' ',filenamesp^[b],' before #',a,' ',filenamesp^[a])
  else
    writeln('#',b,' ',filenamesp^[b],' not refd by #',a,' ',filenamesp^[a]);


  if hasheq(hmessageidsp^[a],hreferencesp[1]^[b]) then
    writeln('#',a,' ',filenamesp^[a],' before #',b,' ',filenamesp^[b])
  else if hasheq(hmessageidsp^[a],hreferencesp[2]^[b]) then
    writeln('#',a,' ',filenamesp^[a],' before #',b,' ',filenamesp^[b])
  else if hasheq(hmessageidsp^[a],hreferencesp[3]^[b]) then
    writeln('#',a,' ',filenamesp^[a],' before #',b,' ',filenamesp^[b])
  else if hasheq(hmessageidsp^[a],hreferencesp[4]^[b]) then
    writeln('#',a,' ',filenamesp^[a],' before #',b,' ',filenamesp^[b])
  else
    writeln('#',a,' ',filenamesp^[a],' not refd by #',b,' ',filenamesp^[b]);

  end;

{$endif}

  if hasheq(articles[b]^.hmessageid,articles[a]^.hreferences[1]) then
    result := false
  else if hasheq(articles[b]^.hmessageid,articles[a]^.hreferences[2]) then
    result := false
  else if hasheq(articles[b]^.hmessageid,articles[a]^.hreferences[3]) then
    result := false
  else if hasheq(articles[b]^.hmessageid,articles[a]^.hreferences[4]) then
    result := false
  else
    if not hasheq(articles[a]^.hmessageid,articles[b]^.hreferences[1]) then
      if not hasheq(articles[a]^.hmessageid,articles[b]^.hreferences[2]) then
        if not hasheq(articles[a]^.hmessageid,articles[b]^.hreferences[3]) then
          if not hasheq(articles[a]^.hmessageid,articles[b]^.hreferences[4]) then
            begin

{no conclusive proof - just guess}

              if articles[a]^.date>articles[b]^.date then
                result := false
              else if articles[a]^.date=articles[b]^.date then
                if
                 (articles[a]^.indents and $f)
                 >
                 (articles[b]^.indents and $f) then
                  result := false;
            end;

{$ifdef testsort}
  if showdebug('sort') then
    begin
      write('firstartfirst(',a,'(',articles[a]^.filename:5,')',',',
       b,'(',articles[b]^.filename:5,')',')=');
      if result then writeln('true') else writeln('false');
{$ifdef pauseintestsort}
      xwrites('pausing...');
      xwritelns(xreadkey);
{$endif}
    end;

{$endif}

  firstartfirst := result;
end;

{need to use an ACTIVE file on those which have them}
function isavalidgroup;

begin
  isavalidgroup := (getgroupdir(group)<>'');
end;

function wafflefogetgroupdir(group: string; forumset: string): string;

var
  result: string;
  infilen: string;
  infile: text;
  s: string;
  foundgroup: boolean;
  default: string;
  defaultdir: string;

begin
  result := '';

  foundgroup := false;
  default := '';

  oldfilemode := filemode;
  if not nofilemode then
    filemode := $40;   {read only, deny none}

  infilen := configdir+'\system\'+forumset;

  safereset(infile,infilen);

  if fileresult=0 then
    begin
      while not foundgroup and not eof(infile) do
        begin
          readln(infile,s);
          foundgroup := (getfirstw(s)=group);
          if pos('/dir=',s)>0 then
            begin
              if getfirstw(s)=group then
                begin
                  result := trim(ltrim(copy(s,pos('/dir=',s)+5,255)));
                  result := unquote(getfirstw(unslash(result)));
                end
              else if getfirstw(s)='DEFAULT' then
                default := s;
            end;
        end;
      close(infile);
    end;

  filemode := oldfilemode;

  if (result='') and (default<>'') and foundgroup then
    begin

      defaultdir := trim(ltrim(copy(default,pos('/dir=',default)+5,255)));
      defaultdir := unquote(getfirstw(unslash(defaultdir)));

{waffle treats /dir=x: to mean /dir=x:\ anyway}

      defaultdir := withbackslash(defaultdir);
      result := defaultdir+pathizegroup(group,noelevenchars);

    end;

  wafflefogetgroupdir := result;
end;

function secondarygetgroupdir(group: string): string;

var
  result: string;
  forumset: string;
  mungedl: string;

begin
  result := '';

  if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
    begin
      mungedl := forumsetl;
      while (result='') and (mungedl<>'') do
        begin
          forumset := chopfirstw(mungedl);
          result := wafflefogetgroupdir(group,forumset);
        end;
    end
  else if xiface=ifaceuupc then
    begin
      result := withbackslash(getconfig('newsroot'))+
       pathizegroup(group,yeselevenchars);
    end;

  secondarygetgroupdir := result;
end;

function getgroupdir;

var
  result: string;
  nonprefix: string;
  partialprefix: string;
  i: integer;

begin
  result := '';

  if ismailgroup(group) then
    begin

{partialprefix is mailprefix without the `.userid' bits}

      partialprefix := copy(group,1,length(mailprefix)-1-length(userid));

      if group=mailprefix then
        begin

{look for just partialprefix, and add individual user ids on after}

          result := secondarygetgroupdir(partialprefix);
          if result<>'' then
            result := withbackslash(result)+userid;
        end

      else

        begin

{must be a folder}

{look for user's home mail directory, then add folders onto end}

          nonprefix := copy(group,length(mailprefix)+2,255);  { lose the . }

          nonprefix := crepl(nonprefix,'.','\');
          result := getgroupdir(partialprefix);
          if result<>'' then
            result := withbackslash(result)+userid+'\'+nonprefix;
        end;

    end;

  if result='' then
    result := secondarygetgroupdir(group);

  getgroupdir := result;
end;

{}{}{}{} {need to make sure it's not inside some option's path}

function fogroupsattr(group: string; attr: string; forumset: string): string;

var
  result: string;
  infilen: string;
  infile: text;
  s: string;
  foundgroup: boolean;
  default: string;

begin
  result := '';

  foundgroup := false;
  default := '';

  oldfilemode := filemode;
  if not nofilemode then
    filemode := $40;   {read only, deny none}

  infilen := configdir+'\system\'+forumset;

  safereset(infile,infilen);

  if fileresult=0 then
    begin
      while not foundgroup and not eof(infile) do
        begin
          readln(infile,s);
          foundgroup := (getfirstw(s)=group);
          if pos(attr,s)>0 then
            begin
              if foundgroup then
                result :=
                 getfirstw(trim(ltrim(copy(s,pos(attr,s)+length(attr),255))))
              else if getfirstw(s)='DEFAULT' then
                default := s;
            end;
        end;
      close(infile);
    end;

  filemode := oldfilemode;

  if (result='') and (default<>'') and foundgroup then
    result :=
     getfirstw(trim(ltrim(copy(default,pos(attr,default)+length(attr),255))));

  fogroupsattr := result;
end;

function groupsattr;

var
  result: string;
  forumset: string;
  mungedl: string;

begin
  result := '';

  if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
    begin
      mungedl := forumsetl;
      while (result='') and (mungedl<>'') do
        begin
          forumset := chopfirstw(mungedl);
          result := fogroupsattr(group,attr,forumset);
        end;
    end;

  groupsattr := result;
end;

{}{}{}{} {need to make sure it's not inside some option's path}

function fogroupbattr(group: string; attr: string; forumset: string): boolean;

var
  result: boolean;
  infilen: string;
  infile: text;
  s: string;
  foundgroup: boolean;
  default: string;

begin
  result := false;

  foundgroup := false;
  default := '';

  oldfilemode := filemode;
  if not nofilemode then
    filemode := $40;   {read only, deny none}

  infilen := configdir+'\system\'+forumset;

  safereset(infile,infilen);

  if fileresult=0 then
    begin
      while not foundgroup and not eof(infile) do
        begin
          readln(infile,s);
          foundgroup := (getfirstw(s)=group);
          if pos(attr,s)>0 then
            begin
              if foundgroup then
                result := true
              else if getfirstw(s)='DEFAULT' then
                default := s;
            end;
        end;
      close(infile);
    end;

  filemode := oldfilemode;

  if (default<>'') and foundgroup then
    result := true;

  fogroupbattr := result;
end;

function groupbattr;

var
  result: boolean;
  forumset: string;
  mungedl: string;

begin
  result := false;

  if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
    begin
      mungedl := forumsetl;
      while not result and (mungedl<>'') do
        begin
          forumset := chopfirstw(mungedl);
          result := fogroupbattr(group,attr,forumset);
        end;
    end;

  groupbattr := result;
end;

function fogroupdesc(group: string; forumset: string): string;

var
  result: string;
  infilen: string;
  infile: text;
  s: string;
  foundgroup: boolean;

begin
  result := '';

  foundgroup := false;

  oldfilemode := filemode;
  if not nofilemode then
    filemode := $40;   {read only, deny none}

  infilen := configdir+'\words\'+forumset;

  safereset(infile,infilen);

  if fileresult=0 then
    begin
      while not foundgroup and not eof(infile) do
        begin
          readln(infile,s);
          foundgroup := (chopfirstw(s)=group);
          if foundgroup then
            result := s;
        end;
      close(infile);
    end;

  filemode := oldfilemode;

  fogroupdesc := result;
end;

function groupdesc(group: string): string;

var
  result: string;
  forumset: string;
  mungedl: string;

begin
  result := '';

  if ismailgroup(group) then
    result := 'mail folder';

  if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
    begin
      mungedl := forumsetl;
      while (result='') and (mungedl<>'') do
        begin
          forumset := chopfirstw(mungedl);
          result := fogroupdesc(group,forumset);
        end;
    end;

  if result='' then
    result := '(unknown description)';

  groupdesc := result;
end;

function sourcedesc;

begin
  if sourcekind=sourcegroup then
    sourcedesc := groupdesc(source)
  else if sourcekind=sourcedir then
    sourcedesc := 'directory'
  else if sourcekind=sourcefolder then
    sourcedesc := 'folder'
  else
    sourcedesc := '(internal error)'
end;

function getnextgroup: string;

var
  foundgroup: string;
  result: string;

begin

{}{} {this should use joinedgroups[] if possible}

  result := '';
  reset(joinf);
  foundgroup := '';

  if not eof(joinf) then
    begin
      if currsource='' then
        begin
          readln(joinf,foundgroup);
          result := getfirstw(foundgroup);
        end
      else
        begin
          while not eof(joinf) and (foundgroup<>currsource) do
            begin
              readln(joinf,foundgroup);
              foundgroup := getfirstw(foundgroup);
            end;

{if we were reading a group we weren't joined to, restart from top}
          if foundgroup<>currsource then
            reset(joinf);

          if not eof(joinf) then
            begin
              readln(joinf,foundgroup);
              result := getfirstw(foundgroup);
            end;
        end;
    end;

  getnextgroup := result;
end;

function importantgroup;

var
  result: boolean;

begin
  result :=
   (copy(group,1,14)='news.announce.') or
   ((numoccur('.',group)=1) and (right(group,8)='.answers'));
  importantgroup := result;
end;

function alreadyseen;

var
  result: boolean;
  i: integer;
  newsglist: string;
  found: boolean;

begin
  result := false;

  if (currsource<>'control') and (currsource<>'monitor') and
   not importantgroup(currsource) then
    begin
      newsglist := ','+newsgroups+',';
      if pos(','+currsource+',' , newsglist)<>0 then  {for news moved by hand}
        begin
          found := false;
          i := 1;
          while (i<numjoined) and not found do
            begin
              if not importantgroup(joinedgroups[i]) and
               (pos(','+joinedgroups[i]+',',newsglist)<>0) then
                begin
                  found := true;
                  result := (joinedgroups[i]<>currsource);
                end;
              inc(i);
            end;
        end;
    end;

  alreadyseen := result;
end;

function getpwinfo;

begin
  getpwinfo := getpwinfoforuser(field164,field165,fieldunix,userid);
end;

function getpwinfoforuser;

var
  result: string;

begin
  result := '{internal error}';

  if xiface=ifaceuufree then
    result := getpwinfounixforuser(fieldunix,someuser)
  else if ifaceversion=ifaceversionunix then
    result := getpwinfounixforuser(fieldunix,someuser)
  else if ifaceversion='1.64' then
    result := getpwinfo164foruser(field164,someuser)
  else if ifaceversion>='1.65' then
    result := getpwinfo165foruser(field165,someuser)
  else
    result := '{unknown ifaceversion: '+ifaceversion+'}';

  getpwinfoforuser := result;
end;

function getpwinfo164foruser;

const
  passwordblocksize=256;

type
  passwordbuft=array[1..passwordblocksize] of char;

var
  result: string;
  passwordbuf: passwordbuft;
  passwordf: file;
  found: boolean;

function passwordentry164(fieldnum: integer): string;

var
  i: integer;
  lfs: integer;
  result: string;

begin
  result := '';
  lfs := 0;
  for i := 1 to passwordblocksize do
    begin
      if passwordbuf[i]=lf then
        inc(lfs);
      if (lfs=fieldnum) and (passwordbuf[i]<>lf) then
        result := result+passwordbuf[i];
    end;
  passwordentry164 := result;
end;

begin
  result := '';
  found := false;

  oldfilemode := filemode;
  if not nofilemode then
    filemode := $40;   {read only, deny none}

  assign(passwordf,configdir+'\admin\'+'password');
  {$I-}
  reset(passwordf,1);
  {$I+}

  if ioresult=0 then
    begin
      blockread(passwordf,passwordbuf,passwordblocksize);
      while not found and not eof(passwordf) do
        begin
          blockread(passwordf,passwordbuf,passwordblocksize);
          if passwordentry164(0)=someuser then
            begin
              result := passwordentry164(field);
              found := true;
            end;
        end;
      close(passwordf);
    end;

  filemode := oldfilemode;

  getpwinfo164foruser := result;
end;

function getpwinfo165foruser;

const
  passwordblocksize=1024;

type
  passwordbuft=array[1..passwordblocksize] of char;

var
  result: string;
  passwordbuf: passwordbuft;
  passwordf: file;
  found: boolean;

function fieldsize165(fieldnum: integer): integer;

var
  result: integer;

begin
  result := 0;
  case fieldnum of
    1: result := 12; {name}
    2: result := 12; {pass}
    3: result := 24; {identity}         {I'm told _this_ is the one for %W}
    4: result := 24; {realname}
    5: result := 22; {phone}
    6: result := 40; {shell}
    7: result := 10; {editor}
    8: result := 10; {console}
    9: result := 66; {comment}
   10: result := 8;  {level}
   11: result := 10; {terminal}
   12: result := 10; {language}
   13: result := 10; {suite}
   14: result := 10; {account}
   15: result := 12; {group}
   16: result := 2;  {access}
   17: result := 8;  {priv}
   18: result := 12; {age}
   19: result := 2;  {color}
   20: result := 5;  {encryption}
   21: result := 8;  {help}
  end;
  fieldsize165 := result;
end;

function fieldstart165(fieldnum: integer): integer;

var
  i: integer;
  result: integer;

begin
  result := 0;
  for i := 1 to fieldnum-1 do
    inc(result,fieldsize165(i));
  fieldstart165 := result;
end;

function passwordentry165(fieldnum: integer): string;

var
  result: string;
  i: integer;
  start: integer;
  size: integer;
  ch: char;
  done: boolean;

begin
  result := '';

  size := fieldsize165(fieldnum);
  start := fieldstart165(fieldnum);
  done := false;
  i := 1;
  while (i<=size) and not done do
    begin
      ch := passwordbuf[i+start];
      if ch=#0 then
        done := true
      else
        result := result+ch;
      inc(i);
    end;

  passwordentry165 := result;
end;

begin
  result := '';
  found := false;

  oldfilemode := filemode;
  if not nofilemode then
    filemode := $40;   {read only, deny none}

  assign(passwordf,configdir+'\admin\'+'password');
  {$I-}
  reset(passwordf,1);
  {$I-}

  if ioresult=0 then
    begin
      blockread(passwordf,passwordbuf,passwordblocksize);
      while not found and not eof(passwordf) do
        begin
          blockread(passwordf,passwordbuf,passwordblocksize);
          if passwordentry165(1)=someuser then
            begin
              result := passwordentry165(field);
              found := true;
            end;
        end;
      close(passwordf);
    end;

  filemode := oldfilemode;

  getpwinfo165foruser := result;
end;

function getpwinfounixforuser;

var
  result: string;
  passwordf: text;
  passwordline: string;
  found: boolean;
  chopfieldcount: integer;

begin
  result := '';
  found := false;

  oldfilemode := filemode;
  if not nofilemode then
    filemode := $40;   {read only, deny none}

  safereset(passwordf,configdir+'\etc\'+'passwd');

  if fileresult=0 then
    begin
      while not found and not eof(passwordf) do
        begin
          readln(passwordf,passwordline);
          if copy(passwordline,1,length(someuser)+1)=someuser+':' then
            begin
              for chopfieldcount := 1 to field-1 do
                passwordline :=
                 copy(passwordline,pos(':',passwordline)+1,255);

              passwordline := passwordline+':';
              result := copy(passwordline,1,pos(':',passwordline)-1);

              found := true;
            end;
        end;
      close(passwordf);
    end;

  filemode := oldfilemode;

  getpwinfounixforuser := result;
end;

{someuser needs to be lowercase for waffle, and probably uupc}
function getfullnameforuser(someuser: string): string;

var
  result: string;

begin
  result := '';

  if (result='') and ((xiface=ifacewaffle) or (xiface=ifaceuufree)) then
    result := trim(getpwinfoforuser(5,3,5,someuser));

{uupc only has full-name info for current user}
  if (result='') and (someuser=userid) and (xiface=ifaceuupc) then
    result := getconfig('fullname');

{environment only has full-name info for current user}
  if (result='') and (someuser=userid) and not ignoreenvironment then
    result := trim(ununderscore(getenv('FULLNAME')));

  getfullnameforuser := result;
end;

function extwafexpand;

var
  result: string;
  tempint: integer;
  tempchar: char;

begin
  if pos('%',s)=0 then
    result := s
  else
    begin
      result := '';
      tempint := 1;
      while tempint<=length(s) do
        begin
          if (s[tempint]<>'%') or (tempint=length(s)) then
            result := result+s[tempint]
          else
            begin
              inc(tempint);
              tempchar := s[tempint];
              case tempchar of
                '%': result := result+'%';
                '^': result := result+'^';
                'A': result := result+userid;
                'W': result := result+fullname;
                'n': result := result+fqdn;
                'u': result := result+uucpname;
                'F': result := result+trim(getpwinfo(5,4,5));
                'i': result := result+percenti;

              {%f is non-standard!}
                'f': result := result+percentf;

              {%_ will be in waffle 1.66}
                '_': result := result+crepl(fullname,' ','_');

                else result := result+'{unknown flag %'+tempchar+'}';
              end;
            end;

          inc(tempint);
        end;
    end;

  extwafexpand := result;
end;

function wafexpand;

begin
  wafexpand := extwafexpand(s,'{error}','{error}');
end;

function makesame;

var
  result: boolean;

begin
  result := false;

  if copy(s,1,length(prefix))=prefix then
    if s<>prefix+shouldbe then
      begin
        s := prefix+shouldbe;
        result := true;
      end;

  makesame := result;
end;

function chopfirstaddr;

var
  result: string;
  inquote: boolean;
  charlookingat: integer;
  done: boolean;

begin
  result := '';
  inquote := false;

  charlookingat := 1;

  done := false;
  while not done do
    begin
      if charlookingat>length(addresses) then
        begin

{only one address in the list}
          done := true;
          result := addresses;
          addresses := '';
        end
      else if addresses[charlookingat]='"' then
        begin

{it's a quote}
          inquote := not inquote;
        end
      else if (addresses[charlookingat]=',') and not inquote then
        begin

{it's a non-quoted separator -- remove the separator and split}
          done := true;
          result := copy(addresses,1,charlookingat-1);
          addresses := copy(addresses,charlookingat+1,255);
        end;

      inc(charlookingat);
    end;

  if inquote then
    begin
      { there's definitely an error if the quote never got closed }
      {}{}{}{}
      writeln('error -- " never got closed');
    end;

  result := trim(ltrim(result));

  chopfirstaddr := result;
end;

function expandonemail;

var
  result: string;
  newaddressfn: string;
  newaddressf: text;
  changed: boolean;
  s: string;

begin
  result := address;

  changed := false;
  if (pos('@',address)=0) and
   (pos('!',address)=0) and
   (pos(' ',address)=0) then
    begin

      if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
        newaddressfn := configdir+'\system\'+'aliases'
      else if xiface=ifaceuupc then
        begin
          newaddressfn := unslash(getconfig('aliases'));
          if newaddressfn='' then
            newaddressfn := home+'\aliases'
          else if numoccur('\',newaddressfn)=0 then
            newaddressfn := withbackslash(home)+newaddressfn;
        end
      else
        newaddressfn := 'aliases';

      oldfilemode := filemode;
      if not nofilemode then
        filemode := $40;   {read only, deny none}

      safereset(newaddressf,newaddressfn);

      if fileresult=0 then
        begin
          while not changed and not eof(newaddressf) do
            begin
              readln(newaddressf,s);
              if lower(chopfirstw(s))=lower(address) then
                begin
                  changed := true;
                  result := s;
                end;
            end;
          close(newaddressf);
        end;

      if not changed then
        begin
          newaddressfn := home+'\aliases';

          safereset(newaddressf,newaddressfn);

          if fileresult=0 then
            begin
              while not changed and not eof(newaddressf) do
                begin
                  readln(newaddressf,s);
                  if lower(chopfirstw(s))=lower(address) then
                    begin
                      changed := true;
                      result := s;
                    end;
                end;
              close(newaddressf);
            end;
        end;

      if not changed then
        begin

{make sure no chance of security hole - no .. or \ or / or : in address}

{don't need to make sure it's not a device - last part of name is always}
{the string 'forward'}

         if (pos('/',address)=0) and (pos(':',address)=0) and
          (pos('\',address)=0) and (pos('..',address)=0) then
           begin
             newaddressfn := withbackslash(userdir)+address+'\forward';

             safereset(newaddressf,newaddressfn);

             if fileresult=0 then
               begin
                 if not eof(newaddressf) then
                   begin
                     changed := true;
                     readln(newaddressf,result);
                   end;
                 close(newaddressf);
               end;
           end;
        end;
      filemode := oldfilemode;
    end;

  expandonemail := result;
end;

function expandmail;

var
  result: string;
  separator: string;
  mangledaddresses: string;
  oneaddress: string;
  onebareaddress: string;
  alladdresses: string;

begin
  result := '';

  alladdresses := addresses;

{}{} {not perfect if you have quoting, but fairly good considering it's}
     {illegal to begin with}

{change `chris pat' into `chris, pat' for expansion}
{change `chris pat,sam' into `chris, pat, sam' for expansion}

  if (pos('@',alladdresses)=0) and (pos('!',alladdresses)=0) and
   (pos('(',alladdresses)=0) and (pos('"',alladdresses)=0) then
    begin
      mangledaddresses := uncomma(alladdresses);
      alladdresses := '';
      separator := '';
      while mangledaddresses<>'' do
        begin
          oneaddress := chopfirstw(mangledaddresses);
          alladdresses := alladdresses+separator+oneaddress;
          separator := ', ';
        end;
    end;

  separator := '';
  mangledaddresses := alladdresses;
  while mangledaddresses<>'' do
    begin
      oneaddress := chopfirstaddr(mangledaddresses);
      onebareaddress := getfromaddr(oneaddress);
      result := result+separator+expandonemail(onebareaddress);
      separator := ', ';
    end;

  result := ltrim(trim(result));

  expandmail := result;
end;

function screenline;

begin
  screenline := trim(expand(s));
end;

function extonekey(highlight: boolean; prompt: string;
 validkeys: string): char;

var
  result: char;
  i: integer;

begin
  result := ' ';

  xclreolxy(1,lpp);
  if highlight then
    xwritehighlights(prompt)
  else
    xwrites(prompt);

  xwrites(' ');
  repeat
    result := xreadkey;
  until pos(result,validkeys)<>0;

{caller has to clear line after - might not want to right away}
  extonekey := result;
end;

function onekey;

begin
  onekey := extonekey(true,prompt,validkeys);
end;

function nonhighlightonekey;

begin
  nonhighlightonekey := extonekey(false,prompt,validkeys);
end;

function onekeydef;

var
  result: char;
  newprompt: string;
  newvalid: string;

begin
  newprompt := prompt+' ('+default+')';
  newvalid := validkeys+' '+chr(13);
  result := onekey(newprompt,newvalid);

  if result=' ' then
    result := default;

  if result=chr(13) then
    result := default;

  onekeydef := result;
end;

function ismailgroup;

begin
  ismailgroup := (copy(group,1,length(mailprefix))=mailprefix);
end;

function isnormalgroup;

begin
  isnormalgroup := not ismailgroup(group);
end;

function getsyscmd;

var
  result: string;
  infn: string;
  inf: text;
  s: string;

begin
  result := '';

  infn := withbackslash(configdir)+'extern'+'\'+'_system';

  safereset(inf,infn);
  if fileresult=0 then
    begin
      while not eof(inf) do
        begin
          readln(inf,s);
          s := ltrim(s);
          if getfirstw(s)=cmd then
            result := gettag('/command=',s);
        end;
    end;

  getsyscmd := result;
end;

function searchart;

var
  result: boolean;
  toofar: boolean;
  inf: text;
  inheaders: boolean;
  s: string;
  c: char;
  lineread: boolean;
  faqs: boolean;

begin
  result := false;
  faqs := (upsearchtext=faqcookie);

  safereset(inf,filename);
  if fileresult=0 then
    begin
      inheaders := true;
      toofar := false;

      while not eof(inf) and not result and not toofar do
        begin
          if crlf then
            readln(inf,s)
          else
            begin
              s := '';
              lineread := false;

              while not lineread do
                begin
                  read(inf,c);
                  if c=lf then
                    lineread := true
                  else if c<>cr then
                    begin
                      s := s+c;
                      lineread := (length(s)>=255);
                    end;
                end;
            end;

          if s='' then
            inheaders := false;
          s := upper(s);

          toofar := not inheaders and headersearch;

          if faqs then
            begin
              result := (pos('NEWS.ANSWERS',s)<>0) or
                (pos('FAQ',s)<>0) or (pos('FREQUENTLY ASKED Q',s)<>0);
            end
          else if inheaders then
            begin
              if headersearch then
                result := textintext(upsearchtext,s);
            end
          else
            begin
              if not headersearch then
                result := textintext(upsearchtext,s);
            end;
        end;

      close(inf);
    end;

  searchart := result;
end;

function searchnov;

var
  result: boolean;

begin
  result := true;
  searchnov := result;
end;

function ismoderated;

var
  result: boolean;

begin
  result := false;

  if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
    result := groupbattr(group,'/mod')
  else if xiface=ifaceuupc then
    result := {}{}{} false {need to handle this}
  else
    result := false;

  ismoderated := result;
end;

function isheaderinlist;

var
  result: boolean;

begin
  result := right(header,1)=':';
  if result then
    result := textintext(':'+upper(header),uheaderlist);

  isheaderinlist := result;
end;

function getaddressfromline(s: string): string;

var
  result: string;

begin
  result := wordwith('@',s);

  if result='' then
    result := wordwith('!',s);

  if (copy(result,1,1)='(') and (copy(result,length(result),1)=')') then
    result := copy(result,2,length(result)-2);

  if (copy(result,1,1)='<') and (copy(result,length(result),1)='>') then
    result := copy(result,2,length(result)-2);

  if copy(result,length(result),1)='.' then
    result := copy(result,1,length(result)-1);

  if copy(result,length(result),1)=',' then
    result := copy(result,1,length(result)-1);

  getaddressfromline := result;
end;

function isreasonableaddress(addr: string): boolean;

var
  result: boolean;

begin
  result := true;

  if (pos('!',addr)=0) and (pos('@',addr)=0) then
    result := false;

  if pos('@',addr)<>0 then
    if pos('.',addr)=0 then
      result := false;

  if pos('@.',addr)<>0 then
    result := false;

  isreasonableaddress := result;
end;

function nthlayout;

var
  result: layoutt;
  tempi: integer;

begin
  result := succ(layoutfirst);

{start at 2, since we already went 1 past the first}
  for tempi := 2 to whichlayout do
    begin
      if succ(result)<>layoutlast then
        result := succ(result);
    end;

  nthlayout := result;
end;

function isabreakline;

{either an empty line or all dashes}

var
  result: boolean;
  trimmeds: string;
  tempint: integer;

begin
  result := false;
  trimmeds := trim(ltrim(s));

{I realize the first is a special case of the second, but probably faster}

  if trimmeds='' then
    result := true
  else
    begin
      result := true;
      for tempint := 1 to length(trimmeds) do
        if trimmeds[tempint]<>'-' then
          result := false;
    end;

  isabreakline := result;
end;

function findproblemwithmessage;

var
  result: string;
  messagef: text;
  done: boolean;
  messageline: string;
  lineon: integer;

begin
  result := '';

  safereset(messagef,messagefn);
  if fileresult<>0 then
    result := 'could not open file!'
  else
    begin
      done := false;
      lineon := 0;

      while (result='') and not done do
        begin

{ran out of headers to check}
          if eof(messagef) then
            result := 'no body found (no empty line)'
          else
            begin
              readln(messagef,messageline);
              inc(lineon);

{once we hit the empty line, we know there's something past the headers}
              if messageline='' then
                begin
                  done := true;

{make sure there's something IN the body!}
                  if eof(messagef) then
                    result := 'no body found (after empty line)'
                  else
                    begin
                      readln(messagef,messageline);
                      if messageline='-- ' then
                        result := 'no body found (just signature)';
                    end;
                end

{all-blank lines are technically legal, but very dangerous to put in}
              else if trim(messageline)='' then
                result := 'all-blank line needs to be empty instead'

{special-case for mail}
              else if (lineon=1) and (copy(messageline,1,5)='From ') then
                result := ''

{check only non-continuation lines}
              else if messageline=ltrim(messageline) then
                begin
                  if pos(':',messageline)=0 then
                    result :=
                     'invalid header line (no colon)  '+messageline

                  else if pos(' ',messageline)=0 then
                    result :=
                     'invalid header line (no space)  '+messageline

                  else if pos(' ',messageline)<pos(':',messageline) then
                    result :=
                     'invalid header line (space before colon)  '+messageline;
                end;
            end;
        end;

      close(messagef);
    end;

  findproblemwithmessage := result;
end;

function toomuchquoting;

var
  result: boolean;
  totallines: longint;
  quotedlines: longint;

  messagef: text;
  messageline: string;

  attributionline: boolean;
  seenemptyline: boolean;
  seensigline: boolean;

begin
  result := false;

  attributionline := false;

  safereset(messagef,messagefn);
  if fileresult<>0 then
    result := true  {could not open file}
  else
    begin
      totallines := 0;
      quotedlines := 0;

      seenemptyline := false;
      seensigline := false;

      while not eof(messagef) do
        begin
          readln(messagef,messageline);
          if messageline='' then
            seenemptyline := true
          else if messageline='-- ' then
            seensigline := true;

          if seenemptyline and not seensigline then
            if messageline<>'' then
              begin
                inc(totallines);
                if copy(messageline,1,1)='>' then
                  inc(quotedlines);
                if (totallines=1) and (quotedlines=0) then
                  attributionline := true;
              end;
        end;

      close(messagef);

      if (quotedlines>0) then
        begin

{ones with just quoted text}
          if totallines=quotedlines then
            result := true;

{ones with just the attribution line}
          if attributionline and (totallines=quotedlines+1) then
            result := true;
        end;

      if totallines>20 then  {don't check tiny messages}
        if quotedlines>2*totallines then
          result := true;
    end;

  toomuchquoting := result;
end;

function toolongline;

var
  result: boolean;

  messagef: text;
  messageline: string;

  seenblank: boolean;

  longlinechecknumber: integer;

begin
  result := false;

  safereset(messagef,messagefn);

  seenblank := false;

  for longlinechecknumber := 1 to 40 do
    if not result then
      if not eof(messagef) then
        begin
          read(messagef,messageline);
          if messageline='' then
            seenblank := true;

          if not eoln(messagef) then
            result := true;

{headers>80 chars are ok}
          if length(messageline)>maxlen then
            if seenblank then
              result := true;

          if not eof(messagef) then {a bit overcautious I think}
            readln(messagef);
        end;

  close(messagef);

  toolongline := result;
end;

function showdebug;

begin
  showdebug := isinlist('all',debuglist,':') or isinlist(s,debuglist,':');
end;

function unreadarticlesin;

var
  result: articlefilenametype;
  hasoverview: boolean;
  adir: string;
  morearticles: boolean;
  fileinfo: searchrec;
  anartnum: articlefilenametype;
  lastread: articlefilenametype;

begin
  result := 0;

  lastread := highestreadin(asource,sourcekind);

  hasoverview := false;

{note -- for mail groups, ignore the overview file}

  if sourcekind=sourcegroup then
    adir := getgroupdir(asource)
  else if sourcekind=sourcedir then
    adir := asource
  else if sourcekind=sourcefolder then
    adir := '\\\\invalid\\directory.specified\\\\';

  if not ismailgroup(asource) then
    begin
      overviewreset(adir);
      if fileresult=0 then
        hasoverview := true;
    end;

{}{}{}{} {the only thing that calls this can handle extra output here}
{}if hasoverview then xwritess('o',^H);

  if hasoverview then
    begin
      morearticles := not eofoverview;
    end
  else
    begin
      findfirst(withbackslash(adir)+articlefilenamepattern,archive,fileinfo);
      morearticles := (doserror=0);
    end;

  while morearticles do
    begin
      if hasoverview then
        begin
          anartnum := readoverviewfilenum;
          morearticles := not eofoverview;
        end
      else
        begin
          anartnum := atol(fileinfo.name);
          findnext(fileinfo);
          morearticles := (doserror=0);
        end;

      if anartnum>lastread then
        inc(result);
    end;

  if hasoverview then
    closeoverview;

  unreadarticlesin := result;
end;

function highestreadin;

var
  result: articlefilenametype;
  s: string;

begin
  result := 0;

  if sourcekind<>sourcegroup then
    result := 0
  else
    begin
      reset(joinf);
      result := impossiblylargeart;
      while (result=impossiblylargeart) and not eof(joinf) do
        begin
          readln(joinf,s);
          if getfirstw(s)=asource then
            result := getalreadyread(s);
        end;
    end;

{ only needed for initial single-group stuff }
{
  if result=impossiblylargeart then
    begin
      xwritelnss('not joined to ',asource);
      shutdown(1);
    end;
}
{ end of only needed part }

  highestreadin := result;
end;

function textintext;

begin
  if useregex then
    textintext := regexintext(asubtext,awholetext)
  else
    textintext := ( pos(asubtext,awholetext)<>0 );
end;



end.