Super Net 1/SUPERNET_1.iso/PC/OTROS/EXTRAS/UUCODE/UUCP/RSNU106A.ZIP/src/rusnfunc.pas

Pascal/Delphi Source File | 1993-12-05 | 37.3 KB | 1,583 lines

unit rusnfunc;

{

rusn-fun.pas - rusnews functions

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

}

{$I rusn-def.pas}

interface

uses rusnglob,rusngenf,rusnio;

function basesitename(s: string): string;

{$ifdef oldmaildelivery}
function newseqnumber: integer;
{$endif}

function newmessageid: string;
function getalreadyread(s: string): word;
function joinedtogroup(var group: string): boolean;
function parseheadername(s: string): string;
function parseheadervalue(s: string): killstringt;
function subjkilled(subject: string): boolean;
function fromkilled(from: string): boolean;
function subjantikilled(subject: string): boolean;
function fromantikilled(from: string): boolean;
function getstaticvalue(name: string): string;
function getheaderline(infilename, fieldname: string): string;
function stringtodate(datestr: string): datet;

{var only for efficiency}
function subjseq(var s1,s2: subjstringt): boolean;
function firstsubjg(var s1,s2: subjstringt): boolean;

function firstartfirst(a,b: integer): boolean;  {assuming subjseq() is true}
function getbasedir(group: string): string;
function groupsattr(group: string; attr: string): string;
function groupbattr(group: string; attr: string): boolean;
function getnextgroup: string;
function alreadyseen(newsgroups: string): boolean;
function getpwinfo164(field: integer): string;
function getpwinfo165(field: integer): string;
function wafexpand(s: string): string;
function makesame(var s: string; prefix,shouldbe: string): boolean;
function expandmail(address: string): string;
function screenline(s: string): string;
function onekey(prompt: string; validkeys: string): char;
function ismailgroup(group: string): boolean;


implementation

function basesitename;

var
  atbang: integer;
  atpercent: integer;
  atat: integer;
  result: string;
  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;

{$ifdef oldmaildelivery}

function newseqnumber;

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

begin
  if waffleversion='1.64' then
    seqfn := waffledir+'\system\'+'seqf'
  else
    seqfn := waffledir+'\uucp\'+'sequence';
  assign(seqf,seqfn);
  reset(seqf);
  readln(seqf,newseq);
  close(seqf);
  rewrite(seqf);
  writeln(seqf,integertozstring(newseq+1,4));
  close(seqf);
  newseqnumber := newseq;
end;

{$endif}

function newmessageid;

begin
  newmessageid :=
   '<'+itoa(year mod 100)+integertozstring(month,2)+
   integertozstring(dayofmonth,2)+'.'+timedigits+'.'+
   randomdigit+randomletter+randomdigit+'.'+newsreadername+'.'+
   'w'+copy(waffleversion,1,1)+copy(waffleversion,3,2)+'w'+'@'+node+'>';
end;

function getalreadyread;

begin
  getalreadyread := atow(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
  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
  else
    result := false;
  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}

function joinedtogroup;

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

