home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 31
/
CDASC_31_1996_juillet_aout.iso
/
internet
/
rnr214.zip
/
RNRCREA.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-01
|
59KB
|
2,153 lines
unit rnrcrea; {formerly from rnrselb}
{$I rnr-def.pas}
interface
uses rnrglob,rnrconf,genericf,rnrfunc,rnrproc,rnrio,rnrfile,rnrmous,rnrart
{$ifdef charset}
,rnrchar
{$endif}
;
procedure delivermail(mailfn: string);
procedure sendnewsasmail(infn: string; addr: string);
procedure injnews(newartfn: string; newsgroups, originalnewsgroups: string);
procedure copylocalmessage(localfn: string; newfn: string);
procedure createpostorcancel(iscancel: boolean;
newsgroups, originalnewsgroups, followupto, subject,
references, author, originalauthor: string; includedfile: string);
procedure createcancel(newsgroups, subject, references,
originalauthor: string);
procedure createpost(newsgroups, originalnewsgroups, followupto, subject,
references, author, originalauthor: string; includedfile: string);
procedure editanddeliver(subject,inreplyto,replyaddr,replyname,ccaddr,
originalfrom,author: string; defaultreply: boolean; includedfile: string;
justremail: boolean);
procedure editandinjnews(newsgroups, originalnewsgroups, author: string);
procedure post;
procedure mail;
procedure postfile;
procedure mailfile;
implementation
{ assumes setsendencoding() has already been called }
procedure copylocalmessage(localfn: string; newfn: string);
var
localf: text;
newf: text;
emptylinefound: boolean;
oneline: string;
begin
safereset(localf,localfn);
saferewrite(newf,newfn);
emptylinefound := false;
while not eof(localf) do
begin
readln(localf,oneline);
if oneline='' then
emptylinefound := true;
{$ifdef charset}
if uselocalcharset then
if emptylinefound then
localtoline(oneline);
{$endif}
writeln(newf,oneline);
end;
close(localf);
close(newf);
end;
procedure execrmail(addrlist: string; lffn: string);
begin
if pos('%f',mailcmdline)=0 then
execviacomspec(extwafexpand(mailcmdline,addrlist,'')+' < '+lffn)
else
execviacomspec(extwafexpand(mailcmdline,addrlist,lffn));
end;
procedure delivermailtolist(mailfn: string; addrlist: string);
var
builtin: boolean;
realaddrlist: string;
mangledaddrlist: string;
oneaddress: string;
firstinlist: boolean;
{LF file -- empty if there's no need for a LF file this pass}
lffn: string;
lff: text;
{file the mail's currently in}
mailf: text;
{new sequence #}
seqstr: string;
{outbox copy}
outboxfn: string;
outboxf: text;
{--outgoing-mail folder copy}
folderfn: string;
folderf: text;
emptylinefound: boolean;
oneline: string;
{whether to fake rmail-single (in case of a long list)}
usingrmailsingle: boolean;
basesite: string;
begin
builtin := mailcmdline=builtincookie;
usingrmailsingle := rmailsingle;
realaddrlist := expandmail(addrlist);
if length(realaddrlist)>64 then
usingrmailsingle := true;
firstinlist := true;
mangledaddrlist := realaddrlist;
while mangledaddrlist<>'' do
begin
oneaddress := chopfirstaddr(mangledaddrlist);
basesite := copy(basesitename(oneaddress),1,8);
outboxfn := withbackslash(outboxdir)+basesite;
{getuniqfext makes sure it's not a device}
{}{}{}{} {getuniqfile doesn't quite!}
if outform='flat' then
outboxfn := getuniqfext(outboxfn)
else
begin
mkhier(outboxfn);
outboxfn := getuniqfile(outboxfn);
end;
lffn := '';
if builtin then
begin
maybemkhier(smarthostdir);
seqstr := integertozstring(newseqnumber,4);
lffn := withbackslash(smarthostdir)+seqstr+'.dat';
end
else if firstinlist or usingrmailsingle then
begin
lffn := withbackslash(temporarydir)+userid+'.nl';
end;
saferewrite(outboxf,outboxfn);
if fileresult<>0 then
begin
xwritelnss('could not write to ',outboxfn);
shutdown(1);
end;
if lffn<>'' then
begin
saferewrite(lff,lffn);
if fileresult<>0 then
begin
xwritelnss('could not write to ',lffn);
shutdown(1);
end;
end;
safereset(mailf,mailfn);
if fileresult<>0 then
begin
xwritelnss('could not read ',mailfn);
shutdown(1);
end;
emptylinefound := false;
while not eof(mailf) do
begin
readln(mailf,oneline);
if oneline='' then
emptylinefound := true;
{$ifdef charset}
if uselocalcharset then
if emptylinefound then
localtoline(oneline);
{$endif}
if not trusted then
if not emptylinefound then
if makesame(oneline,'From: ',mailfrom) then
begin end;
writeln(outboxf,oneline);
if lffn<>'' then
write(lff,oneline,lf);
end;
close(mailf);
close(outboxf);
if lffn<>'' then
close(lff);
if builtin then
begin {builtin}
{once .DAT is written, create .XQT}
lffn := withbackslash(smarthostdir)+seqstr+'.xqt';
saferewrite(lff,lffn);
write(lff,'U ',fromuserid,' ',uucpname,lf);
write(lff,'Z',lf);
write(lff,'F D.',uucpname,seqstr,lf);
write(lff,'I D.',uucpname,seqstr,lf);
write(lff,'C rmail ',oneaddress,lf);
close(lff);
{once .DAT and .XQT are written, create .CMD}
lffn := withbackslash(smarthostdir)+seqstr+'.cmd';
saferewrite(lff,lffn);
writeln(lff,'S ',seqstr,'.DAT D.',uucpname,seqstr,' ',
fromuserid,' - ',seqstr,'.DAT 0600');
writeln(lff,'S ',seqstr,'.XQT X.',uucpname,seqstr,' ',
fromuserid,' - ',seqstr,'.XQT 0600');
close(lff);
end {builtin}
else if usingrmailsingle then
begin {usingrmailsingle}
mouseshutdown;
execrmail(oneaddress,lffn);
mouseinit;
if execresult<>0 then
warnerr(mailcmdline,execresult);
end {usingrmailsingle}
else if firstinlist then
begin {firstinlist}
mouseshutdown;
execrmail(uncomma(realaddrlist),lffn);
mouseinit;
if execresult<>0 then
warnerr(mailcmdline,execresult);
end; {firstinlist}
firstinlist := false;
end;
end;
procedure delivermail;
var
toaddr: string;
ccaddr: string;
{the --outgoing-mail should only get one copy, even with two lists}
outgoingmaildir: string;
outgoingmailfn: string;
outgoingmailf: text;
begin
{two :mail commands in a row don't work without this!}
headerinmem := '';
{$ifdef charset}
{ Must do this _before_ opening mailfile with reset(), or it will fail }
{ for the poor users who have share loaded }
if uselocalcharset then
setsendencoding(
getheaderline(mailfn,'content-type:'),
getheaderline(mailfn,'content-transfer-encoding:'));
{$endif}
toaddr := getheaderline(mailfn,'to:');
ccaddr := getheaderline(mailfn,'cc:');
if toaddr=couldnotreadfilecookie then
begin
warn('not sent -- could not read '+mailfn+'!');
end
else if ccaddr=couldnotreadfilecookie then
begin
warn('not sent -- could not read '+mailfn+'!');
end
else
begin
delivermailtolist(mailfn,toaddr);
if ccaddr<>'' then
delivermailtolist(mailfn,ccaddr);
if outgoingmail<>'' then
begin
outgoingmaildir := getgroupdir(outgoingmail);
if outgoingmaildir='' then
warn('could not find a directory for '+outgoingmail)
else
begin
mkhier(outgoingmaildir);
outgoingmailfn := getuniqfile(outgoingmaildir);
xclreolxy(1,lpp);
xwritesss('Saving a copy in ',outgoingmailfn,'...');
copylocalmessage(mailfn,outgoingmailfn);
end;
end;
end;
{caller will refresh}
end;
procedure sendnewsasmail;
var
inf: text;
tempfn: string;
tempf: text;
oneline: string;
toseen: boolean;
emptylinefound: boolean;
ccaddrfound: string;
isccline: boolean;
toaddr: string;
ccaddr: string;
begin
warn('mailing to '+copy(addr,1,50));
toaddr := '';
ccaddr := '';
xwrites('mailing...');
safereset(inf,infn);
tempfn := withbackslash(temporarydir)+userid+'.n2m';
saferewrite(tempf,tempfn);
if not nomailfrom then
writeln(tempf,'From ',fromuserid,' ',copy(cdow,1,3),', ',
dayofmonth,' ',copy(monthname,1,3),' ',year,' ',currenttimestring,' ',
timezone,' ','remote from ',uucpname);
if not isheaderinlist('Received:',nomailheaders) then
begin
writeln(tempf,'Received: by ',fqdn,' ('+newsreadername+')');
writeln(tempf,' via ',newsreadername,'; ',copy(cdow,1,3),', ',
dayofmonth,' ',copy(monthname,1,3),' ',year,' ',
currenttimestring,' ',timezone);
end;
{ supress CC:s until very end -- if there was a To: then give up the CC: }
{ unchanged; otherwise change the CC: to a To: so there's one for uupc }
toseen := false;
emptylinefound := false;
ccaddrfound := '';
while not eof(inf) do
begin
readln(inf,oneline);
isccline := false;
if not emptylinefound then {must write it before the empty line!}
begin
if lower(copy(ltrim(oneline),1,3))='to:' then
begin
toseen := true;
oneline := ltrim(copy(ltrim(oneline),4,255));
if (oneline='poster') or (oneline='sender') then
oneline := addr;
toaddr := expandmail(oneline);
oneline := 'To: '+toaddr;
end;
if lower(copy(ltrim(oneline),1,3))='cc:' then
begin
ccaddrfound := ltrim(copy(ltrim(oneline),4,255));
isccline := true;
end;
if oneline='' then
emptylinefound := true;
if emptylinefound then {it must have _just_ become true}
begin
if not isheaderinlist('Comments:',nomailheaders) then
begin
writeln(tempf,'Comments: ',
'this message originated as a public newsgroup posting');
end;
if toseen then {was a To: -- print out the CC: we suppressed}
begin
if ccaddrfound<>'' then
begin
if (ccaddrfound='poster') or (ccaddrfound='sender') then
ccaddrfound := addr;
ccaddrfound := expandmail(ccaddrfound);
ccaddr := ccaddrfound;
writeln(tempf,'CC: ',ccaddr);
end;
end
else
begin
if ccaddrfound='' then
ccaddrfound := addr;
if (ccaddrfound='poster') or (ccaddrfound='sender') then
ccaddrfound := addr;
ccaddrfound := expandmail(ccaddrfound);
toaddr := ccaddrfound;
writeln(tempf,'To: ',toaddr);
toseen := true;
end;
if indicatepostedmailinbody then
begin
{finish headers}
writeln(tempf);
writeln(tempf,
'[ this message originated as a public newsgroup posting ]');
{empty line (the first one!) will follow}
end;
end;
end;
if not isccline then
writeln(tempf,oneline);
end;
close(inf);
close(tempf);
delivermail(tempfn);
end;
{}{} {should be a three-part process!}
procedure injnews;
var
goingtomail: boolean;
newartf: text;
newartlffn: string;
newartlff: text;
emptylinefound: boolean;
oneline: string;
newnewsgroups: string;
mungedgroups: string;
firstnewsgroup: string;
firstcommapos: integer;
newfrom: string;
newapproved: string;
outgoinggroup: string;
outgoingdir: string;
outgoingfn: string;
outgoingf: text;
fromfound: boolean;
moderatoraddr: string;
onlylf: boolean;
begin
goingtomail := false;
headerinmem := '';
{ Must do this _before_ opening mailfile with reset(), or it will fail }
{ for the poor users who have share loaded }
{$ifdef charset}
if uselocalcharset then
setsendencoding(
getheaderline(newartfn,'content-type:'),
getheaderline(newartfn,'content-transfer-encoding:'));
{$endif}
newnewsgroups := getheaderline(newartfn,'newsgroups:');
newfrom := getheaderline(newartfn,'from:');
newapproved := getheaderline(newartfn,'approved:');
safereset(newartf,newartfn);
{copy to outgoing directory if asked -- just pick the first one found}
outgoingfn := '';
outgoinggroup := '';
{first: try to find an outgoing group for any group it was posted to}
{the `done' isn't necessary, even a space would do, and probably}
{even ending the string at the `,' would do, but why take chances}
{with the string routines?}
mungedgroups := newnewsgroups+',done';
while (outgoinggroup='') and (numoccur(',',mungedgroups)>0) do
begin
firstcommapos := pos(',',mungedgroups);
firstnewsgroup := copy(mungedgroups,1,firstcommapos-1);
mungedgroups := copy(mungedgroups,firstcommapos+1,255);
outgoinggroup := groupsattr(firstnewsgroup,'/spy=');
end;
{second: try to find an outgoing group for any group before editing}
{the `done' isn't necessary, even a space would do, and probably}
{even ending the string at the `,' would do, but why take chances}
{with the string routines?}
mungedgroups := newsgroups+',done';
while (outgoinggroup='') and (numoccur(',',mungedgroups)>0) do
begin
firstcommapos := pos(',',mungedgroups);
firstnewsgroup := copy(mungedgroups,1,firstcommapos-1);
mungedgroups := copy(mungedgroups,firstcommapos+1,255);
outgoinggroup := groupsattr(firstnewsgroup,'/spy=');
end;
{finally: try to find an outgoing group for any group before Followup-To: }
{the `done' isn't necessary, even a space would do, and probably}
{even ending the string at the `,' would do, but why take chances}
{with the string routines?}
mungedgroups := originalnewsgroups+',done';
while (outgoinggroup='') and (numoccur(',',mungedgroups)>0) do
begin
firstcommapos := pos(',',mungedgroups);
firstnewsgroup := copy(mungedgroups,1,firstcommapos-1);
mungedgroups := copy(mungedgroups,firstcommapos+1,255);
outgoinggroup := groupsattr(firstnewsgroup,'/spy=');
end;
if outgoinggroup='' then
outgoinggroup := outgoingnews;
if outgoinggroup='' then
begin
if not quiet then
warn('(there is no outgoing group copy for this post)');
end
else
begin
outgoingdir := getgroupdir(outgoinggroup);
if outgoingdir='' then
begin
warn('no dir found for outgoing group '+outgoinggroup+' !');
end
else
begin
outgoingfn := getuniqfile(outgoingdir);
end;
end;
{check if any group on the list is moderated}
{the `done' isn't necessary, even a space would do, and probably}
{even ending the string at the `,' would do, but why take chances}
{with the string routines?}
mungedgroups := newnewsgroups+',done';
moderatoraddr := '';
while (moderatoraddr='') and (numoccur(',',mungedgroups)>0) do
begin
firstcommapos := pos(',',mungedgroups);
firstnewsgroup := copy(mungedgroups,1,firstcommapos-1);
mungedgroups := copy(mungedgroups,firstcommapos+1,255);
if ismoderated(firstnewsgroup) then
begin
moderatoraddr := groupsattr(firstnewsgroup,'/mod=');
if moderatoraddr='' then
begin
{1996-02-15 -- this crepl caused a stack overflow}
moderatoraddr := crepl(firstnewsgroup,'.','-');
moderatoraddr := moderatoraddr+'@'+backbone;
end;
end;
end;
{
allow only trusted users to issue Control: messages, post to alt.hackers,
be group moderators, etc.
}
if trusted then
if newapproved<>'' then
moderatoraddr := '';
goingtomail := (moderatoraddr<>'');
{use LF for posts, CRLF for mail}
onlylf := not goingtomail;
newartlffn := withbackslash(temporarydir)+userid+'.nl';
saferewrite(newartlff,newartlffn);
if outgoingfn<>'' then
begin
mkhier(outgoingdir);
saferewrite(outgoingf,outgoingfn);
if fileresult<>0 then
begin
warn('could not write to outgoing file '+outgoingfn);
outgoingfn := '';
end;
end;
emptylinefound := false;
reset(newartf);
while not eof(newartf) do
begin
readln(newartf,oneline);
{$ifdef charset}
if (uselocalcharset) then
if emptylinefound then
localtoline(oneline);
{$endif}
if not trusted then
if not emptylinefound then
if makesame(oneline,'From: ',mailfrom) then
begin end;
if not emptylinefound then
if copy(oneline,1,6)='From: ' then
fromfound := true;
if oneline='' then
begin
if not emptylinefound then {this must be the first empty line}
begin
if not fromfound then
begin
if onlylf then
write(newartlff,'From: ',newsfrom,lf)
else
writeln(newartlff,'From: ',newsfrom);
if outgoingfn<>'' then
writeln(outgoingf,'From: ',newsfrom);
fromfound := true;
end;
end;
emptylinefound := true;
end;
if onlylf then
write(newartlff,oneline,lf)
else
writeln(newartlff,oneline);
if outgoingfn<>'' then
writeln(outgoingf,oneline);
end;
close(newartf);
close(newartlff);
if outgoingfn<>'' then
close(outgoingf);
if goingtomail then
begin
sendnewsasmail(newartlffn,moderatoraddr);
end
else
begin
{}{} {should use rnews in bin directory only?}
mouseshutdown;
if pos('%f',newscmdline)=0 then
execviacomspec(wafexpand(newscmdline)+' < '+newartlffn)
else
execviacomspec(extwafexpand(newscmdline,'',newartlffn));
mouseinit;
{}{} {waffle's rnews sometimes displays random error message on low memory}
{but then doesn't exit with an error return code!}
waitnseconds(1);
if execresult<>0 then
warnerr(newscmdline,execresult);
end;
end;
procedure createpostorcancel;
{ if author<>'', opens then closes artf }
var
newartfn: string;
newartf: text;
refline: string;
wref: string;
nextref: string;
ref1,ref2: string;
emptylinefound: boolean;
sigfn: string;
sigf: text;
oneline: string;
ccaddr: string;
begin
{ don't propogate errors in the Newsgroups: line if you can help it }
newsgroups := unspace(newsgroups);
followupto := unspace(followupto);
newartfn := withbackslash(temporarydir)+userid+'.fol';
saferewrite(newartf,newartfn);
{this done since waf164 didn't handle newsname like waf165 does}
if not isheaderinlist('Path:',nonewsheaders) then
writeln(newartf,'Path: ',newsname,'!',pathuserid);
writeln(newartf,'Newsgroups: ',newsgroups);
if (originalnewsgroups<>'') and (originalnewsgroups<>newsgroups) then
writeln(newartf,'X-Original-Newsgroups: ',originalnewsgroups);
if followupto<>'' then
writeln(newartf,'Followup-To: ',followupto);
if originalauthor<>'' then
writeln(newartf,'X-Original-Article-From: ',originalauthor);
if iscancel then
begin
if newsfrom=originalauthor then
begin
writeln(newartf,'From: ',newsfrom);
writeln(newartf,'Sender: ',newsfrom);
end
else
begin
writeln(newartf,'From: ',originalauthor);
writeln(newartf,'Sender: ',newsfrom);
end;
end
else
begin
writeln(newartf,'From: ',newsfrom);
end;
if replyto<>'' then
writeln(newartf,'Reply-To: ',replyto);
writeln(newartf,'Subject: ',subject);
if not isheaderinlist('Message-ID:',nonewsheaders) then
writeln(newartf,'Message-ID: ',newmessageid);
writeln(newartf,'Date: ',copy(cdow,1,3),', ',dayofmonth,' ',
copy(monthname,1,3),' ',year,' ',currenttimestring,' ',timezone);
if references<>'' then
begin
{$ifdef rnewscontbroken}
writeln(newartf,'References: ',references);
{$else}
{ wref is the space-terminated string of references that are yet to be }
{ written out - it starts with two spaces if need be (other than line one) }
wref := 'References: ';
while references<>'' do
begin
references := ltrim(references);
nextref := chopfirstw(references);
if length(wref+nextref)>70 then
begin
writeln(newartf,wref);
wref := ' '+nextref+' ';
end
else
wref := wref+nextref+' ';
end;
if wref<>'' then
writeln(newartf,trim(wref));
{$endif}
end;
if organ<>'' then
writeln(newartf,'Organization: ',organ);
{$ifdef charset}
if uselocalcharset then
begin
writeln(newartf,'MIME-Version: 1.0');
writeln(newartf,'Content-Type: text/plain; charset=',mailingsetname);
writeln(newartf,'Content-Transfer-Encoding: ',mailxfername);
end;
{$endif}
if iscancel then
writeln(newartf,'Control: ','cancel ',references);
if not isheaderinlist('X-Newsreader:',nonewsheaders) then
writeln(newartf,'X-Newsreader: ',newsreadername,' ',newsreaderversion);
writeln(newartf);
if iscancel then
writeln(newartf,'cancelled within ',newsreadername)
else if includedfile<>'' then
begin
writeln(newartf,'encoded file ',includedfile,' follows:');
writeln(newartf);
close(newartf);
appendencodedfile(newartfn,includedfile);
assign(newartf,newartfn);
append(newartf);
writeln(newartf);
end
else if author='' then
writeln(newartf,newsmarkerline)
else
begin
writeln(newartf,author,' writes:');
writeln(newartf);
emptylinefound := false;
artreset;
while not arteof and not emptylinefound do
begin
getartl(oneline,255,notoscreen);
if oneline='' then
emptylinefound := true;
end;
while not arteof do
begin
{don't use just cols here, to be polite}
getartl(oneline,min(cols,80)-3,notoscreen);
{$ifdef charset}
if uselocalcharset then
linetolocal(oneline);
{$endif}
if oneline='' then
writeln(newartf,'>')
else if (copy(oneline,1,1)='>') and not quotewithspace then
writeln(newartf,'>',expand(oneline))
else
writeln(newartf,'> ',expand(oneline));
end;
artclose;
end;
sigfn := unslash(getconfig('signature'));
if sigfn='' then
sigfn := 'sig';
if numoccur('\',sigfn)=0 then
sigfn := withbackslash(home)+sigfn;
safereset(sigf,sigfn);
if fileresult=0 then
begin
readln(sigf,oneline);
if oneline<>'-- ' then
writeln(newartf,'-- ');
reset(sigf);
while not eof(sigf) do
begin
readln(sigf,oneline);
writeln(newartf,oneline);
end;
close(sigf);
end;
close(newartf);
end;
procedure createcancel;
begin
createpostorcancel(true,newsgroups,'','',subject,
references,'',originalauthor,'');
end;
procedure createpost;
begin
createpostorcancel(false,newsgroups,originalnewsgroups,followupto,
subject,references,author,originalauthor,includedfile);
end;
procedure editandinjnews;
var
newartfn: string;
sendeditvspellquit: char;
ccaddr: string;
cansend: boolean;
sendprompt: string;
sendchar: char;
invalidmessage: string;
anyunknowngroups: boolean;
anymailgroups: boolean;
newsgroupsline: string;
onenewsgroup: string;
onenewsgroupwithdesc: string;
onenewsgroupwithdescline: integer;
groupwidth: integer;
descwidth: integer;
begin
{ don't propogate errors in the Newsgroups: line if you can help it }
newsgroups := unspace(newsgroups);
newartfn := withbackslash(temporarydir)+userid+'.fol';
{edit the first time around}
sendeditvspellquit := 'e';
while (sendeditvspellquit<>'s') and (sendeditvspellquit<>'q') do
begin
if not trusted then
if sendeditvspellquit='E' then
sendeditvspellquit := 'e';
if sendeditvspellquit='v' then
begin
mouseshutdown;
execp(vspeller,vspelleroptions+' '+newartfn);
mouseinit;
if execresult<>0 then
warnerr(vspeller,execresult);
if editaftervspell then
sendeditvspellquit := 'e';
end;
if sendeditvspellquit='e' then
begin
mouseshutdown;
execp(editor,editoroptions+' '+newartfn);
mouseinit;
if execresult<>0 then
warnerr(editor,execresult);
end;
if sendeditvspellquit='E' then
begin
mouseshutdown;
execp(editor,editoroptions+' '+newartfn+' '+artfn);
mouseinit;
if execresult<>0 then
warnerr(editor,execresult);
end;
{}{} {check headers and headers-ran-into-body messages}
{invalid format of Newsgroups: line (spaces, etc.)}
{warn if any groups in Newsgroups: not in forum set}
{delete any duplicates from Newsgroups: line}
{check From:}
{check for /solo groups}
{a Lines: header might be polite. maybe not}
headerinmem := ''; {invalidate cache from last getheaderline}
cansend := true;
xclreolxy(1,lpp);
xwrites('checking headers...');
if cansend then
if getheaderline(newartfn,'from:')=couldnotreadfilecookie then
begin
warn('not sent -- could not read '+newartfn+'!');
cansend := false;
end;
if cansend then
if trim(getheaderline(newartfn,'from:'))='' then
begin
warn('no From: header -- cannot send');
cansend := false;
end;
if cansend then
if not trusted then
if getfromaddr(getheaderline(newartfn,'from:'))<>
getfromaddr(newsfrom) then
begin
warn('changed From: header -- cannot send');
cansend := false;
end;
if cansend then
if trim(getheaderline(newartfn,'subject:'))='' then
begin
warn('no Subject: header -- cannot send');
cansend := false;
end;
if cansend then
if lower(trim(getheaderline(newartfn,'subject:')))='re:' then
begin
warn('no Subject: header -- cannot send');
cansend := false;
end;
if cansend then
begin
newsgroupsline := getheaderline(newartfn,'newsgroups:');
newsgroupsline := ltrim(trim(newsgroupsline));
newsgroupsline := crepl(newsgroupsline,tab,' ');
end;
if cansend then
if newsgroupsline='' then
begin
warn('no Newsgroups: header -- cannot send');
cansend := false;
end;
if cansend then
if numoccur(' ',newsgroupsline)<>0 then
begin
warn('no spaces are allowed in Newsgroups: header -- cannot send');
cansend := false;
end;
if cansend then
begin
invalidmessage := findproblemwithmessage(newartfn);
if invalidmessage<>'' then
begin
warn2(invalidmessage,'cannot send');
cansend := false;
end;
end;
if cansend then
if toomuchquoting(newartfn) then
begin
warn('lots of quoting, not much new material -- please edit');
if not trusted then
cansend := false;
end;
if cansend then
if not trusted then
if trim(getheaderline(newartfn,'approved:'))<>'' then
begin
warn('without --trusted, cannot send approved articles');
cansend := false;
end;
if cansend then
if toolongline(newartfn,255) then
begin
{}{}{}{} {should offer to word-wrap in place instead}
warn('some line is very long, and will be lost');
cansend := false;
end;
if cansend then
if toolongline(newartfn,80) then
begin
warn2('some lines are >80 chars, which people with really old',
'or poorly-planned software will have problems seeing');
end;
{don't let trusted users post to more than 3 groups (2 commas)}
if cansend then
if numoccur(',',newsgroupsline)>2 then
begin
warn('massive crossposting -- please edit');
if not trusted then
cansend := false;
end;
if cansend then
begin
anyunknowngroups := false;
anymailgroups := false;
onenewsgroupwithdescline := lpp-2;
{ the message will go on lpp, so clear lpp-1 to start }
xclreolxy(1,lpp-1);
{ clear space for the first description }
xclreolxy(1,onenewsgroupwithdescline);
{
there are cols-1 useful columns
groupwidth and its trailing space are already used
}
groupwidth := max(cols div 2-10,10);
descwidth := cols-1 - (groupwidth+1);
newsgroupsline := uncomma(newsgroupsline);
while newsgroupsline<>'' do
begin
onenewsgroup := chopfirstw(newsgroupsline);
if ismailgroup(onenewsgroup) then
anymailgroups := true;
if getgroupdir(onenewsgroup)='' then
anyunknowngroups := true;
if onenewsgroupwithdescline>4 then
begin
onenewsgroupwithdesc :=
leftjustify(right(onenewsgroup,groupwidth),groupwidth,' ')+
' '+
copy(sourcedesc(onenewsgroup,sourcegroup),1,descwidth);
{ clear the line above to make it stand out }
xclreolxy(1,onenewsgroupwithdescline-1);
{
this line must already be clear then, either from the pre-loop
code or the previous iteration
}
writexy(1,onenewsgroupwithdescline,onenewsgroupwithdesc);
dec(onenewsgroupwithdescline);
end;
end;
if anymailgroups then
begin
warn('cannot crosspost to a private mail pseudo-group!');
cansend := false;
end
else if anyunknowngroups then
warn('some groups not on this site -- might be invalid');
end;
if cansend then
begin
sendprompt := '{s}end '; {note trailing space}
sendchar := 's';
end
else
begin
sendprompt := '';
sendchar := 'q'; {can always quit}
end;
if author='' then
sendeditvspellquit :=
onekey('Public: '+sendprompt+'{e}dit {v}spell {q}uit',
sendchar+'evq')
else
sendeditvspellquit :=
onekey('Public: '+sendprompt+'{e}dit {E}dit-both {v}spell {q}uit',
sendchar+'eEvq');
if sendeditvspellquit='s' then
xwrites('sending...')
else if sendeditvspellquit='e' then
xwrites('editing...')
else if sendeditvspellquit='E' then
xwrites('editing both...')
else if sendeditvspellquit='v' then
xwrites('vspelling...')
else if sendeditvspellquit='q' then
xwrites('quit');
end;
if sendeditvspellquit='s' then
begin
headerinmem:= ''; { In case user edited headers ... }
injnews(newartfn,newsgroups,originalnewsgroups);
ccaddr := getheaderline(newartfn,'cc:');
if ccaddr<>'' then
begin
if (ccaddr='poster') or (ccaddr='sender') then
ccaddr := author;
sendnewsasmail(newartfn,ccaddr);
end;
end;
{leave refresh and artf re-opening to the caller}
end;
procedure post;
var
nsubject: string;
ngroups: string;
postforgetit: char;
begin
ngroups := internalcmdlineparams;
if ngroups<>'' then
if not isavalidgroup(ngroups) then
if joinedtogroup(ngroups) then
;
if ngroups='' then
begin
if currsourcekind=sourcegroup then
ngroups := currsource
else
ngroups := 'misc.misc';
end;
if not maypost then
warn('you do not have access to post this way')
else
begin
if ismoderated(ngroups) then
warn(ngroups+' group is moderated');
postforgetit := 'p';
if ismailgroup(ngroups) then
begin
ngroups := 'misc.misc';
postforgetit :=
onekeydef('this is a mail group - {p}ost {f}orget it','pf','f');
end;
if postforgetit='p' then
begin
xclreolxy(1,lpp-3);
xclreolxy(1,lpp-2);
xwrites(sourcedesc(ngroups,sourcegroup));
xclreolxy(1,lpp-1);
xclreolxy(1,lpp);
xwrites('Subject: ');
xreadlns(nsubject,max(cols-10,70),nopreserve);
xclreolxy(1,lpp);
xwrites('Newsgroups: ');
xreadlns(ngroups,max(cols-15,70),yespreserve);
if ngroups='' then
ngroups := 'misc.misc';
if not isavalidgroup(ngroups) then
if joinedtogroup(ngroups) then
;
createpost(ngroups,'','',nsubject,'','','','');
editandinjnews(ngroups,'','');
end;
end;
{ caller must refresh }
end;
procedure postfile;
var
nsubject: string;
ngroups: string;
postforgetit: char;
includedfile: string;
cannotusemsg: string;
begin
ngroups := internalcmdlineparams;
if ngroups<>'' then
if not isavalidgroup(ngroups) then
if joinedtogroup(ngroups) then
;
if ngroups='' then
begin
if currsourcekind=sourcegroup then
ngroups := currsource
else
ngroups := 'misc.misc';
end;
if not trusted then
warn('you do not have access to post files this way')
else if not maypost then
warn('you do not have access to post this way')
else
begin
if ismoderated(ngroups) then
warn(ngroups+' group is moderated');
postforgetit := 'p';
if ismailgroup(ngroups) then
begin
ngroups := 'misc.misc';
postforgetit :=
onekeydef('this is a mail group - {p}ost {f}orget it','pf','f');
end;
if postforgetit='p' then
begin
xclreolxy(1,lpp-6);
xclreolxy(1,lpp-5);
xwritehighlights(
'do {NOT} post large files to discussion groups! almost');
xclreolxy(1,lpp-4);
xwrites('any group with ".binaries." in the name should be ok;');
xclreolxy(1,lpp-3);
xwritehighlights(
'any other is almost definitely not -- {PLEASE BE CAREFUL}');
xclreolxy(1,lpp-2);
xclreolxy(1,lpp-1);
warn('this is the last warning you will receive');
xclreolxy(1,lpp-3);
xclreolxy(1,lpp-2);
xwrites(sourcedesc(ngroups,sourcegroup));
xclreolxy(1,lpp-1);
includedfile := '';
cannotusemsg := '(no file entered yet!)';
while cannotusemsg<>'' do
begin
getexistingfilename(
includedfile,'(blank to exit) File:',includedfile);
includedfile := unslash(includedfile);
cannotusemsg := '';
if includedfile<>'' then
if illegalfn(includedfile) then
cannotusemsg := 'illegal filename';
if (includedfile<>'') and not trusted and (cannotusemsg='') then
if suspiciousfn(includedfile) then
cannotusemsg := 'without -t/--trusted';
if (includedfile<>'') and (cannotusemsg='') then
if isdev(includedfile) then
cannotusemsg := 'reserved device name';
if (includedfile<>'') and (cannotusemsg='') then
if not fexists(includedfile) then
cannotusemsg := 'file does not exist';
if (includedfile<>'') and (cannotusemsg<>'') then
warn('unable to use: '+cannotusemsg);
end;
if (includedfile<>'') and (cannotusemsg='') then
begin
nsubject := 'included file: '+includedfile;
if not trusted then
includedfile := withbackslash(home)+includedfile;
xclreolxy(1,lpp);
xwrites('Subject: ');
xreadlns(nsubject,max(cols-10,70),yespreserve);
xclreolxy(1,lpp);
xwrites('Newsgroups: ');
xreadlns(ngroups,max(cols-15,70),yespreserve);
if ngroups='' then
ngroups := 'misc.misc';
if not isavalidgroup(ngroups) then
if joinedtogroup(ngroups) then
;
createpost(ngroups,'','',nsubject,'','','',includedfile);
editandinjnews(ngroups,'','');
end;
end;
end;
{ caller must refresh }
end;
procedure editanddeliver;
{ expects artf to be closed; will open and close if author<>'' }
var
groupormail: string;
mailfn: string;
mailf: text;
mailcheckedfn: string;
mailcheckedf: text;
emptylinefound: boolean;
fromfound: boolean;
sigfn: string;
sigf: text;
oneline: string;
sendeditvspellquit: char;
outmailfn: string;
outmailf: text;
basesite: string;
cansend: boolean;
sendprompt: string;
sendchar: char;
invalidmessage: string;
begin
if ismailgroup(currsource) then
groupormail := 'mail'
else if currsourcekind=sourcegroup then
groupormail := currsource
else
groupormail := 'somewhere mysterious';
mailfn := withbackslash(temporarydir)+userid+'.mai';
saferewrite(mailf,mailfn);
if not nomailfrom then
writeln(mailf,'From ',fromuserid,' ',copy(cdow,1,3),', ',
dayofmonth,' ',copy(monthname,1,3),' ',year,' ',currenttimestring,' ',
timezone,' ','remote from ',uucpname);
if not isheaderinlist('Received:',nomailheaders) then
begin
writeln(mailf,'Received: by ',fqdn,' ('+newsreadername+')');
writeln(mailf,' via ',newsreadername,'; ',copy(cdow,1,3),', ',
dayofmonth,' ',copy(monthname,1,3),' ',year,' ',
currenttimestring,' ',timezone);
end;
{ don't bother with this line anymore -- makes future expansion easier }
{
writeln(mailf,' for ',replyaddr);
}
write(mailf,'To: ',replyaddr);
if replyname='' then
writeln(mailf)
else if (pos(',',replyname)<>0)
or (pos('(',replyname)<>0)
or (pos(')',replyname)<>0)
or (pos('<',replyname)<>0)
or (pos('>',replyname)<>0) then
writeln(mailf,' ("',replyname,'")')
else
writeln(mailf,' (',replyname,')');
if ccaddr<>'' then
writeln(mailf,'CC: ',ccaddr);
if originalfrom<>'' then
writeln(mailf,'X-Original-Article-From: ',originalfrom);
writeln(mailf,'Subject: ',subject);
writeln(mailf,'From: ',mailfrom);
if replyto<>'' then
writeln(mailf,'Reply-To: ',replyto);
if not isheaderinlist('Message-ID:',nomailheaders) then
writeln(mailf,'Message-ID: ',newmessageid);
writeln(mailf,'Date: ',copy(cdow,1,3),', ',dayofmonth,' ',
copy(monthname,1,3),' ',year,' ',currenttimestring,' ',timezone);
{$ifdef charset}
if uselocalcharset then
begin
writeln(mailf,'MIME-Version: 1.0');
writeln(mailf,'Content-Type: text/plain; charset=',postingsetname);
writeln(mailf,'Content-Transfer-Encoding: 8bit');
end;
{$endif}
if inreplyto<>'' then
writeln(mailf,'In-Reply-To: ',inreplyto);
if organ<>'' then
writeln(mailf,'Organization: ',organ);
if not isheaderinlist('X-Newsreader:',nomailheaders) then
writeln(mailf,'X-Newsreader: ',newsreadername,' ',newsreaderversion);
writeln(mailf);
if includedfile<>'' then
begin
writeln(mailf,'encoded file ',includedfile,' follows:');
writeln(mailf);
close(mailf);
appendencodedfile(mailfn,includedfile);
assign(mailf,mailfn);
append(mailf);
writeln(mailf);
end
else if justremail then
begin
writeln(mailf,'[re-mailed to you from ',groupormail,']');
if getfromaddr(author)<>getfromaddr(mailfrom) then
if getfromaddr(author)<>getfromaddr(newsfrom) then
writeln(mailf,'[the original seemed to come from ',author,']');
writeln(mailf);
emptylinefound := false;
artreset;
while not arteof and not emptylinefound do
begin
getartl(oneline,255,notoscreen);
if oneline='' then
emptylinefound := true;
end;
while not arteof do
begin
{don't use just cols here, to be polite}
getartl(oneline,min(cols,80)-3,notoscreen);
{$ifdef charset}
if (uselocalcharset) then
linetolocal(oneline);
{$endif}
writeln(mailf,expand(oneline));
end;
artclose;
end
else if author='' then
writeln(mailf,mailmarkerline)
else
begin
if defaultreply and (ccaddr='') then
writeln(mailf,'In ',groupormail,' you write:')
else
if length(groupormail)+length(author)<60 then
writeln(mailf,'In ',groupormail,', ',author,' writes:')
else
writeln(mailf,'In ',groupormail,', ',
copy(author,1,max(60-length(groupormail),20)),'... writes:');
writeln(mailf);
emptylinefound := false;
artreset;
while not arteof and not emptylinefound do
begin
getartl(oneline,255,notoscreen);
if oneline='' then
emptylinefound := true;
end;
while not arteof do
begin
{don't use just cols here, to be polite}
getartl(oneline,min(cols,80)-3,notoscreen);
{$ifdef charset}
if (uselocalcharset) then
linetolocal(oneline);
{$endif}
if oneline='' then
writeln(mailf,'>')
else if (copy(oneline,1,1)='>') and not quotewithspace then
writeln(mailf,'>',expand(oneline))
else
writeln(mailf,'> ',expand(oneline));
end;
artclose;
end;
sigfn := unslash(getconfig('signature'));
if sigfn='' then
sigfn := 'mailsig';
if numoccur('\',sigfn)=0 then
sigfn := withbackslash(home)+sigfn;
safereset(sigf,sigfn);
if fileresult<>0 then
begin
sigfn := withbackslash(home)+'sig';
safereset(sigf,sigfn);
end;
if fileresult=0 then
begin
readln(sigf,oneline);
if oneline<>'-- ' then
writeln(mailf,'-- ');
reset(sigf);
while not eof(sigf) do
begin
readln(sigf,oneline);
writeln(mailf,expand(oneline));
end;
close(sigf);
end;
close(mailf);
{edit the first time around}
sendeditvspellquit := 'e';
while (sendeditvspellquit<>'s') and (sendeditvspellquit<>'q') do
begin
if not trusted then
if sendeditvspellquit='E' then
sendeditvspellquit := 'e';
if sendeditvspellquit='v' then
begin
mouseshutdown;
execp(vspeller,vspelleroptions+' '+mailfn);
mouseinit;
if execresult<>0 then
warnerr(vspeller,execresult);
if editaftervspell then
sendeditvspellquit := 'e';
end;
if sendeditvspellquit='e' then
begin
mouseshutdown;
execp(editor,editoroptions+' '+mailfn);
mouseinit;
if execresult<>0 then
warnerr(editor,execresult);
end;
if sendeditvspellquit='E' then
begin
mouseshutdown;
execp(editor,editoroptions+' '+mailfn+' '+artfn);
mouseinit;
if execresult<>0 then
warnerr(editor,execresult);
end;
headerinmem := ''; {invalidate cache from last getheaderline}
cansend := true;
xclreolxy(1,lpp);
xwrites('checking headers...');
if cansend then
if getheaderline(mailfn,'from:')=couldnotreadfilecookie then
begin
warn('not sent -- could not read '+mailfn+'!');
cansend := false;
end;
if cansend then
if trim(getheaderline(mailfn,'from:'))='' then
begin
warn('no From: header -- cannot send');
cansend := false;
end;
if cansend then
if not trusted then
if getfromaddr(getheaderline(mailfn,'from:'))<>
getfromaddr(mailfrom) then
begin
warn('changed From: header -- cannot send');
cansend := false;
end;
if cansend then
if trim(getheaderline(mailfn,'subject:'))='' then
begin
warn('no Subject: header -- cannot send');
cansend := false;
end;
if cansend then
if lower(trim(getheaderline(mailfn,'subject:')))='re:' then
begin
warn('no Subject: header -- cannot send');
cansend := false;
end;
if cansend then
if trim(getheaderline(mailfn,'to:'))='' then
if trim(getheaderline(mailfn,'cc:'))='' then
begin
warn('no To: header and no CC: header -- cannot send');
cansend := false;
end;
if cansend then
begin
invalidmessage := findproblemwithmessage(mailfn);
if invalidmessage<>'' then
begin
warn2(invalidmessage,'cannot send');
cansend := false;
end;
end;
if cansend then
if toomuchquoting(mailfn) then
begin
warn('lots of quoting, not much new material -- please edit');
if not trusted then
cansend := false;
end;
{looks silly for mail, but prevents problems at stupid mail<->news gateways}
if cansend then
if not trusted then
if trim(getheaderline(mailfn,'approved:'))<>'' then
begin
warn('without --trusted, cannot send approved articles');
cansend := false;
end;
if cansend then
if toolongline(mailfn,255) then
begin
{}{}{}{} {should offer to word-wrap in place instead}
warn('some line is very long, and will be lost');
cansend := false;
end;
if cansend then
if toolongline(mailfn,80) then
begin
warn2('some lines are >80 chars, which people with really old',
'or poorly-planned software will have problems seeing');
end;
xclreolxy(1,lpp-1);
if cansend then
begin
sendprompt := '{s}end '; {note trailing space}
sendchar := 's';
end
else
begin
sendprompt := '';
sendchar := 'q'; {can always quit}
end;
sendeditvspellquit :=
onekey('Private: '+sendprompt+'{e}dit {E}dit-both {v}spell {q}uit',
sendchar+'eEvq');
if sendeditvspellquit='s' then
xwrites('sending...')
else if sendeditvspellquit='e' then
xwrites('editing...')
else if sendeditvspellquit='E' then
xwrites('editing both...')
else if sendeditvspellquit='v' then
xwrites('vspelling...')
else if sendeditvspellquit='q' then
xwrites('quit');
end;
if sendeditvspellquit='s' then
begin
mailcheckedfn := withbackslash(temporarydir)+userid+'.chk';
{ here copy mailf to mailcheckedf }
saferewrite(mailcheckedf,mailcheckedfn);
safereset(mailf,mailfn);
{check for changed From: lines on non-trusted users and replace}
{must make sure a From: line is actually found!}
emptylinefound := false;
fromfound := false;
while not eof(mailf) do
begin
read(mailf,oneline);
if eoln(mailf) then
readln(mailf);
if not trusted then
begin
if oneline='' then
begin
emptylinefound := true;
if not fromfound then
begin
writeln(mailcheckedf,'From: ',mailfrom);
fromfound := true;
end;
end
else if not emptylinefound then
begin
if getfirstw(oneline)='From:' then
fromfound := true;
if makesame(oneline,'From: ',mailfrom) then
begin
warn3
(
'From: line was changed back to '+mailfrom,
'(the default). the -t flag is required to change the',
'From: line. adding a Reply-To: is probably better.'
);
{
xclreolxy(1,1);
xclreolxy(1,2);
xclreolxy(1,3);
xclreolxy(1,4);
xclreolxy(1,5);
xclreolxy(1,6);
xclreolxy(1,7);
writexy(1,1,'From: line was changed from');
writexy(1,2,oneline+' to');
writexy(1,3,mailfrom);
writexy(1,4,'and has been changed back. if you need');
writexy(1,5,'to change From:, run as a trusted user.');
writexy(1,6,'adding a Reply-To: is probably better');
}
end;
end;
end;
writeln(mailcheckedf,oneline);
end;
close(mailf);
close(mailcheckedf);
delivermail(mailcheckedfn);
end;
{leave refresh and re-opening of artf to caller}
end;
procedure mail;
var
toaddr: string;
ccaddr: string;
nsubject: string;
afullname: string;
begin
if not maymail then
warn('you may not mail -- check your configuration')
else
begin
toaddr := internalcmdlineparams;
xclreolxy(1,lpp);
xwrites('To: ');
xreadlns(toaddr,max(cols-5,75),yespreserve);
toaddr := expandmail(toaddr);
if toaddr<>'' then
begin
if not quiet then
begin
xclreolxy(1,lpp-1);
xclreolxy(1,lpp-2);
if (pos('!',toaddr)=0) and
(pos('@',toaddr)=0) and
(pos(',',toaddr)=0) then
begin
afullname := getfullnameforuser(lower(toaddr));
if afullname='' then
afullname := ' (local, unknown name)'
else
afullname := ', '+afullname;
xwritesss('To: ',toaddr,afullname)
end
else
xwritess('To: ',toaddr);
end;
xclreolxy(1,lpp);
xwrites('CC: ');
xreadlns(ccaddr,max(cols-5,75),nopreserve);
ccaddr := expandmail(ccaddr);
if (ccaddr<>'') and not quiet then
begin
xclreolxy(1,lpp-1);
xclreolxy(1,lpp-2);
if (pos('!',ccaddr)=0) and
(pos('@',ccaddr)=0) and
(pos(',',ccaddr)=0) then
begin
afullname := getfullnameforuser(lower(ccaddr));
if afullname='' then
afullname := ' (local, unknown name)'
else
afullname := ', '+afullname;
xwritesss('CC: ',ccaddr,afullname)
end
else
xwritess('CC: ',ccaddr);
end;
xclreolxy(1,lpp);
xwrites('Subject: ');
xreadlns(nsubject,max(cols-10,70),nopreserve);
editanddeliver(
{subject } nsubject,
{inreplyto } '',
{replyaddr } toaddr,
{replyname } '',
{ccaddr } ccaddr,
{originalfrom } '',
{author } '',
{defaultreply } false,
{includedfile } '',
{justremail } false
);
end;
end;
{ caller must refresh }
end;
procedure mailfile;
var
toaddr: string;
ccaddr: string;
nsubject: string;
includedfile: string;
cannotusemsg: string;
afullname: string;
begin
if not trusted then
warn('you may not mail files this way')
else if not maymail then
warn('you may not mail -- check your configuration')
else
begin
toaddr := internalcmdlineparams;
xclreolxy(1,lpp-6);
xclreolxy(1,lpp-5);
xwritehighlights(
'do {NOT} mail large files unless you are sure all recipients');
xclreolxy(1,lpp-4);
xwrites('can handle them, and it will not cause any network problems');
xclreolxy(1,lpp-3);
xwritehighlights(
'between you and any of the recipients -- {PLEASE BE CAREFUL}');
xclreolxy(1,lpp-2);
xclreolxy(1,lpp-1);
warn('this is the last warning you will receive');
xclreolxy(1,lpp);
xwrites('To: ');
xreadlns(toaddr,max(cols-5,75),yespreserve);
toaddr := expandmail(toaddr);
if toaddr<>'' then
begin
if not quiet then
begin
xclreolxy(1,lpp-1);
xclreolxy(1,lpp-2);
if (pos('!',toaddr)=0) and
(pos('@',toaddr)=0) and
(pos(',',toaddr)=0) then
begin
afullname := getfullnameforuser(lower(toaddr));
if afullname='' then
afullname := ' (local, unknown name)'
else
afullname := ', '+afullname;
xwritesss('To: ',toaddr,afullname)
end
else
xwritess('To: ',toaddr);
end;
xclreolxy(1,lpp);
xwrites('CC: ');
xreadlns(ccaddr,max(cols-5,75),nopreserve);
ccaddr := expandmail(ccaddr);
if (ccaddr<>'') and not quiet then
begin
xclreolxy(1,lpp-1);
xclreolxy(1,lpp-2);
if (pos('!',ccaddr)=0) and
(pos('@',ccaddr)=0) and
(pos(',',ccaddr)=0) then
begin
afullname := getfullnameforuser(lower(ccaddr));
if afullname='' then
afullname := ' (local, unknown name)'
else
afullname := ', '+afullname;
xwritesss('CC: ',ccaddr,afullname)
end
else
xwritess('CC: ',ccaddr);
end;
xclreolxy(1,lpp);
includedfile := '';
cannotusemsg := '(no file entered yet!)';
while cannotusemsg<>'' do
begin
getexistingfilename(
includedfile,'(blank to exit) File:',includedfile);
includedfile := unslash(includedfile);
cannotusemsg := '';
if includedfile<>'' then
if illegalfn(includedfile) then
cannotusemsg := 'illegal filename';
if (includedfile<>'') and not trusted and (cannotusemsg='') then
if suspiciousfn(includedfile) then
cannotusemsg := 'without -t/--trusted';
if (includedfile<>'') and (cannotusemsg='') then
if isdev(includedfile) then
cannotusemsg := 'reserved device name';
if (includedfile<>'') and (cannotusemsg='') then
if not fexists(includedfile) then
cannotusemsg := 'file does not exist';
if (includedfile<>'') and (cannotusemsg<>'') then
warn('unable to use: '+cannotusemsg);
end;
if (includedfile<>'') and (cannotusemsg='') then
begin
nsubject := 'included file: '+includedfile;
if not trusted then
includedfile := withbackslash(home)+includedfile;
xclreolxy(1,lpp);
xwrites('Subject: ');
xreadlns(nsubject,max(cols-10,70),yespreserve);
editanddeliver(
{subject } nsubject,
{inreplyto } '',
{replyaddr } toaddr,
{replyname } '',
{ccaddr } ccaddr,
{originalfrom } '',
{author } '',
{defaultreply } false,
{includedfile } includedfile,
{justremail } false
);
end;
end;
end;
{ caller must refresh }
end;
end.