home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 31
/
CDASC_31_1996_juillet_aout.iso
/
internet
/
rnr214.zip
/
RNRINIT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-03
|
65KB
|
2,431 lines
unit rnrinit;
{
rnrinit.pas - rnr initialization
}
{$I rnr-def.pas}
interface
uses dos,crt,genericf,colornms,nwid,rnrglob,rnrconf,rnrio,rnrfile,
rnrfunc,rnrproc,rnrkill,rnrmous
{$ifdef timeout}
,rnrtime
{$endif}
{$ifdef charset}
,rnrchar
{$endif}
;
const
issuspicious=true;
notsuspicious=false;
procedure initialize;
procedure justhandleset(setline: string; suspicious: boolean);
procedure justhandleunset(setline: string; suspicious: boolean);
implementation
var
foundtrusted: boolean;
defaultfromwidth: integer;
defaultsizewidth: integer;
procedure usage;
begin
xwritelnsss('usage: ',newsreadername,' [options]');
xwritelns(' -u --user %A');
xwritelns(' -n --newsgroup c.b.w (jumps directly to that newsgroup)');
xwritelns(' -p --port 1 (uses that fossil port - 1=COM1, 2=COM2)');
xwritelns(' -f --fullname Full_Name (underscores will become spaces)');
xwritelns(' -e --editor d:/path/editor[.exe] (uses this editor)');
xwritelns(' -o --editor-options !_w:\user\%A (editor non-filename options)');
xwritelns(' -s --forum-set-list local_usenet (uses these forum sets only)');
xwritelns(' -t --trusted (allows dialin users to edit articles)');
xwritelns(' -i --interface (specify waffle or uupc file layout)');
xwritelns(' -v --interface-version %V (specifies interface version)');
xwritelns(' -m --minutes %O (specifies minutes online time, or -1)');
xwritelns(' -d --shadow 1 (shadows all COMx output to console)');
xwritelns(' -r --rcfile w:/waffle/lib/rnr.opt (reads in options)');
xwriteln;
xwritelns('see documentation for other configuration options');
xwriteln;
xwritelns('Russell_Schulz@locutus.ofB.ORG ('+releasedate+')');
xwritelns('Adapted for UUPC by storner@osiris.ping.dk (941204)');
shutdown(1);
end;
procedure defaultlppcols;
begin
if console then
begin
if detectvideo then
begin
lpp := mem[$40:$84]+1;
cols := mem[$40:$4a];
end
else
begin
lpp := 25;
cols := 80
end;
end
else
begin
lpp := 24;
cols := 80;
end;
end;
procedure fixuplppcols;
begin
lpp := max(minlpp,min(lpp,maxlpp));
cols := max(mincols,min(cols,maxcols));
{26 letters+10 digits for toggles}
sellpp := min(lpp-selheaderlines-4,36);
end;
procedure backupjoin;
var
groupline: string;
tempf: text;
createjoined: boolean;
begin
xwritelns('Backing up join file...');
createjoined := (numjoined=0);
assign(tempf,home+'\join.bak');
rewrite(tempf);
reset(joinf);
while not eof(joinf) do
begin
readln(joinf,groupline);
writeln(tempf,groupline);
if createjoined and (numjoined<maxjoined) then
begin
inc(numjoined);
joinedgroups[numjoined] := getfirstw(groupline);
end;
end;
close(tempf);
reset(joinf);
end;
procedure fixpathuserid;
begin
{ only do this if we've been able to run translateuserid -- so this }
{ means that this routine _must_ be called after translateuserid too }
if configdir<>'' then
begin
if pathuserid='' then
pathuserid := userid;
pathuserid := wafexpand(pathuserid);
end;
end;
procedure fixfromuserid;
begin
{ only do this if we've been able to run translateuserid -- so this }
{ means that this routine _must_ be called after translateuserid too }
if configdir<>'' then
begin
if fromuserid='' then
fromuserid := userid;
fromuserid := wafexpand(fromuserid);
end;
end;
procedure fixcustomstatic;
begin
{ only do this if we've been able to run translateuserid -- so this }
{ means that this routine _must_ be called after translateuserid too }
if configdir<>'' then
customstatic := wafexpand(customstatic);
end;
procedure fixnewscmdline;
begin
if newscmdline='(standard)' then
newscmdline := getsyscmd('news');
if newscmdline='' then
newscmdline := 'rnews';
newscmdline := unslash(newscmdline);
if newscmdline=builtincookie then
begin
xwritelns('error: there is no builtin newscmdline');
shutdown(1);
end;
end;
procedure fixmailcmdline;
begin
if mailcmdline='(standard)' then
mailcmdline := getsyscmd('mail');
if mailcmdline='' then
mailcmdline := builtincookie;
mailcmdline := unslash(mailcmdline);
end;
procedure fixcolors;
var
mangledcolors: string;
begin
lowcolor := 7;
highcolor := 15;
if colors='' then
colors := getconfig('colors');
if colors='' then
colors := getconfig('colours');
if colors<>'' then
begin
mangledcolors := colors;
lowcolor := colortoi(chopfirstw(mangledcolors));
highcolor := colortoi(getfirstw(mangledcolors));
end;
if (lowcolor mod 16)=(highcolor mod 16) then
if (lowcolor mod 16)=7 then
highcolor := 15
else
lowcolor := 7;
if quotecolor=255 then
quotecolor := lowcolor;
if alternatecolor=255 then
alternatecolor := lowcolor;
end;
procedure handlemap(cmdline: string);
var
where: string;
oldkey,newkey: char;
newcmdline: string;
function whatch: char;
var
result: char;
donescan: boolean;
begin
result := chr(0);
if newcmdline<>'' then
begin
if (newcmdline[1]='\') and (length(newcmdline)>1) then
begin
result := newcmdline[2];
newcmdline := lchop(newcmdline,2); {get rid of it and the backslash}
end
else if (newcmdline[1]='=') and (length(newcmdline)>1) then
begin
newcmdline := lchop(newcmdline,1); {get rid of the equals}
donescan := false;
while not donescan do
begin
if length(newcmdline)=0 then
donescan := true {no more to see}
else if (newcmdline[1]<'0') or (newcmdline[1]>'9') then
donescan := true {no more digits, anyway}
else
begin
result := chr(10*ord(result)+ord(newcmdline[1])-ord('0'));
newcmdline := lchop(newcmdline,1); {get rid of digit}
end;
end;
end
else
begin
result := newcmdline[1];
newcmdline := lchop(newcmdline,1);
end;
end;
whatch := result;
end;
begin {handlemap}
newcmdline := cmdline;
newkey := chr(0);
oldkey := chr(0);
where := chopfirstw(newcmdline);
newcmdline := ltrim(newcmdline);
oldkey := whatch;
newcmdline := ltrim(newcmdline);
newkey := whatch;
if (oldkey<>chr(0)) and (newkey<>chr(0)) then
begin
if where='browse' then
begin
browsemap[oldkey] := newkey;
end
else if where='select' then
begin
selmap[oldkey] := newkey;
end
else if where='both' then
begin
browsemap[oldkey] := newkey;
selmap[oldkey] := newkey;
end
else if where='main' then
begin
mainmap[oldkey] := newkey;
end
else
begin
warn('weird use of map - ignored '+cmdline);
end;
end
else
begin
warn('weird use of map - ignored '+cmdline);
end;
end; {handlemap}
procedure maybesetopts(tag: string; var result: string;
newval: string; mayuserestrictedopts: boolean);
begin
if mayuserestrictedopts then
result := newval
else
warn('without -t, cannot use '+tag+' here');
end;
procedure maybesetoptp(tag: string; var result: pathstring;
newval: string; mayuserestrictedopts: boolean);
begin
if mayuserestrictedopts then
result := newval
else
warn('without -t, cannot use '+tag+' here');
end;
procedure maybesetoptsh(tag: string; var result: shortstring;
newval: string; mayuserestrictedopts: boolean);
begin
if mayuserestrictedopts then
result := newval
else
warn('without -t, cannot use '+tag+' here');
end;
procedure maybesetopti(tag: string; var result: integer;
newval: integer; mayuserestrictedopts: boolean);
begin
if mayuserestrictedopts then
result := newval
else
warn('without -t, cannot use '+tag+' here');
end;
procedure maybesetoptb(tag: string; var result: boolean;
newval: boolean; mayuserestrictedopts: boolean);
begin
if mayuserestrictedopts then
result := newval
else
warn('without -t, cannot use '+tag+' here');
end;
function handleset(setline: string; suspicious: boolean): boolean;
var
usedarg: boolean;
mayuserestrictedopts: boolean;
tag: string;
avalue: string;
lavalue: string;
bvalue: boolean;
equalpos: integer;
begin
usedarg := false;
{$ifdef trustedusersmayputrestrictedoptsinuserrcfile}
mayuserestrictedopts := trusted or (not suspicious);
{$else}
mayuserestrictedopts := not suspicious;
{$endif}
{handle "set foo", "set --foo", "set foo 3", and "set foo=3"}
avalue := trim(ltrim(setline));
equalpos := pos('=',avalue);
if equalpos=0 then
tag := chopfirstw(avalue)
else
begin
tag := copy(avalue,1,equalpos-1);
avalue := copy(avalue,equalpos+1,255);
end;
tag := lower(tag);
bvalue := true;
lavalue := lower(avalue);
if (lavalue='false') or
(lavalue='f') or
(lavalue='off') or
(lavalue='0') or
(lavalue='no') then
bvalue := false;
if copy(tag,1,2)='--' then
tag := lchop(tag,2);
if (tag='-e') or (tag='editor') then
begin
maybesetoptp(tag,editor,avalue,mayuserestrictedopts);
usedarg := true;
end
else if (tag='-o') or (tag='editor-options') then
begin
maybesetoptp(tag,editoroptions,
ununderscore(avalue),mayuserestrictedopts);
usedarg := true;
end
else if (tag='-d') or (tag='shadow') then
begin
maybesetopti(tag,shadow,atoi(avalue),mayuserestrictedopts);
usedarg := true;
end
else if tag='vspeller' then
begin
maybesetoptp(tag,vspeller,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='vspeller-options' then
begin
maybesetoptp(tag,vspelleroptions,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='subjects-case-insensitive' then
subjectscaseinsensitive := bvalue
else if tag='subject-length' then
begin
subjectlength := atoi(avalue);
if subjectlength<5 then
begin
subjectlength := 5;
xwrites('using subject-length of ');
xwritei(subjectlength);
xwriteln;
end;
if subjectlength>maxsubjectlen then
begin
subjectlength := maxsubjectlen;
xwrites('using subject-length of ');
xwritei(subjectlength);
xwriteln;
end;
usedarg := true;
end
else if tag='squash-spaces' then
squashspaces := bvalue
else if tag='equate-truncated' then
begin
equatetruncated := atoi(avalue);
if equatetruncated<5 then
begin
xwritelns('using equate-truncated of 5');
equatetruncated := 5;
end;
usedarg := true;
end
else if tag='make-space-like-x' then
makespacelikex := bvalue
else if tag='make-return-like-asterisk' then
begin
xwritelns('warning: obsolete option --make-return-like-asterisk');
xwritelns('warning: use --map select =13 * instead');
handlemap('select =13 *');
end
else if tag='hide-these-headers' then
begin
hideheaders := upper(avalue);
usedarg := true;
end
else if tag='show-only-these-headers' then
begin
showheaders := upper(avalue);
usedarg := true;
end
else if tag='highlight-these-headers' then
begin
highlightheaders := upper(avalue);
usedarg := true;
end
else if tag='no-mail-from' then
maybesetoptb(tag,nomailfrom,bvalue,mayuserestrictedopts)
else if tag='no-mail-headers' then
begin
maybesetopts(tag,nomailheaders,upper(avalue),mayuserestrictedopts);
usedarg := true;
end
else if tag='no-news-headers' then
begin
maybesetopts(tag,nonewsheaders,upper(avalue),mayuserestrictedopts);
usedarg := true;
end
else if tag='wandering-numbers' then
wanderingnumbers := bvalue
else if tag='antikill-references' then
antikillreferences := bvalue
else if tag='show-subject-kills' then
showsubjectkills := bvalue
else if tag='show-from-kills' then
showfromkills := bvalue
else if tag='show-subject-antikills' then
showsubjectantikills := bvalue
else if tag='show-from-antikills' then
showfromantikills := bvalue
else if tag='show-kills' then
showkills := bvalue
else if tag='show-antikills' then
showantikills := bvalue
else if tag='auto-antikill' then
autoantikill := bvalue
else if tag='warn-auto-antikill' then
warnautoantikill := bvalue
else if tag='edit-after-vspell' then
editaftervspell := bvalue
else if tag='case-insensitive-kill' then
caseinsensitivekill := bvalue
else if tag='case-insensitive-antikill' then
caseinsensitiveantikill := bvalue
else if tag='substring-subject-kill' then
substringsubjectkill := bvalue
else if tag='substring-from-kill' then
substringfromkill := bvalue
else if tag='substring-subject-antikill' then
substringsubjectantikill := bvalue
else if tag='substring-from-antikill' then
substringfromantikill := bvalue
else if tag='quiet' then
quiet := bvalue
else if tag='confirm-quit' then
confirmquit := bvalue
else if tag='confirm-next' then
begin
warn('confirm-next is now confirm-next-group');
confirmnextgroup := bvalue;
end
else if tag='confirm-next-group' then
confirmnextgroup := bvalue
else if tag='confirm-next-article' then
confirmnextarticle := bvalue
else if tag='missing-subject-is-ok' then
missingsubjectisok := bvalue
else if tag='tilde-home' then
maybesetoptb(tag,tildehome,bvalue,mayuserestrictedopts)
else if tag='antikill-this-newsreader' then
antikillthisnewsreader := bvalue
else if tag='clear-screen-between-groups' then
clearscreenbetweengroups := bvalue
else if tag='detect-video' then
begin
if mayuserestrictedopts then
begin
if console then
begin
detectvideo := bvalue;
defaultlppcols;
end;
end;
end
else if tag='antikill-even-killed' then
antikillevenkilled := bvalue
else if tag='use-bios-for-screen' then
maybesetoptb(tag,usebiosforscreen,bvalue,mayuserestrictedopts)
else if tag='hide-form-feeds' then
hideformfeeds := bvalue
else if tag='path-userid' then
begin
maybesetoptsh(tag,pathuserid,avalue,mayuserestrictedopts);
usedarg := true;
fixpathuserid;
end
else if tag='from-userid' then
begin
maybesetoptsh(tag,fromuserid,avalue,mayuserestrictedopts);
usedarg := true;
fixfromuserid;
end
else if tag='custom-static' then
begin
maybesetoptp(tag,customstatic,avalue,mayuserestrictedopts);
usedarg := true;
fixcustomstatic;
end
else if tag='halt-on-unknown-groups' then
haltonunknowngroups := bvalue
else if tag='mouse-chars-header' then
begin
mousecharsheader := avalue;
usedarg := true;
end
else if tag='just-dots' then
justdots := bvalue
else if tag='no-filemode' then
maybesetoptb(tag,nofilemode,bvalue,mayuserestrictedopts)
else if tag='quit-message' then
begin
maybesetopts(tag,quitmessage,ununderscore(avalue),mayuserestrictedopts);
usedarg := true;
end
else if tag='output-separator' then
begin
outputseparator := avalue;
usedarg := true;
end
else if tag='news-cmd-line' then
begin
maybesetoptp(tag,newscmdline,avalue,mayuserestrictedopts);
usedarg := true;
fixnewscmdline;
end
else if tag='mail-cmd-line' then
begin
maybesetoptp(tag,mailcmdline,avalue,mayuserestrictedopts);
usedarg := true;
fixmailcmdline;
end
else if tag='mail-agent' then
mailagent := bvalue
else if tag='outgoing-mail' then
begin
maybesetopts(tag,outgoingmail,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='outgoing-news' then
begin
maybesetopts(tag,outgoingnews,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='highlight-search-hits' then
highlightsearchhits := bvalue
else if (tag='colors') or (tag='colours') then
begin
colors := uncomma(ununderscore(avalue));
usedarg := true;
fixcolors;
end
else if (tag='quote-color') or (tag='quote-colour') then
begin
quotecolor := colortoi(avalue);
usedarg := true;
end
{$ifdef charset}
else if tag='local-charset' then
begin
if mayuserestrictedopts then
begin
uselocalcharset := true;
localcharsetfn := wafexpand(avalue);
end;
usedarg := true;
end
{$endif}
else if tag='rmail-single' then
maybesetoptb(tag,rmailsingle,bvalue,mayuserestrictedopts)
else if tag='idle' then
begin
maybesetopti(tag,idleminutes,atoi(avalue),mayuserestrictedopts);
usedarg := true;
end
else if tag='swap' then
begin
if mayuserestrictedopts then
swap := avalue;
usedarg := true;
if (swap<>'') and (swap<>'no') and (swap<>'disk') and (swap<>'ems') then
begin
xwritelns('unknown --swap parameter');
xwritelns(' --swap no => no swapping');
xwritelns(' --swap disk => swap to disk');
xwritelns(' --swap ems => swap to EMS or disk');
shutdown(1);
end;
end
else if tag='article-filename-pattern' then
begin
maybesetoptp(tag,articlefilenamepattern,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='overview-base-name' then
begin
maybesetoptp(tag,overviewbasename,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='from-width' then
begin
fromwidth := atoi(avalue);
usedarg := true;
{}{ default value should depend on cols }
if (fromwidth<5) or (fromwidth>80) then
fromwidth := defaultfromwidth;
end
else if tag='size-width' then
begin
sizewidth := atoi(avalue);
usedarg := true;
if (sizewidth<1) or (sizewidth>4) then
sizewidth := defaultsizewidth;
end
else if tag='enter-group-command' then
begin
maybesetoptp(tag,entergroupcommand,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='dots-on-reset' then
dotsonreset := bvalue
else if tag='view-command' then
begin
maybesetoptp(tag,viewcommand,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='extract-command' then
begin
maybesetoptp(tag,extractcommand,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='encode-command' then
begin
maybesetoptp(tag,encodecommand,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='crlf' then
crlf := bvalue
else if tag='find-quote-char' then
findquotechar := bvalue
else if tag='quote-char' then
begin
if length(avalue)>0 then
quotechar := avalue[1]
else
quotechar := '>';
usedarg := (length(avalue)>0);
end
else if tag='print-command' then {ugh}
begin
maybesetoptp(tag,printcommand,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='layout' then
begin
if avalue='normal' then
layout := layoutnormal
else if avalue='squashed' then
layout := layoutsquashed
else
layout := nthlayout(atoi(avalue));
usedarg := true;
end
else if (tag='alternate-color') or (tag='alternate-colour') then
begin
alternatecolor := colortoi(avalue);
usedarg := true;
end
else if (tag='date-color') or (tag='date-colour') then
begin
datecolor := colortoi(avalue);
usedarg := true;
end
else if tag='mail-marker-line' then
begin
mailmarkerline := avalue;
usedarg := (length(avalue)>0);
if trim(mailmarkerline)='' then
mailmarkerline := defaultmailmarkerline;
end
else if tag='news-marker-line' then
begin
newsmarkerline := avalue;
usedarg := (length(avalue)>0);
if trim(newsmarkerline)='' then
newsmarkerline := defaultnewsmarkerline;
end
else if tag='truncate-id-length' then
begin
maybesetopti(tag,truncateidlength,atoi(avalue),mayuserestrictedopts);
usedarg := true;
if truncateidlength<1 then
truncateidlength := 1;
end
else if tag='debug' then
begin
debuglist := avalue;
usedarg := true;
if copy(debuglist,1,1)<>':' then
debuglist := ':'+debuglist;
if copy(debuglist,length(debuglist),1)<>':' then
debuglist := debuglist+':';
end
else if tag='date-format' then
begin
dateformat := avalue;
usedarg := true;
end
else if tag='mail-date-format' then
begin
maildateformat := avalue;
usedarg := true;
end
else if tag='news-date-format' then
begin
newsdateformat := avalue;
usedarg := true;
end
else if tag='regex' then
useregex := bvalue
else if tag='quote-with-space' then
quotewithspace := bvalue
else if tag='find-existing-file-command' then
begin
maybesetoptp(tag,findexistingfilecommand,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='find-file-command' then
begin
maybesetoptp(tag,findfilecommand,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='helpful' then
begin
helpful := bvalue;
end
else if tag='indicate-posted-mail-in-body' then
begin
indicatepostedmailinbody := bvalue;
end
else if tag='' then
begin
warn('set: no arguments found');
end
else
begin
warn('unknown set option: '+tag);
end;
handleset := usedarg;
end;
procedure justhandleset;
var
wasteboolean: boolean;
begin
wasteboolean := handleset(setline,suspicious);
end;
procedure justhandleunset;
var
newsetline: string;
wasteboolean: boolean;
begin
newsetline := trim(ltrim(setline));
if pos('=',newsetline)=0 then
if pos(' ',newsetline)=0 then
newsetline := newsetline+'=false';
wasteboolean := handleset(newsetline,suspicious);
end;
procedure translateuserid;
var
translatefn: string;
translatef: text;
translateline: string;
done: boolean;
begin
{waste of time - tpascal doesn't use filemode on text files!}
oldfilemode := filemode;
if not nofilemode then
filemode := $40; {read only, deny none}
translatefn := configdir+'\etc\'+'idtrans';
safereset(translatef,translatefn);
if showdebug('userid') then
if fileresult=0 then
xwritelnss(translatefn,' exists')
else
xwritelnss(translatefn,' does not exist');
if fileresult=0 then
begin
done := false;
while not done and not eof(translatef) do
begin
readln(translatef,translateline);
if showdebug('userid') then
xwritelnss('translation line: ',translateline);
if chopfirstw(translateline)=userid then
begin
userid := trim(translateline);
xwritelnssss('using id ',userid,
', as per translation file ',translatefn);
done := true;
end;
end;
close(translatef);
end;
filemode := oldfilemode;
end;
procedure createconfigpathstring(name: configelementname; value: pathstring);
var
aconfigelementptrpathstring: configelementptrpathstring;
begin
if memavail<configmemoryreserved+sizeof(configelementpathstring) then
msgshutdown('insufficient memory (configuration)',1);
new(aconfigelementptrpathstring);
aconfigelementptrpathstring^.name := name;
aconfigelementptrpathstring^.value := value;
aconfigelementptrpathstring^.changed := false;
aconfigelementptrpathstring^.next := configheadpathstring;
configheadpathstring := aconfigelementptrpathstring;
end;
procedure createconfigshortstring(name: configelementname; value: shortstring);
var
aconfigelementptrshortstring: configelementptrshortstring;
begin
if memavail<configmemoryreserved+sizeof(configelementshortstring) then
msgshutdown('insufficient memory (configuration)',1);
new(aconfigelementptrshortstring);
aconfigelementptrshortstring^.name := name;
aconfigelementptrshortstring^.value := value;
aconfigelementptrshortstring^.changed := false;
aconfigelementptrshortstring^.next := configheadshortstring;
configheadshortstring := aconfigelementptrshortstring;
end;
procedure createconfiginteger(name: configelementname; value: integer);
var
aconfigelementptrinteger: configelementptrinteger;
begin
if memavail<configmemoryreserved+sizeof(configelementinteger) then
msgshutdown('insufficient memory (configuration)',1);
new(aconfigelementptrinteger);
aconfigelementptrinteger^.name := name;
aconfigelementptrinteger^.value := value;
aconfigelementptrinteger^.changed := false;
aconfigelementptrinteger^.next := configheadinteger;
configheadinteger := aconfigelementptrinteger;
end;
procedure createconfigboolean(name: configelementname; value: boolean);
var
aconfigelementptrboolean: configelementptrboolean;
begin
if memavail<configmemoryreserved+sizeof(configelementboolean) then
msgshutdown('insufficient memory (configuration)',1);
new(aconfigelementptrboolean);
aconfigelementptrboolean^.name := name;
aconfigelementptrboolean^.value := value;
aconfigelementptrboolean^.changed := false;
aconfigelementptrboolean^.next := configheadboolean;
configheadboolean := aconfigelementptrboolean;
end;
procedure createallconfigspathstring;
begin
configheadpathstring := nil;
savedconfigheadpathstring := nil;
createconfigpathstring('name','value');
end;
procedure createallconfigsshortstring;
begin
configheadshortstring := nil;
savedconfigheadshortstring := nil;
createconfigshortstring('name','value');
end;
procedure createallconfigsinteger;
begin
configheadinteger := nil;
savedconfigheadinteger := nil;
createconfiginteger('name',0);
end;
procedure createallconfigsboolean;
begin
configheadboolean := nil;
savedconfigheadboolean := nil;
createconfigboolean('name',false);
end;
procedure initialize;
var
currparmi: integer;
currparm: string;
nextparm: string;
rcf: text;
rctag: string;
rcval: string;
wantedtogotosource: boolean;
ch: char;
procedure initopts;
begin
foundtrusted := false;
{}{}{ should be based on cols when known }
defaultfromwidth := 20;
defaultsizewidth := 3; {max 1-byte non-negative integer is 3 digits}
userid := '';
currsource := '';
currdir := '';
currsourcekind := sourcegroup;
forumsetl := '';
iface := '';
xiface := ifaceunknown;
ifaceversion := '';
uupcusr := '';
uupcsys := '';
timezone := '';
maildateformat := 'www, mmm dd';
newsdateformat := 'mmm dd';
dateformat := '(!error)';
useregex := false;
quotewithspace := false;
findexistingfilecommand := builtincookie;
findfilecommand := builtincookie;
helpful := false;
indicatepostedmailinbody := false;
{$ifdef tiny}
console := false;
port := 0;
trusted := false;
minutestorun := 60;
{$else}
console := true;
port := -1;
trusted := true;
minutestorun := maxint;
{$endif}
fullname := '';
editor := '';
editoroptions := '';
vspeller := '';
vspelleroptions := '';
shadow := 0;
rcfilename := '';
netmail := '';
netnews := '';
replyto := '';
subjectscaseinsensitive := false;
subjectlength := 50;
squashspaces := false;
equatetruncated := 0;
makespacelikex := false;
hideheaders := '';
showheaders := '';
highlightheaders := upper(':Subject:From:Date:');
nomailfrom := false;
nomailheaders := '';
nonewsheaders := '';
wanderingnumbers := false;
antikillreferences := false;
showsubjectkills := false;
showfromkills := false;
showsubjectantikills := false;
showfromantikills := false;
showkills := false;
showantikills := false;
autoantikill := false;
warnautoantikill := false;
editaftervspell := false;
caseinsensitivekill := false;
caseinsensitiveantikill := false;
substringsubjectkill := false;
substringfromkill := false;
substringsubjectantikill := false;
substringfromantikill := false;
quiet := false;
ignoreenvironment := false;
confirmquit := false;
confirmnextgroup := false;
confirmnextarticle := false;
missingsubjectisok := false;
tildehome := true;
antikillthisnewsreader := false;
clearscreenbetweengroups := false;
detectvideo := true;
antikillevenkilled := false;
mailprefix := '';
ignoremouse := false;
usebiosforscreen := false;
hideformfeeds := false;
pathuserid := '';
fromuserid := '';
customstatic := '';
haltonunknowngroups := false;
mousecharsheader := '< > ^ $ * - + Q N @ ~ Z G ''';
justdots := false;
nofilemode := false;
quitmessage := 'Closing files...';
outputseparator := '---cut-here---';
newscmdline := '';
mailcmdline := '';
mailagent := false;
outgoingmail := '';
outgoingnews := 'monitor';
highlightsearchhits := false;
colors := '';
quotecolor := 255;
{$ifdef charset}
uselocalcharset := false;
localcharsetfn := '';
{$endif}
rmailsingle := false;
idleminutes := 0;
if (dosversion and $ff)<3 then
swap := 'disk'
else
swap := 'ems';
articlefilenamepattern := '*';
overviewbasename := 'overview';
fromwidth := defaultfromwidth;
sizewidth := defaultsizewidth;
entergroupcommand := '';
dotsonreset := false;
viewcommand := 'viewart';
extractcommand := 'munpack';
encodecommand := 'encode';
crlf := true; {used to default to false before we had unset}
findquotechar := false;
printcommand := 'paginate'; {ugh}
netware := false;
layout := layoutnormal;
alternatecolor := 255;
datecolor := 255;
mailmarkerline := defaultmailmarkerline;
newsmarkerline := defaultnewsmarkerline;
truncateidlength := 8;
debuglist := '';
if (dosversion and $ff)<3 then
nofilemode := true;
configdir := '';
browseuppersearchstring := '';
end;
function handleoption(tag, maybedash: string; suspicious: boolean): boolean;
{tag must be lower-case}
var
avalue: string;
usedarg: boolean;
mayuserestrictedopts: boolean;
handleviaset: boolean;
begin {handleoption}
handleviaset := false;
if maybedash='-' then
avalue := ''
else
avalue := maybedash;
usedarg := false;
{$ifdef trustedusersmayputrestrictedoptsinuserrcfile}
mayuserestrictedopts := trusted or (not suspicious);
{$else}
mayuserestrictedopts := not suspicious;
{$endif}
if (tag='-?') or (tag='--help') then
usage
else if tag='--map' then
begin
handlemap(avalue);
usedarg := true;
end
else if (tag='-u') or (tag='--user') then
begin
if showdebug('userid') then
xwritelnss('with -u/--user, attempting to set userid to ',avalue);
maybesetoptsh(tag,userid,avalue,mayuserestrictedopts);
usedarg := true;
end
else if (tag='-n') or (tag='--newsgroup') then
begin
currsource := avalue;
currsourcekind := sourcegroup;
if currsource<>'' then
needtofindnextgroup := false;
usedarg := true;
end
else if (tag='-g') or (tag='--goto') then
begin
wantedtogotosource := true;
if copy(avalue,1,1)<>'-' then
begin
currsource := avalue;
currsourcekind := sourcegroup;
usedarg := true;
end;
end
else if (tag='-p') or (tag='--port') then
begin
maybesetopti(tag,port,atoi(avalue)-1,mayuserestrictedopts);
console := false;
trusted := false;
usedarg := true;
end
else if (tag='-l') or (tag='--lines') then
begin
lpp := atoi(avalue);
usedarg := true;
end
else if (tag='-c') or (tag='--columns') then
begin
cols := atoi(avalue);
usedarg := true;
end
else if (tag='-f') or (tag='--fullname') then
begin
maybesetopts(tag,fullname,
trim(ununderscore(avalue)),mayuserestrictedopts);
usedarg := true;
end
else if (tag='-e') or (tag='--editor') then
handleviaset := true
else if (tag='-o') or (tag='--editor-options') then
handleviaset := true
else if (tag='-s') or (tag='--forum-set-list') then
begin
maybesetopts(tag,forumsetl,
uncomma(ununderscore(avalue)),mayuserestrictedopts);
usedarg := true;
end
else if (tag='-t') or (tag='--trusted') then
begin
maybesetoptb(tag,foundtrusted,true,mayuserestrictedopts);
end
else if tag='--waffle-version' then
begin
maybesetoptsh(tag,ifaceversion,avalue,mayuserestrictedopts);
usedarg := true;
xwritelns(
'warning: obsolete option --waffle-version - use --interface-version');
end
else if (tag='-v') or (tag='--interface-version') then
begin
maybesetoptsh(tag,ifaceversion,avalue,mayuserestrictedopts);
usedarg := true;
end
else if (tag='-m') or (tag='--minutes') then
begin
maybesetopti(tag,minutestorun,atoi(avalue),mayuserestrictedopts);
usedarg := true;
end
else if (tag='-d') or (tag='--shadow') then
handleviaset := true
else if (tag='-r') or (tag='--rcfile') then
begin
maybesetoptp(tag,rcfilename,unslash(avalue),mayuserestrictedopts);
usedarg := true;
end
else if (tag='-i') or (tag='--interface') then
begin
maybesetoptsh(tag,iface,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='--console' then
begin
if mayuserestrictedopts then
begin
console := true;
port := -1;
trusted := true;
minutestorun := maxint;
end;
xwritelns('warning: obsolete option --console');
end
else if tag='--vspeller' then
handleviaset := true
else if tag='--vspeller-options' then
handleviaset := true
else if tag='--set' then
begin
justhandleset(avalue,suspicious);
usedarg := true;
end
else if tag='--unset' then
begin
justhandleunset(avalue,suspicious);
usedarg := true;
end
else if tag='--subjects-case-insensitive' then
handleviaset := true
else if tag='--subject-length' then
handleviaset := true
else if tag='--squash-spaces' then
handleviaset := true
else if tag='--equate-truncated' then
handleviaset := true
else if tag='--make-space-like-x' then
handleviaset := true
else if tag='--make-return-like-asterisk' then
begin
xwritelns('warning: obsolete option --make-return-like-asterisk');
xwritelns('warning: use --select =13 * instead');
handlemap('select =13 *');
end
else if tag='--hide-these-headers' then
handleviaset := true
else if tag='--show-only-these-headers' then
handleviaset := true
else if tag='--highlight-these-headers' then
handleviaset := true
else if tag='--no-mail-from' then
handleviaset := true
else if tag='--no-mail-headers' then
handleviaset := true
else if tag='--no-news-headers' then
handleviaset := true
else if tag='--wandering-numbers' then
handleviaset := true
else if tag='--antikill-references' then
handleviaset := true
else if tag='--show-subject-kills' then
handleviaset := true
else if tag='--show-from-kills' then
handleviaset := true
else if tag='--show-subject-antikills' then
handleviaset := true
else if tag='--show-from-antikills' then
handleviaset := true
else if tag='--show-kills' then
handleviaset := true
else if tag='--show-antikills' then
handleviaset := true
else if tag='--auto-antikill' then
handleviaset := true
else if tag='--warn-auto-antikill' then
handleviaset := true
else if tag='--edit-after-vspell' then
handleviaset := true
else if tag='--case-insensitive-kill' then
handleviaset := true
else if tag='--case-insensitive-antikill' then
handleviaset := true
else if tag='--substring-subject-kill' then
handleviaset := true
else if tag='--substring-from-kill' then
handleviaset := true
else if tag='--substring-subject-antikill' then
handleviaset := true
else if tag='--substring-from-antikill' then
handleviaset := true
else if tag='--quiet' then
handleviaset := true
else if tag='--ignore-environment' then
maybesetoptb(tag,ignoreenvironment,true,mayuserestrictedopts)
else if tag='--confirm-quit' then
handleviaset := true
else if tag='--confirm-next' then {}{}{}{backwards-compatible}
handleviaset := true
else if tag='--confirm-next-group' then
handleviaset := true
else if tag='--confirm-next-article' then
handleviaset := true
else if tag='--missing-subject-is-ok' then
handleviaset := true
else if tag='--tilde-home' then
handleviaset := true
else if tag='--antikill-this-newsreader' then
handleviaset := true
else if tag='--clear-screen-between-groups' then
handleviaset := true
else if tag='--detect-video' then
handleviaset := true
else if tag='--antikill-even-killed' then
handleviaset := true
else if tag='--mail-prefix' then
begin
maybesetoptp(tag,mailprefix,avalue,mayuserestrictedopts);
usedarg := true;
end
else if tag='--ignore-mouse' then
ignoremouse := true
else if tag='--use-bios-for-screen' then
handleviaset := true
else if tag='--hide-form-feeds' then
handleviaset := true
else if tag='--path-userid' then
handleviaset := true
else if tag='--from-userid' then
handleviaset := true
else if tag='--custom-static' then
handleviaset := true
else if tag='--halt-on-unknown-groups' then
handleviaset := true
else if tag='--mouse-chars-header' then
handleviaset := true
else if tag='--just-dots' then
handleviaset := true
else if tag='--no-filemode' then
handleviaset := true
else if tag='--quit-message' then
handleviaset := true
else if tag='--output-separator' then
handleviaset := true
else if tag='--news-cmd-line' then
handleviaset := true
else if tag='--mail-cmd-line' then
handleviaset := true
else if tag='--mail-agent' then
handleviaset := true
else if tag='--outgoing-mail' then
handleviaset := true
else if tag='--outgoing-news' then
handleviaset := true
else if tag='--highlight-search-hits' then
handleviaset := true
else if (tag='--colors') or (tag='--colours') then
handleviaset := true
else if (tag='--quote-color') or (tag='--quote-color') then
handleviaset := true
{$ifdef charset}
else if tag='--local-charset' then
handleviaset := true
{$endif}
else if tag='--rmail-single' then
handleviaset := true
else if tag='--idle' then
handleviaset := true
else if tag='--swap' then
handleviaset := true
else if tag='--article-filename-pattern' then
handleviaset := true
else if tag='--overview-base-name' then
handleviaset := true
else if tag='--from-width' then
handleviaset := true
else if tag='--size-width' then
handleviaset := true
else if tag='--enter-group-command' then
handleviaset := true
else if tag='--dots-on-reset' then
handleviaset := true
else if tag='--view-command' then
handleviaset := true
else if tag='--extract-command' then
handleviaset := true
else if tag='--encode-command' then
handleviaset := true
else if tag='--crlf' then
handleviaset := true
else if tag='--find-quote-char' then
handleviaset := true
else if tag='--print-command' then {ugh}
handleviaset := true
else if tag='--netware' then
maybesetoptb(tag,netware,true,mayuserestrictedopts)
else if tag='--layout' then
handleviaset := true
else if (tag='--alternate-color') or (tag='--alternate-colour') then
handleviaset := true
else if (tag='--date-color') or (tag='--date-colour') then
handleviaset := true
else if tag='--mail-from' then
begin
maybesetopts(tag,netmail,avalue,mayuserestrictedopts); {verified later}
usedarg := true;
end
else if tag='--news-from' then
begin
maybesetopts(tag,netnews,avalue,mayuserestrictedopts); {verified later}
usedarg := true;
end
else if tag='--reply-to' then
begin
maybesetopts(tag,replyto,avalue,mayuserestrictedopts); {verified later}
usedarg := true;
end
else if tag='--mail-marker-line' then
handleviaset := true
else if tag='--news-marker-line' then
handleviaset := true
else if tag='--truncate-id-length' then
handleviaset := true
else if tag='--debug' then
handleviaset := true
else if tag='--mail-date-format' then
handleviaset := true
else if tag='--news-date-format' then
handleviaset := true
else if tag='--regex' then
handleviaset := true
else if tag='--quote-with-space' then
handleviaset := true
else if tag='--find-file-command' then
handleviaset := true
else
begin
{$ifdef ignoreoldoptions}
{ compatibility switch with earlier releases - now obsolete }
{try to make sure any error messages are going to be visible!}
console := true;
xwritesss(newsreadername,' ',newsreaderversion);
xwritelnss(': unknown option: ',tag);
usage; {usage shuts down}
{$else}
userid := tag;
xwritelns('warning: obsolete usage of userid on the command line');
xwritelns('use -u/--user instead');
{$endif}
end;
if handleviaset then
usedarg := handleset(tag+' '+avalue,suspicious);
if foundtrusted then
trusted := true;
handleoption := usedarg;
end; {handleoption}
begin {initialize}
{$ifdef timeout}
{ need to do this now, in case anything is illegal and needs a warn() }
minstart := mitoday;
minlastinput := mitoday;
{$endif}
{set up things for clean shutdowns}
oldtextattr := textattr;
haskillfile := false;
hasantikillfile := false;
{
killfileinmem := false;
antikillfileinmem := false;
}
joinfn := '';
{$ifdef mouse}
hasmouse := false;
{$endif}
randomize;
{
if memavail<configmemoryreserved+
sizeof(filenamesp^)+
sizeof(fromsp^)+
sizeof(datesp^) then
msgshutdown('insufficient memory',1);
new(filenamesp);
new(fromsp);
new(datesp);
}
if memavail<configmemoryreserved+
sizeof(groupkillsp^)+
sizeof(killsp^) then
msgshutdown('insufficient memory (kill)',1);
new(groupkillsp);
new(killsp);
if memavail<configmemoryreserved+
sizeof(groupantikillsp^)+
sizeof(antikillsp^) then
msgshutdown('insufficient memory (antikill)',1);
new(groupantikillsp);
new(antikillsp);
{
if memavail<configmemoryreserved+sizeof(hmessageidsp^) then
msgshutdown('insufficient memory (messageid)',1);
new(hmessageidsp);
if memavail<configmemoryreserved+numhashedrefs*sizeof(hreferencesp[1]^) then
msgshutdown('insufficient memory (references)',1);
new(hreferencesp[1]);
new(hreferencesp[2]);
new(hreferencesp[3]);
new(hreferencesp[4]);
}
createallconfigspathstring;
createallconfigsshortstring;
createallconfigsinteger;
createallconfigsboolean;
allocatedarts := 0;
while (memavail>configmemoryreserved+sizeof(articles[1]^)) and
(allocatedarts<maxarts) do
begin
inc(allocatedarts);
new(articles[allocatedarts]);
end;
if allocatedarts<2 then
msgshutdown('insufficient memory -- cannot hold even 2 articles!',1);
initopts;
needtofindnextgroup := true;
lowestartsearched := impossiblylargeart;
readpagesback := 0;
readunfiltered := false;
antikilledonly := false;
searchinheaders := false;
searchinbody := false;
searchthedate := false;
searchinsubj := false;
searchinname := false;
searchtext := '';
searchdatelow := ymdtodate(currentdatestring);
searchdatehigh := ymdtodate(currentdatestring);
wantedtogotosource := false;
lastfilen := '';
lastfolder := '';
defaultlppcols;
for ch := chr(0) to chr(255) do
begin
browsemap[ch] := ch;
selmap[ch] := ch;
mainmap[ch] := ch;
end;
{first do command-line options, which may use restricted options}
{$ifdef debug}
xwritelns('parameters:');
for currparmi := 1 to paramcount do
xwritelns(paramstr(currparmi));
{$endif}
currparmi := 1;
while currparmi<=paramcount do
begin
currparm := paramstr(currparmi);
if currparmi<paramcount then
nextparm := paramstr(currparmi+1)
else
nextparm := '';
{not suspicious because it's on the command-line}
if handleoption(lower(currparm),nextparm,notsuspicious) then
inc(currparmi);
inc(currparmi);
end;
{then do rcfile options, which may also use restricted options}
if rcfilename<>'' then
begin
{waste of time - tpascal doesn't use filemode on text files!}
oldfilemode := filemode;
if not nofilemode then
filemode := $40; {read only, deny none}
safereset(rcf,rcfilename);
if fileresult<>0 then
begin
console := true;
xwritelnss('could not open rc file ',rcfilename);
shutdown(1);
end;
{reset it for next time around}
rcfilename := '';
while not eof(rcf) do
begin
readln(rcf,rcval);
rctag := chopfirstw(rcval);
if length(rctag)>0 then
if rctag[1]<>'#' then
begin
if rctag[1]<>'-' then
rctag := '--'+rctag;
{not suspicious because it's in the rc file specified on the command-line}
if handleoption(lower(rctag),rcval,notsuspicious) then
;
end;
end;
close(rcf);
filemode := oldfilemode;
if rcfilename<>'' then
xwritelns('cannot use -r/--rcfile inside an rcfile, sorry');
end;
if usebiosforscreen then
directvideo := false;
{try to make sure any error messages are going to be visible!}
if not console and (port<>0) and (port<>1) and (port<>2) and (port<>3) then
begin
console := true;
xwritelns('error: -p/--port specified without valid port number');
xwritelns(' valid numbers are 1 (COM1) and 2 (COM2) (3=COM3 and');
xwritelns(' 4=COM4 allowed, your fossil may not support them)');
shutdown(1);
end;
xwritelnsss(newsreadername,' ',newsreaderversion);
wafenv := unslash(getenv('WAFFLE'));
uupcusr := unslash(getenv('UUPCUSRRC'));
uupcsys := unslash(getenv('UUPCSYSRC'));
if (iface='') and (wafenv<>'') then
begin
iface := 'waffle';
notquietlns('(assuming waffle interface)');
end;
if (iface='') and (uupcusr<>'') then
begin
iface := 'uupc';
notquietlns('(assuming uupc interface)');
end;
if iface='waffle' then
xiface := ifacewaffle
else if iface='uupc' then
xiface := ifaceuupc
else if iface='uufree' then
xiface := ifaceuufree
else
begin
xwritelnss('unknown interface: ',iface);
xwritelns('currently known: waffle, uupc, uufree');
shutdown(1);
end;
if userid='' then
if showdebug('userid') then
begin
if ignoreenvironment then
xwritelns('will ignore these environment variables:');
xwritelnss('NET_NAME=',getenv('NET_NAME'));
xwritelnss('USER=',getenv('USER'));
xwritelnss('LOGNAME=',getenv('LOGNAME'));
xwritelnss('USERNAME=',getenv('USERNAME'));
end;
if (userid='') and not ignoreenvironment then
userid := getenv('NET_NAME');
if (userid='') and not ignoreenvironment then
userid := getenv('USER');
if (userid='') and not ignoreenvironment then
userid := getenv('LOGNAME');
if (userid='') and not ignoreenvironment then
userid := getenv('USERNAME');
if userid='' then
if showdebug('userid') then
xwritelnss('getconfig(mailbox) returns: ',getconfig('mailbox'));
if userid='' then
userid := getconfig('mailbox');
if (userid='') and netware then
if showdebug('userid') then
xwritelnss('getnetwareid returns: ',getnetwareid);
if (userid='') and netware then
userid := getnetwareid;
if userid='' then
begin
xwritelns('unable to determine userid');
usage;
end;
if showdebug('userid') then
if length(userid)>truncateidlength then
xwritelns('truncating userid');
userid := lower(copy(userid,1,truncateidlength));
xwritelnss('user: ',userid);
if (xiface=ifacewaffle) and (wafenv='') then
begin
{$ifdef waffleenvcanbemissing}
xwritelns('no WAFFLE environment variable - using `./static''.');
wafenv := './static';
{$else}
xwritelns('must set WAFFLE environment variable');
shutdown(1);
{$endif}
end;
if (xiface=ifaceuupc) and (uupcsys='') then
begin
xwritelns('must set UUPCSYSRC environment variable');
shutdown(1);
end;
if (xiface=ifaceuufree) and (wafenv='') then
begin
{$ifdef waffleenvcanbemissing}
xwritelns('no WAFFLE environment variable - using `./static''.');
wafenv := './static';
{$else}
xwritelns('must set WAFFLE environment variable');
shutdown(1);
{$endif}
end;
if (ifaceversion='') and not ignoreenvironment then
ifaceversion := getenv('INTERFACEVERSION');
if (ifaceversion='') and (xiface=ifacewaffle) and not ignoreenvironment then
ifaceversion := getenv('WAFFLEVERSION');
{
need to define configdir before using it to check if waf165's index
file is there for 1.65 auto-detection
}
configdir := getconfig('configdir');
if (configdir='') and (xiface=ifacewaffle) then
configdir := copy(wafenv,1,rposc(wafenv,'\')-1);
if (configdir='') and (xiface=ifaceuufree) then
configdir := copy(wafenv,1,rposc(wafenv,'\')-1);
configdir := unslash(configdir);
if ifaceversion='' then
ifaceversion := getconfig('version');
if (ifaceversion='') and (xiface=ifacewaffle) then
if fexists(configdir+'\admin\'+'index') then
ifaceversion := '1.65'
else
ifaceversion := '1.64';
if (ifaceversion='') and (xiface=ifaceuufree) then
ifaceversion := ifaceversionunix;
if xiface=ifacewaffle then
if ifaceversion<>ifaceversionunix then
if (length(ifaceversion)<>4) or (copy(ifaceversion,2,1)<>'.') or
(numoccur('.',ifaceversion)<>1) then
begin
xwritelns('WAFFLEVERSION environment variable, or static file');
xwritelns('version: setting, or -v/--interface-version argument');
xwritelns('in wrong format -- should be either `unix'' or a');
xwritelns('number similar to `1.64'' (without the quotes)');
xwritelnsss('it is currently set to: `',ifaceversion,'''');
shutdown(1);
end;
if not quiet then
begin
xwritess('interface: ',iface);
xwritelnss(', version ',ifaceversion);
end;
{ not that useful -- only shows what's left inside pre-allocated heap }
{
notquietlns(ltoa(memavail div 1024)+'k available');
}
if allocatedarts<maxarts then
xwritelns('maximum '+itoa(allocatedarts)+' articles');
if debuglist<>'' then
notquietlnss('debug: ',debuglist);
temporarydir := getconfig('tempdir');
if not ignoreenvironment then
begin
temporarydir := default(getenv('TMP'),temporarydir);
temporarydir := default(getenv('TEMP'),temporarydir);
end;
temporarydir := default('.',temporarydir);
temporarydir := unslash(temporarydir);
spooldir := unslash(default(configdir+'/spool',getconfig('spooldir')));
userdir := unslash(default(configdir+'/user',getconfig('userdir')));
outboxdir := unslash(default(spooldir+'/outbox',getconfig('outboxdir')));
outform := default('flat',lower(getconfig('outform')));
{outform hierarchy will be in waffle 1.66}
if (outform<>'flat') and (outform<>'hierarchy') then
begin
xwritelnsss('unsupported outbox format: ',outform,', using flat');
outform := 'flat';
end;
{ would do the userid and pathuserid and fromuserid earlier, but need }
{ to define configdir first, and then we need to have the fullname! }
{can't use waffle's uucpfrom, since I use fromuserid in, say, Message-IDs}
{
if fromuserid='' then
fromuserid := getconfig('uucpfrom');
}
{ debuglist: translateuserid does its own output }
translateuserid;
{ must expand fullname once we have the right userid, and before we try }
{ to use %_ in expansion of pathuserid and fromuserid }
if fullname='' then
fullname := getfullnameforuser(userid);
if fullname='' then
begin
xwritelnsss('user ',userid,' has no name in the password file');
xwritelns(' that can be found, and environment variable FULLNAME');
xwritelns(' not set, and option -f/--fullname not used');
shutdown(1);
end;
fixpathuserid;
fixfromuserid;
fixcustomstatic;
{finally do user's rc file options, which MIGHT not use restricted options}
{done as early as possible to allow user to use --quiet usefully}
if xiface=ifacewaffle then
home := withbackslash(userdir)+userid;
if xiface=ifaceuupc then
home := unslash(unbackslash(getconfig('home')));
if xiface=ifaceuufree then
home := withbackslash(userdir)+userid;
if home='' then
begin
xwritelns('unknown home directory');
shutdown(1);
end;
{waste of time - tpascal doesn't use filemode on text files!}
oldfilemode := filemode;
if not nofilemode then
filemode := $40; {read only, deny none}
rcfilename := withbackslash(home)+newsreadername+'.rc';
safereset(rcf,rcfilename);
if fileresult=0 then
begin
while not eof(rcf) do
begin
readln(rcf,rcval);
rctag := chopfirstw(rcval);
if length(rctag)>0 then
if (rctag[1]<>'#') and (rctag[1]<>';') then
begin
if rctag[1]<>'-' then
rctag := '--'+rctag;
{very important that this is marked as `suspicious' value (third arg)!}
{because it's from the user's rnr.rc file}
if handleoption(lower(rctag),rcval,issuspicious) then
;
end;
end;
close(rcf);
end
else
xwritelnsss('(could not open rc file ',rcfilename,')');
filemode := oldfilemode;
{finally done reading options}
if idleminutes=0 then
if trusted then
idleminutes := 60
else
idleminutes := 5;
notquietlnss('full name: ',fullname);
{}{} {needs to get editor entry from password and extern/_editors files}
if (editor='') and not ignoreenvironment then
editor := getenv('VISUAL');
if (editor='') and not ignoreenvironment then
editor := getenv('EDITOR');
if editor='' then
editor := 'vi';
notquietlnss('editor: ',editor);
if (vspeller='') and not ignoreenvironment then
vspeller := getenv('VSPELL');
if (vspeller='') and not ignoreenvironment then
vspeller := getenv('SPELL');
if vspeller='' then
vspeller := 'vspell';
notquietlnss('vspeller: ',vspeller);
if not quiet and (minutestorun>=0) then
if minutestorun>24*60 then
xwritelnsi('days left this session: ',minutestorun div 60 div 24)
else if minutestorun>60 then
xwritelnsi('hours left this session: ',minutestorun div 60)
else
xwritelnsi('minutes left this session: ',minutestorun);
uucpname := getconfig('uucpname');
fqdn := getconfig('fqdn');
organ := getconfig('organ');
newsname := default(uucpname,getconfig('newsname'));
smarthost := getconfig('smarthost');
if (smarthost='') and (xiface=ifaceuupc) then
smarthost := uupcgetconfig('newsserv');
if (uucpname='') or (smarthost='') then
begin
xwritelns('invalid uucpname or smarthost static variable');
xwritelns(' neither of these may be empty');
xwritelns(' current values:');
xwritelnss(' uucpname: ',uucpname);
xwritelnss(' smarthost: ',smarthost);
shutdown(1);
end;
smarthostdir := smarthost;
if pos('!',smarthostdir)<>0 then
smarthostdir := copy(smarthost,1,pos('!',smarthostdir)-1);
smarthostdir := withbackslash(spooldir)+smarthostdir;
maybemkhier(home);
maybemkhier(outboxdir);
maybemkhier(temporarydir);
backbone := getconfig('backbone');
if backbone='' then
begin
{use waffle's default}
notquietlns('no backbone variable -- using berkeley');
backbone := 'ucbvax.berkeley.edu';
end;
if mailprefix='' then
mailprefix := uucpname+'.mail';
{make life easier later - redefine mailprefix to include userid}
mailprefix := mailprefix+'.'+userid;
notquietlnss('mail groups begin with ',mailprefix);
{this way can be much quicker than using default}
if netmail='' then
netmail := getconfig('netmail');
if netnews='' then
netnews := getconfig('netnews');
if replyto='' then
replyto := getconfig('replyto');
{here calling default doesn't hurt}
netmail := default('%A@%n (%W)',netmail);
netnews := default(netmail,netnews);
mailfrom := wafexpand(netmail);
newsfrom := wafexpand(netnews);
if replyto<>'' then
replyto := wafexpand(replyto);
if
hasno('.',fqdn)
or
(numoccur('@',mailfrom)>1)
or
(numoccur('@',newsfrom)<>1)
or
(numoccur('@',replyto)>1)
or
(pos('@.',mailfrom)<>0)
or
(pos('@.',newsfrom)<>0)
or
(pos('@.',replyto)<>0)
or
(
hasno('@',mailfrom) and hasno('!',mailfrom)
)
or
(
(replyto<>'') and hasno('@',replyto) and hasno('!',replyto)
)
or
(
hasany('(',newsfrom) and
(
(numoccur('(',newsfrom)<>1)
or (numoccur(')',newsfrom)<>1)
or (numoccur('<',newsfrom)<>0)
or (numoccur('>',newsfrom)<>0)
)
)
then
begin
xwritelns('invalid node: or netmail:/netnews:/replyto: static entry');
xwritelns(' the node (fqdn) entry needs at least one "."');
xwritelns(' the netmail entry needs one "@" and/or at least one "!"');
xwritelns(' the netnews entry needs one "@"');
xwritelns(' the netnews entry cannot have any of ()<> inside the ()');
xwritelns(' any replyto entry needs one "@" and/or at least one "!"');
xwritelns(' @. is never legal in a mail address');
xwriteln;
xwritelns('current settings:');
xwritelnss(' node: ',fqdn);
xwritelnss(' newsfrom: ',newsfrom);
xwritelnss(' mailfrom: ',mailfrom);
xwritelnss(' replyto: ',replyto);
shutdown(1);
end;
notquietlnss('mail from: ',mailfrom);
if mailfrom<>newsfrom then
notquietlnss('news from: ',newsfrom);
if replyto<>'' then
if not quiet then
begin
if replyto=mailfrom then
xwritelnss('reply-to: ','(same as mail)')
else if replyto=newsfrom then
xwritelnss('reply-to: ','(same as news)')
else
xwritelnss('reply-to: ',replyto);
end;
maymail := true;
maypost := true;
if pos('@no.such.domain',mailfrom)<>0 then
begin
maymail := false;
xwritelns('unconfigured -- you may not mail');
end;
if pos('@no.such.domain',newsfrom)<>0 then
begin
maypost := false;
xwritelns('unconfigured -- you may not post');
end;
fixnewscmdline;
fixmailcmdline;
if forumsetl='' then
forumsetl := getconfig('forums');
forumsetl := ltrim(trim(forumsetl));
if (forumsetl='') and (xiface=ifaceuupc) then
forumsetl := 'active';
if forumsetl='' then
begin
xwritelns('empty forum set list');
shutdown(1);
end;
notquietlnss('forum set list: ',forumsetl);
if not ignoreenvironment then
timezone := getenv('TZ');
if timezone='' then
timezone := getconfig('timezone');
if timezone='' then
timezone := '-0700';
if pos(' ',timezone)>1 then
timezone := copy(timezone,1,pos(' ',timezone)-1)
else if (timezone[1]<>'+') and (timezone[1]<>'-') then
timezone := copy(timezone,1,3);
{ handles TZ=GMT0BST and TZ=+1100 and TZ=BST-1 cases }
{}{}{} {need to do more checking on the timezone!}
notquietlnss('timezone: ',timezone);
comspec := getenv('COMSPEC');
if comspec='' then
if indir('c:\.','command.com') then
comspec := 'c:\command.com'
else
comspec := 'command.com';
notquietlnss('newscmdline: ',newscmdline);
notquietlnss('mailcmdline: ',mailcmdline);
{once joinfn is assigned to a nonempty string, it's open}
joinfn := home+'\join';
safereset(joinf,joinfn);
if fileresult<>0 then
begin
xwritelnsss('join file ',joinfn,' not found.');
joinfn := '';
shutdown(1);
end;
numjoined := 0;
backupjoin;
readinkill(yesbackupkill);
readinantikill(yesbackupkill);
if currsource<>'' then
if not expandsource(currsource,currsourcekind) then
begin
xwritelnss('you are not joined to ',currsource);
xwritelns('and it does not look like a valid directory, so');
xwritelns('I will start at the top of the join file');
currsource := '';
needtofindnextgroup := true;
end;
fixuplppcols;
if not quiet then
begin
xwritelnsi('lines per page: ',lpp);
xwritelnsi('sel lines per page: ',sellpp);
xwritelnsi('columns: ',cols);
if usebiosforscreen then
xwritelns('(using bios for screen writes)');
if hideformfeeds then
xwritelns('(hiding form feeds)');
end;
if console then
begin
fixcolors;
mouseinit;
end;
xlowvideo;
if outgoingmail<>'' then
begin
unfoldergroup(outgoingmail);
if not ismailgroup(outgoingmail) then
outgoingmail := '='+outgoingmail;
unfoldergroup(outgoingmail);
xwritelnss('copies of outgoing mail will be put in ',outgoingmail);
end;
if uselocalcharset then
begin
loadcharsets(localcharsetfn);
end;
if wantedtogotosource then
begin
{ make sure last line had no valuable information }
xgotoxy(1,lpp);
xwriteln;
pickasource(currsource,currsourcekind);
if currsource<>'' then
needtofindnextgroup := false;
end;
end;
end.