begin
  result := false;
  newname := '';
  subname := '';
  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 (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;
  joinedtogroup := 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 killmatch(killtext,headertext: string;
 caseinsensitive,substring: boolean): boolean;

{ if caseinsensitive, then headertext is already uppercased }

begin
  if caseinsensitive then
    if substring then
      killmatch := (pos(upper(killtext),headertext)<>0)
    else
      killmatch := (upper(killtext)=headertext)
  else
    if substring then
      killmatch := (pos(killtext,headertext)<>0)
    else
      killmatch := (killtext=headertext);
end;

function subjkilled;

var
  i: integer;
  result: boolean;
  noresubject: string;

begin

{ subject matching always done modulo Re: }

  result := false;
  noresubject := nore(subject);

  if caseinsensitivekill then
    noresubject := upper(noresubject);

  for i := 1 to numsubjks do
    if not result then
      result := killmatch(killsubjsp^[i],noresubject,
       caseinsensitivekill,substringsubjectkill);
  subjkilled := result;
end;

function fromkilled;

var
  i: integer;
  result: boolean;
  newfrom: string;

begin
{From: match if that address found anywhere - so that if they change their}
{posting software or whatever you'll still find it.}

  result := false;
  newfrom := from;

  if caseinsensitivekill then
    newfrom := upper(newfrom);

  for i := 1 to numfromks do
    if not result then
      result := killmatch(killfromsp^[i],newfrom,
       caseinsensitivekill,substringfromkill);

  fromkilled := result;
end;

function subjantikilled;

var
  i: integer;
  result: boolean;
  noresubject: string;

begin

{ subject matching always done modulo Re: }

  result := false;
  noresubject := nore(subject);

  if caseinsensitiveantikill then
    noresubject := upper(noresubject);

  for i := 1 to numsubjaks do
    if not result then
      result := killmatch(antikillsubjsp^[i],noresubject,
       caseinsensitiveantikill,substringsubjectantikill);

  subjantikilled := result;
end;

function fromantikilled;

var
  i: integer;
  result: boolean;
  newfrom: string;

begin

  result := false;
  newfrom := from;

  if caseinsensitiveantikill then
    newfrom := upper(newfrom);

  for i := 1 to numfromaks do
    if not result then
      result := killmatch(antikillfromsp^[i],newfrom,
       caseinsensitiveantikill,substringfromantikill);

  fromantikilled := result;
end;

function getstaticvalue;

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

begin
  result := '';

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

  if customstatic<>'' then
    begin
      assign(infile,customstatic);
      {$I-}
      reset(infile);
      {$I+}
      if ioresult=0 then
        begin
          while (result='') and not eof(infile) do
            begin
              readln(infile,s);
              if s<>'' then
                if copy(s,1,1)<>'#' then
                  begin
                    foundname := trim(ltrim(copy(s,1,pos(':',s)-1)));
                    if foundname=name then
                      begin
                        result := trim(ltrim(copy(s,pos(':',s)+1,255)));
                      end;
                  end;
            end;
          close(infile);
        end;
    end;

  if result='' then
    begin

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

      if ioresult=0 then
        begin
          while (result='') and not eof(infile) do
            begin
              readln(infile,s);
              if s<>'' then
                if copy(s,1,1)<>'#' then
                  begin
                    foundname := trim(ltrim(copy(s,1,pos(':',s)-1)));
                    if foundname=name then
                      begin
                        result := trim(ltrim(copy(s,pos(':',s)+1,255)));
                      end;
                  end;
            end;
          close(infile);
        end;
    end;

  filemode := oldfilemode;

  getstaticvalue := result;
end;

function getheaderline;

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

function nextlinefrombuf: string;

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

begin
  result := '';
  gotcrlf := false;
  while (headerbytesseen<headerbytesinmem) and not gotcrlf do
    begin
      inc(headerbytesseen);
      c := headerbuf[headerbytesseen];
      if (c=#13) then
        gotcrlf := true
      else if c<>#10 then
        result := result+c;
    end;
  nextlinefrombuf := result;
end;

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 := '(could not read file)';
          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]=#10 then
            if headerbuf[i+2]=#10 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 length(trim(s))=0 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)=^I) 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 length(trim(s))=0 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)=^I) 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}

function stringtodate;

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

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

{var only for efficiency}

function canonicalsubj(var subject: subjstringt): string;

var
  result: string;

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

  if subjectscaseinsensitive then
    result := upper(result);

  canonicalsubj := result;
end;

{var only for efficiency}

function canonfschar(var subject: subjstringt): char;

var
  result: char;

begin
  if subject='' then
    result := ' '
  else
    begin
      if subjectscaseinsensitive then
        result := upcase(subject[1])
      else
        result := subject[1];
    end;

  canonfschar := result;
end;

function subjseq;

var
  result: boolean;

begin
  if (s1='') or (s2='') then
    result := (canonicalsubj(s1)=canonicalsubj(s2))
  else if canonfschar(s1)=canonfschar(s2) then
    result := (canonicalsubj(s1)=canonicalsubj(s2))
  else
    result := false;

  subjseq := result;
end;

function firstsubjg;

var
  result: boolean;

begin
  if (s1='') or (s2='') then
    result := (canonicalsubj(s1)>canonicalsubj(s2))
  else if canonfschar(s1)<canonfschar(s2) then
    result := false
  else
    result := (canonicalsubj(s1)>canonicalsubj(s2));

  firstsubjg := result;
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(hmessageidsp^[b],hreferencesp[1]^[a]) then
    result := false
  else if hasheq(hmessageidsp^[b],hreferencesp[2]^[a]) then
    result := false
  else if hasheq(hmessageidsp^[b],hreferencesp[3]^[a]) then
    result := false
  else if hasheq(hmessageidsp^[b],hreferencesp[4]^[a]) then
    result := false
  else
    if not hasheq(hmessageidsp^[a],hreferencesp[1]^[b]) then
      if not hasheq(hmessageidsp^[a],hreferencesp[2]^[b]) then
        if not hasheq(hmessageidsp^[a],hreferencesp[3]^[b]) then
          if not hasheq(hmessageidsp^[a],hreferencesp[4]^[b]) then
            begin

{no conclusive proof - just guess}

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

{$ifdef testsort}
  write('firstartfirst(',a,',',b,')=');
  if result then writeln('true') else writeln('false');
                xwrites('pausing...');
                xwritelns(xreadkey);

{$endif}

  firstartfirst := result;
end;

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

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

begin
  foundgroup := false;
  result := '';
  default := '';

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

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

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

  if ioresult=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}

      if defaultdir[length(defaultdir)]<>'\' then
        defaultdir := defaultdir+'\';
      mangledgroup := group;
      while pos('.',mangledgroup)>0 do
        begin
          result := result+
           copy(mangledgroup,1,min(8,pos('.',mangledgroup)-1))+'\';
          mangledgroup := copy(mangledgroup,pos('.',mangledgroup)+1,255);
        end;
      result := defaultdir+result+
       copy(mangledgroup,1,min(8,length(mangledgroup)))+'\';
    end;

  if result<>'' then
    if result[length(result)]<>'\' then
      result := result+'\';

  fogetbasedir := result;
end;

function secondarygetbasedir(group: string): string;

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

begin
  result := '';
  mungedl := forumsetl;
  while (result='') and (mungedl<>'') do
    begin
      forumset := chopfirstw(mungedl);
      result := fogetbasedir(group,forumset);
    end;
  secondarygetbasedir := result;
end;

function getbasedir;

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 := secondarygetbasedir(partialprefix);
          if result<>'' then
            result := 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 . }

          for i := 1 to length(nonprefix) do
            if nonprefix[i]='.' then
              nonprefix[i] := '\';
          result := getbasedir(partialprefix);
          if result<>'' then
            result := result+nonprefix+'\';
        end;

    end;

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

  getbasedir := 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
  foundgroup := false;
  result := '';
  default := '';

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

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

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

  if ioresult=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
  forumset: string;
  mungedl: string;
  result: string;

begin
  result := '';
  mungedl := forumsetl;
  while (result='') and (mungedl<>'') do
    begin
      forumset := chopfirstw(mungedl);
      result := fogroupsattr(group,attr,forumset);
    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;
  mangledgroup: string;
  default: string;

begin
  foundgroup := false;
  result := false;
  default := '';

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

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

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

  if ioresult=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
  forumset: string;
  mungedl: string;
  result: boolean;

begin
  result := false;
  mungedl := forumsetl;
  while not result and (mungedl<>'') do
    begin
      forumset := chopfirstw(mungedl);
      result := fogroupbattr(group,attr,forumset);
    end;
  groupbattr := result;
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 currgroup='' then
        begin
          readln(joinf,foundgroup);
          result := getfirstw(foundgroup);
        end
      else
        begin
          while not eof(joinf) and (foundgroup<>currgroup) do
            begin
              readln(joinf,foundgroup);
              foundgroup := getfirstw(foundgroup);
            end;
          if not eof(joinf) then
            begin
              readln(joinf,foundgroup);
              result := getfirstw(foundgroup);
            end;
        end;
    end;
  getnextgroup := result;
end;

function alreadyseen;

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

begin
  result := false;
  if (currgroup<>'control') and (currgroup<>'monitor') and
   (copy(currgroup,1,14)<>'news.announce.') and
   ((numoccur('.',currgroup)<>1) or (right(currgroup,8)<>'.answers')) then
    begin
      found := false;
      newsglist := ','+newsgroups+',';
      i := 1;
      while (i<numjoined) and not found do
        begin
          if (copy(joinedgroups[i],1,14)<>'news.announce.') and
           (pos(','+joinedgroups[i]+',',newsglist)<>0) and
             ((numoccur('.',joinedgroups[i])<>1) or
             (right(joinedgroups[i],8)<>'.answers')) then
            begin
              found := true;
              result := (joinedgroups[i]<>currgroup);
            end;
          inc(i);
        end;
    end;
  alreadyseen := result;
end;

function getpwinfo164;

const
  passwordblocksize=256;

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

var
  passwordbuf: passwordbuft;
  passwordf: file;
  result: string;
  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]=#10 then
        inc(lfs);
      if (lfs=fieldnum) and (passwordbuf[i]<>#10) 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,waffledir+'\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)=userid then
            begin
              result := passwordentry164(field);
              found := true;
            end;
        end;
      close(passwordf);
    end;

  filemode := oldfilemode;

  getpwinfo164 := result;
end;

function getpwinfo165;

const
  passwordblocksize=1024;

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

var
  passwordbuf: passwordbuft;
  passwordf: file;
  result: string;
  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
  i: integer;
  start: integer;
  size: integer;
  result: string;
  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,waffledir+'\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)=userid then
            begin
              result := passwordentry165(field);
              found := true;
            end;
        end;
      close(passwordf);
    end;

  filemode := oldfilemode;

  getpwinfo165 := result;
end;

function wafexpand;

var
  result: string;
  i: integer;
  c: char;

begin
  if pos('%',s)=0 then
    result := s
  else
    begin
      result := '';
      i := 1;
      while i<=length(s) do
        begin
          if s[i]='%' then
            begin
              inc(i);
              if i<=length(s) then
                begin
                  c := s[i];
                  case c of
                    '%': result := result+'%';
                    'A': result := result+userid;
                    'W': result := result+fullname;
                    'n': result := result+node;
                    'u': result := result+uucpname;
                    else result := result+'(unknown flag %'+c+')';
                  end;
                end;
            end
          else
            result := result+s[i];
          inc(i);
        end;
    end;
  wafexpand := result;
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 expandmail;

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

begin
  result := address;
  changed := false;
  if (pos('@',address)=0) and (pos('!',address)=0) then
    begin
      newaddressfn := waffledir+'\system\'+'aliases';

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

      assign(newaddressf,newaddressfn);
      {$I-}
      reset(newaddressf);
      {$I+}

      if ioresult=0 then
        begin
          while not changed and not eof(newaddressf) do
            begin
              readln(newaddressf,s);
              if chopfirstw(s)=address then
                begin
                  changed := true;
                  result := s;
                end;
            end;
          close(newaddressf);
        end;
      if not changed then
        begin
          newaddressfn := home+'\aliases';

          assign(newaddressf,newaddressfn);
          {$I-}
          reset(newaddressf);
          {$I+}

          if ioresult=0 then
            begin
              while not changed and not eof(newaddressf) do
                begin
                  readln(newaddressf,s);
                  if chopfirstw(s)=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 := userdir+'\'+address+'\forward';

             assign(newaddressf,newaddressfn);
             {$I-}
             reset(newaddressf);
             {$I+}

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

function screenline;

var
  expandeds: string;

begin
  expandeds := trim(expand(s));
  if length(expandeds)<cols then
    screenline := expandeds
  else
    screenline := copy(expandeds,1,cols-2)+'<';
end;

function onekey;

var
  result: char;

begin
  xclreolxy(1,lpp);
  xwritess(prompt,' ');
  repeat
    result := xreadkey;
  until pos(result,validkeys)<>0;
{caller has to clear line after - might not want to right away}
  onekey := result;
end;

function ismailgroup;

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

end.